From 9d1c413200955a74c8f028b47516e0ec2b80f537 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 19 Jul 2024 21:19:47 -0400 Subject: [PATCH 01/60] Comment most things, towards interpreter rewrite --- .gitignore | 3 +- backend/fsdark.sln | 489 ++-- backend/src/BuiltinExecution/Builtin.fs | 66 +- .../BuiltinExecution/BuiltinExecution.fsproj | 62 +- backend/src/LibExecution/Builtin.fs | 19 +- backend/src/LibExecution/Dval.fs | 213 +- backend/src/LibExecution/DvalDecoder.fs | 150 +- backend/src/LibExecution/DvalReprDeveloper.fs | 351 +-- backend/src/LibExecution/Execution.fs | 211 +- backend/src/LibExecution/Interpreter.fs | 1550 ++++++------ backend/src/LibExecution/LibExecution.fsproj | 18 +- .../src/LibExecution/NameResolutionError.fs | 175 +- backend/src/LibExecution/ProgramTypes.fs | 838 +++---- .../ProgramTypesToRuntimeTypes.fs | 757 +++--- backend/src/LibExecution/RuntimeTypes.fs | 1600 ++++++------ backend/src/LibExecution/TypeChecker.fs | 1066 ++++---- backend/tests/TestUtils/LibTest.fs | 522 ++-- backend/tests/TestUtils/RTShortcuts.fs | 116 +- backend/tests/TestUtils/TestUtils.fs | 2194 ++++++++--------- backend/tests/TestUtils/TestUtils.fsproj | 6 +- backend/tests/TestUtils/paket.references | 1 + backend/tests/Tests/ProgramTypes.Tests.fs | 256 +- backend/tests/Tests/Tests.fs | 88 +- backend/tests/Tests/Tests.fsproj | 76 +- scripts/build/compile | 94 +- scripts/run-backend-tests | 44 +- 26 files changed, 5406 insertions(+), 5559 deletions(-) diff --git a/.gitignore b/.gitignore index 166496225f..f066c130c3 100644 --- a/.gitignore +++ b/.gitignore @@ -44,4 +44,5 @@ deploy-lock-manual-deploy clis/ -.mono \ No newline at end of file +.mono +.fake \ No newline at end of file diff --git a/backend/fsdark.sln b/backend/fsdark.sln index 2b64fa9893..d42876e12b 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -3,6 +3,7 @@ Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.26124.0 MinimumVisualStudioVersion = 15.0.26124.0 + Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{08CCFCF6-2248-43ED-A6EF-E972A2DA0E6A}" ProjectSection(SolutionItems) = preProject paket.dependencies = paket.dependencies @@ -12,395 +13,211 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution README.md = README.md EndProjectSection EndProject + +# Main folders Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BwdServer", "src\BwdServer\BwdServer.fsproj", "{B56110F0-2D27-4718-8C80-E7FDE3439A63}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExecution\LibExecution.fsproj", "{D8ECA989-4383-47D3-B443-4D7BFF1F05E7}" -EndProject Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{3820D9E8-1B4E-486E-9C46-D52E3784D222}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Tests", "tests\Tests\Tests.fsproj", "{DB61305F-4CA9-4D92-82A5-503495F515E8}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" -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}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExecution\LibExecution.fsproj", "{D8ECA989-4383-47D3-B443-4D7BFF1F05E7}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestUtils", "tests\TestUtils\TestUtils.fsproj", "{839A1EF7-18F5-491E-B40B-2BAA57378B40}" +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" +#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinExecution", "src\BuiltinExecution\BuiltinExecution.fsproj", "{BBFC824F-A0DE-4A28-B82F-49C04EBA7475}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibHttpMiddleware", "src\LibHttpMiddleware\LibHttpMiddleware.fsproj", "{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ProdExec", "src\ProdExec\ProdExec.fsproj", "{00488B6E-9BB3-49AA-AE42-C120799D803C}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "src\LibBinarySerialization\LibBinarySerialization.fsproj", "{5830D9BF-CA28-47B0-964F-343FAB28751B}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Wasm", "src\Wasm\Wasm.fsproj", "{5990939C-7E7B-4CFA-86FF-44CA5756498A}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LocalExec", "src\LocalExec\LocalExec.fsproj", "{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibPackageManager", "src\LibPackageManager\LibPackageManager.fsproj", "{A74049E0-AD31-407B-9918-6A6A76C945C9}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCliHost", "src\BuiltinCliHost\BuiltinCliHost.fsproj", "{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}" + +# Cloud stuff +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "src\LibBinarySerialization\LibBinarySerialization.fsproj", "{5830D9BF-CA28-47B0-964F-343FAB28751B}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Wasm", "src\Wasm\Wasm.fsproj", "{5990939C-7E7B-4CFA-86FF-44CA5756498A}" +#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 +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ProdExec", "src\ProdExec\ProdExec.fsproj", "{00488B6E-9BB3-49AA-AE42-C120799D803C}" +#EndProject + +# CLI stuff +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibPackageManager", "src\LibPackageManager\LibPackageManager.fsproj", "{A74049E0-AD31-407B-9918-6A6A76C945C9}" +#EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCliHost", "src\BuiltinCliHost\BuiltinCliHost.fsproj", "{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}" +#EndProject + +# Tests +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestUtils", "tests\TestUtils\TestUtils.fsproj", "{839A1EF7-18F5-491E-B40B-2BAA57378B40}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Tests", "tests\Tests\Tests.fsproj", "{DB61305F-4CA9-4D92-82A5-503495F515E8}" EndProject + +# local dev +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LocalExec", "src\LocalExec\LocalExec.fsproj", "{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}" +#EndProject + Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU - Debug|x64 = Debug|x64 - Debug|x86 = Debug|x86 Release|Any CPU = Release|Any CPU - Release|x64 = Release|x64 - Release|x86 = Release|x86 EndGlobalSection - GlobalSection(SolutionProperties) = preSolution + + GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE 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}.Debug|x64.ActiveCfg = Debug|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|x64.Build.0 = Debug|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|x86.ActiveCfg = Debug|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Debug|x86.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 - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|x64.ActiveCfg = Release|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|x64.Build.0 = Release|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|x86.ActiveCfg = Release|Any CPU - {B56110F0-2D27-4718-8C80-E7FDE3439A63}.Release|x86.Build.0 = Release|Any CPU + #{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}.Debug|x64.ActiveCfg = Debug|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|x64.Build.0 = Debug|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|x86.ActiveCfg = Debug|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Debug|x86.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 - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|x64.ActiveCfg = Release|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|x64.Build.0 = Release|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|x86.ActiveCfg = Release|Any CPU - {D8ECA989-4383-47D3-B443-4D7BFF1F05E7}.Release|x86.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}.Debug|x64.ActiveCfg = Debug|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Debug|x64.Build.0 = Debug|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Debug|x86.ActiveCfg = Debug|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Debug|x86.Build.0 = Debug|Any CPU {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|Any CPU.ActiveCfg = Release|Any CPU {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|Any CPU.Build.0 = Release|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|x64.ActiveCfg = Release|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|x64.Build.0 = Release|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|x86.ActiveCfg = Release|Any CPU - {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|x86.Build.0 = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.Build.0 = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|x64.ActiveCfg = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|x64.Build.0 = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|x86.ActiveCfg = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|x86.Build.0 = Debug|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.ActiveCfg = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.Build.0 = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|x64.ActiveCfg = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|x64.Build.0 = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|x86.ActiveCfg = Release|Any CPU - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|x86.Build.0 = Release|Any CPU + #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.Build.0 = Release|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|Any CPU.Build.0 = Debug|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|x64.ActiveCfg = Debug|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|x64.Build.0 = Debug|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|x86.ActiveCfg = Debug|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|x86.Build.0 = Debug|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|Any CPU.ActiveCfg = Release|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|Any CPU.Build.0 = Release|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|x64.ActiveCfg = Release|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|x64.Build.0 = Release|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|x86.ActiveCfg = Release|Any CPU - {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|x86.Build.0 = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.Build.0 = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|x64.ActiveCfg = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|x64.Build.0 = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|x86.ActiveCfg = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|x86.Build.0 = Debug|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.ActiveCfg = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.Build.0 = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|x64.ActiveCfg = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|x64.Build.0 = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|x86.ActiveCfg = Release|Any CPU - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|x86.Build.0 = Release|Any CPU + #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.Build.0 = Release|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|Any CPU.Build.0 = Debug|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|x64.ActiveCfg = Debug|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|x64.Build.0 = Debug|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|x86.ActiveCfg = Debug|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|x86.Build.0 = Debug|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|Any CPU.ActiveCfg = Release|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|Any CPU.Build.0 = Release|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|x64.ActiveCfg = Release|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|x64.Build.0 = Release|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|x86.ActiveCfg = Release|Any CPU - {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|x86.Build.0 = Release|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|Any CPU.Build.0 = Debug|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|x64.ActiveCfg = Debug|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|x64.Build.0 = Debug|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|x86.ActiveCfg = Debug|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|x86.Build.0 = Debug|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|Any CPU.ActiveCfg = Release|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|Any CPU.Build.0 = Release|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|x64.ActiveCfg = Release|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|x64.Build.0 = Release|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|x86.ActiveCfg = Release|Any CPU - {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|x86.Build.0 = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.Build.0 = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|x64.ActiveCfg = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|x64.Build.0 = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|x86.ActiveCfg = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|x86.Build.0 = Debug|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.ActiveCfg = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.Build.0 = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|x64.ActiveCfg = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|x64.Build.0 = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|x86.ActiveCfg = Release|Any CPU - {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|x86.Build.0 = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|x64.ActiveCfg = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|x64.Build.0 = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|x86.ActiveCfg = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|x86.Build.0 = Debug|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.Build.0 = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|x64.ActiveCfg = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|x64.Build.0 = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|x86.ActiveCfg = Release|Any CPU - {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|x86.Build.0 = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|x64.ActiveCfg = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|x64.Build.0 = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|x86.ActiveCfg = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|x86.Build.0 = Debug|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.Build.0 = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|x64.ActiveCfg = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|x64.Build.0 = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|x86.ActiveCfg = Release|Any CPU - {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|x86.Build.0 = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|x64.ActiveCfg = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|x64.Build.0 = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|x86.ActiveCfg = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|x86.Build.0 = Debug|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.Build.0 = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|x64.ActiveCfg = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|x64.Build.0 = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|x86.ActiveCfg = Release|Any CPU - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|x86.Build.0 = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.Build.0 = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|x64.ActiveCfg = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|x64.Build.0 = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|x86.ActiveCfg = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|x86.Build.0 = Debug|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.ActiveCfg = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.Build.0 = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|x64.ActiveCfg = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|x64.Build.0 = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|x86.ActiveCfg = Release|Any CPU - {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|x86.Build.0 = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|x64.ActiveCfg = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|x64.Build.0 = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|x86.ActiveCfg = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|x86.Build.0 = Debug|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.Build.0 = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|x64.ActiveCfg = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|x64.Build.0 = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|x86.ActiveCfg = Release|Any CPU - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|x86.Build.0 = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.Build.0 = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|x64.ActiveCfg = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|x64.Build.0 = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|x86.ActiveCfg = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|x86.Build.0 = Debug|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.ActiveCfg = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.Build.0 = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|x64.ActiveCfg = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|x64.Build.0 = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|x86.ActiveCfg = Release|Any CPU - {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|x86.Build.0 = Release|Any CPU + #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.Build.0 = Release|Any CPU + #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.Build.0 = Release|Any CPU + #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.Build.0 = Release|Any CPU + #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.Build.0 = Release|Any CPU + #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.Build.0 = Release|Any CPU + #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.Build.0 = Release|Any CPU + #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.Build.0 = Release|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|Any CPU.Build.0 = Debug|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|x64.ActiveCfg = Debug|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|x64.Build.0 = Debug|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|x86.ActiveCfg = Debug|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|x86.Build.0 = Debug|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|Any CPU.ActiveCfg = Release|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|Any CPU.Build.0 = Release|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|x64.ActiveCfg = Release|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|x64.Build.0 = Release|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|x86.ActiveCfg = Release|Any CPU - {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|x86.Build.0 = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.Build.0 = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|x64.ActiveCfg = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|x64.Build.0 = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|x86.ActiveCfg = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|x86.Build.0 = Debug|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.ActiveCfg = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.Build.0 = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|x64.ActiveCfg = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|x64.Build.0 = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|x86.ActiveCfg = Release|Any CPU - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|x86.Build.0 = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.Build.0 = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|x64.ActiveCfg = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|x64.Build.0 = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|x86.ActiveCfg = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|x86.Build.0 = Debug|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.ActiveCfg = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.Build.0 = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|x64.ActiveCfg = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|x64.Build.0 = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|x86.ActiveCfg = Release|Any CPU - {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|x86.Build.0 = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.Build.0 = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|x64.ActiveCfg = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|x64.Build.0 = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|x86.ActiveCfg = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|x86.Build.0 = Debug|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.ActiveCfg = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.Build.0 = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|x64.ActiveCfg = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|x64.Build.0 = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|x86.ActiveCfg = Release|Any CPU - {5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|x86.Build.0 = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.Build.0 = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|x64.ActiveCfg = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|x64.Build.0 = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|x86.ActiveCfg = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|x86.Build.0 = Debug|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.ActiveCfg = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.Build.0 = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|x64.ActiveCfg = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|x64.Build.0 = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|x86.ActiveCfg = Release|Any CPU - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|x86.Build.0 = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|x64.ActiveCfg = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|x64.Build.0 = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|x86.ActiveCfg = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|x86.Build.0 = Debug|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.Build.0 = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|x64.ActiveCfg = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|x64.Build.0 = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|x86.ActiveCfg = Release|Any CPU - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|x86.Build.0 = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|x64.ActiveCfg = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|x64.Build.0 = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|x86.ActiveCfg = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|x86.Build.0 = Debug|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.Build.0 = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|x64.ActiveCfg = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|x64.Build.0 = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|x86.ActiveCfg = Release|Any CPU - {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|x86.Build.0 = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.Build.0 = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|x64.ActiveCfg = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|x64.Build.0 = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|x86.ActiveCfg = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|x86.Build.0 = Debug|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.ActiveCfg = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.Build.0 = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|x64.ActiveCfg = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|x64.Build.0 = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|x86.ActiveCfg = Release|Any CPU - {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|x86.Build.0 = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|x64.ActiveCfg = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|x64.Build.0 = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|x86.ActiveCfg = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|x86.Build.0 = Debug|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.Build.0 = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|x64.ActiveCfg = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|x64.Build.0 = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|x86.ActiveCfg = Release|Any CPU - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|x86.Build.0 = Release|Any CPU + #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.Build.0 = Release|Any CPU + #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.Build.0 = Release|Any CPU + #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.Build.0 = Release|Any CPU + #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.Build.0 = Release|Any CPU + #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.Build.0 = Release|Any CPU + #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.Build.0 = Release|Any CPU + #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.Build.0 = Release|Any CPU + #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.Build.0 = Release|Any CPU {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|x64.ActiveCfg = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|x64.Build.0 = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|x86.ActiveCfg = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|x86.Build.0 = Debug|Any CPU {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.Build.0 = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|x64.ActiveCfg = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|x64.Build.0 = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|x86.ActiveCfg = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection + + + # Notes of what projects being in which folders GlobalSection(NestedProjects) = preSolution - {B56110F0-2D27-4718-8C80-E7FDE3439A63} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {D8ECA989-4383-47D3-B443-4D7BFF1F05E7} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {DB61305F-4CA9-4D92-82A5-503495F515E8} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} - {3FC57943-9D51-49AE-9FBD-4A112B4F68D6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {5FD0E378-FD88-45E5-9963-BFF2921E6A6A} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {839A1EF7-18F5-491E-B40B-2BAA57378B40} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} {BBFC824F-A0DE-4A28-B82F-49C04EBA7475} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {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} + #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + + {DB61305F-4CA9-4D92-82A5-503495F515E8} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} + {839A1EF7-18F5-491E-B40B-2BAA57378B40} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} EndGlobalSection EndGlobal diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 4b37144ae6..878e22dffc 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -11,52 +11,54 @@ let fnRenames = [] let builtins - (httpConfig : Libs.HttpClient.Configuration) - (pm : LibExecution.ProgramTypes.PackageManager) + //(httpConfig : Libs.HttpClient.Configuration) + //(pm : LibExecution.ProgramTypes.PackageManager) : Builtins = Builtin.combine - [ Libs.NoModule.builtins + [ + // Libs.NoModule.builtins - Libs.Bool.builtins + // Libs.Bool.builtins - Libs.Int8.builtins - Libs.UInt8.builtins - Libs.Int16.builtins - Libs.UInt16.builtins - Libs.Int32.builtins - Libs.UInt32.builtins - Libs.Int64.builtins - Libs.UInt64.builtins - Libs.Int128.builtins - Libs.UInt128.builtins + // Libs.Int8.builtins + // Libs.UInt8.builtins + // Libs.Int16.builtins + // Libs.UInt16.builtins + // Libs.Int32.builtins + // Libs.UInt32.builtins + // Libs.Int64.builtins + // Libs.UInt64.builtins + // Libs.Int128.builtins + // Libs.UInt128.builtins - Libs.Float.builtins + // Libs.Float.builtins - Libs.Math.builtins + // Libs.Math.builtins - Libs.Bytes.builtins + // Libs.Bytes.builtins - Libs.Char.builtins - Libs.String.builtins + // Libs.Char.builtins + // Libs.String.builtins - Libs.List.builtins - Libs.Dict.builtins + // Libs.List.builtins + // Libs.Dict.builtins - Libs.DateTime.builtins - Libs.Uuid.builtins + // Libs.DateTime.builtins + // Libs.Uuid.builtins - Libs.Base64.builtins + // Libs.Base64.builtins - Libs.Json.builtins - Libs.AltJson.builtins + // Libs.Json.builtins + // Libs.AltJson.builtins - Libs.HttpClient.builtins httpConfig + // Libs.HttpClient.builtins httpConfig - Libs.LanguageTools.builtins - Libs.Parser.builtins + // Libs.LanguageTools.builtins + // Libs.Parser.builtins - Libs.Crypto.builtins - Libs.X509.builtins + // Libs.Crypto.builtins + // Libs.X509.builtins - Libs.Packages.builtins pm ] + // Libs.Packages.builtins pm + ] fnRenames diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 802debfe7a..d1dbc83327 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -10,51 +10,51 @@ - + - + - - - - - - - - - - - + + + + + + + + + + + - + - + - + - - + + - - + + - - + + - + - - + + - + - - + + - - + + - + diff --git a/backend/src/LibExecution/Builtin.fs b/backend/src/LibExecution/Builtin.fs index 3392e1622e..b788ce7535 100644 --- a/backend/src/LibExecution/Builtin.fs +++ b/backend/src/LibExecution/Builtin.fs @@ -51,22 +51,25 @@ let combine (libs : List) (fnRenames : FnRenames) : Builtins = fns |> List.iter checkFn - { constants = - libs - |> List.map _.constants - |> List.collect Map.values - |> Map.fromListBy _.name + { + // constants = + // libs + // |> List.map _.constants + // |> List.collect Map.values + // |> Map.fromListBy _.name fns = fns |> renameFunctions fnRenames |> Map.fromListBy _.name } -let make (constants : List) (fns : List) : Builtins = - { constants = constants |> Map.fromListBy _.name +let make + //(constants : List) + (fns : List) : Builtins = + { //constants = constants |> Map.fromListBy _.name fns = fns |> Map.fromListBy _.name } module Shortcuts = let fn = FQFnName.builtin - let constant = FQConstantName.builtin + //let constant = FQConstantName.builtin let incorrectArgs = RuntimeTypes.incorrectArgs type Param = BuiltInParam diff --git a/backend/src/LibExecution/Dval.fs b/backend/src/LibExecution/Dval.fs index 56ed0dbdb5..472e222d5f 100644 --- a/backend/src/LibExecution/Dval.fs +++ b/backend/src/LibExecution/Dval.fs @@ -7,115 +7,106 @@ open LibExecution.RuntimeTypes module VT = ValueType +// let int8 (i : int8) = DInt8(i) +// let uint8 (i : uint8) = DUInt8(i) +// let int16 (i : int16) = DInt16(i) +// let uint16 (i : uint16) = DUInt16(i) +// let int32 (i : int32) = DInt32(i) +// let uint32 (i : uint32) = DUInt32(i) let int64 (i : int64) = DInt64(i) - -let uint64 (i : uint64) = DUInt64(i) - -let int8 (i : int8) = DInt8(i) - -let uint8 (i : uint8) = DUInt8(i) - -let int16 (i : int16) = DInt16(i) - -let uint16 (i : uint16) = DUInt16(i) - -let int32 (i : int32) = DInt32(i) - -let uint32 (i : uint32) = DUInt32(i) - -let int128 (i : System.Int128) = DInt128(i) - -let uint128 (i : System.UInt128) = DUInt128(i) - -let list (typ : KnownType) (list : List) : Dval = DList(VT.known typ, list) - -let dict (typ : KnownType) (entries : List) : Dval = - DDict(VT.known typ, Map entries) - -let dictFromMap (typ : KnownType) (entries : Map) : Dval = - DDict(VT.known typ, entries) - - -/// VTTODO -/// the interpreter "throws away" any valueTypes currently, -/// so while these .option and .result functions are great in that they -/// return the correct typeArgs, they conflict with what the interpreter will do -/// -/// So, to make some tests happy, let's ignore these for now. -/// -/// (might need better explanation^) -let ignoreAndUseEmpty (_ignoredForNow : List) = [] - - - -let optionType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.option - - -let optionSome (innerType : KnownType) (dv : Dval) : Dval = - DEnum( - optionType, - optionType, - ignoreAndUseEmpty [ VT.known innerType ], - "Some", - [ dv ] - ) - -let optionNone (innerType : KnownType) : Dval = - DEnum(optionType, optionType, ignoreAndUseEmpty [ VT.known innerType ], "None", []) - -let option (innerType : KnownType) (dv : Option) : Dval = - match dv with - | Some dv -> optionSome innerType dv - | None -> optionNone innerType - - - -let resultType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.result - - -let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = - DEnum( - resultType, - resultType, - ignoreAndUseEmpty [ ValueType.Known okType; ValueType.Known errorType ], - "Ok", - [ dvOk ] - ) - -let resultError - (okType : KnownType) - (errorType : KnownType) - (dvError : Dval) - : Dval = - - DEnum( - resultType, - resultType, - ignoreAndUseEmpty [ ValueType.known okType; ValueType.known errorType ], - "Error", - [ dvError ] - ) - -let result - (okType : KnownType) - (errorType : KnownType) - (dv : Result) - : Dval = - match dv with - | Ok dv -> resultOk okType errorType dv - | Error dv -> resultError okType errorType dv - - -let byteArrayToDvalList (bytes : byte[]) : Dval = - bytes - |> Array.toList - |> List.map (fun b -> DUInt8(byte b)) - |> fun dvalList -> DList(VT.uint8, dvalList) - -let DlistToByteArray (dvalList : List) : byte[] = - dvalList - |> List.map (fun dval -> - match dval with - | DUInt8 b -> b - | _ -> (Exception.raiseInternal "Invalid type in byte list") []) - |> Array.ofList +// let uint64 (i : uint64) = DUInt64(i) +// let int128 (i : System.Int128) = DInt128(i) +// let uint128 (i : System.UInt128) = DUInt128(i) + +// let list (typ : KnownType) (list : List) : Dval = DList(VT.known typ, list) + +// let dict (typ : KnownType) (entries : List) : Dval = +// DDict(VT.known typ, Map entries) + +// let dictFromMap (typ : KnownType) (entries : Map) : Dval = +// DDict(VT.known typ, entries) + + +// /// VTTODO +// /// the interpreter "throws away" any valueTypes currently, +// /// so while these .option and .result functions are great in that they +// /// return the correct typeArgs, they conflict with what the interpreter will do +// /// +// /// So, to make some tests happy, let's ignore these for now. +// /// +// /// (might need better explanation^) +// let ignoreAndUseEmpty (_ignoredForNow : List) = [] + + + +// let optionType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.option + + +// let optionSome (innerType : KnownType) (dv : Dval) : Dval = +// DEnum( +// optionType, +// optionType, +// ignoreAndUseEmpty [ VT.known innerType ], +// "Some", +// [ dv ] +// ) + +// let optionNone (innerType : KnownType) : Dval = +// DEnum(optionType, optionType, ignoreAndUseEmpty [ VT.known innerType ], "None", []) + +// let option (innerType : KnownType) (dv : Option) : Dval = +// match dv with +// | Some dv -> optionSome innerType dv +// | None -> optionNone innerType + + + +// let resultType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.result + + +// let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = +// DEnum( +// resultType, +// resultType, +// ignoreAndUseEmpty [ ValueType.Known okType; ValueType.Known errorType ], +// "Ok", +// [ dvOk ] +// ) + +// let resultError +// (okType : KnownType) +// (errorType : KnownType) +// (dvError : Dval) +// : Dval = + +// DEnum( +// resultType, +// resultType, +// ignoreAndUseEmpty [ ValueType.known okType; ValueType.known errorType ], +// "Error", +// [ dvError ] +// ) + +// let result +// (okType : KnownType) +// (errorType : KnownType) +// (dv : Result) +// : Dval = +// match dv with +// | Ok dv -> resultOk okType errorType dv +// | Error dv -> resultError okType errorType dv + + +// let byteArrayToDvalList (bytes : byte[]) : Dval = +// bytes +// |> Array.toList +// |> List.map (fun b -> DUInt8(byte b)) +// |> fun dvalList -> DList(VT.uint8, dvalList) + +// let DlistToByteArray (dvalList : List) : byte[] = +// dvalList +// |> List.map (fun dval -> +// match dval with +// | DUInt8 b -> b +// | _ -> (Exception.raiseInternal "Invalid type in byte list") []) +// |> Array.ofList diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/LibExecution/DvalDecoder.fs index 917cc1021a..0fc61b89ec 100644 --- a/backend/src/LibExecution/DvalDecoder.fs +++ b/backend/src/LibExecution/DvalDecoder.fs @@ -18,17 +18,17 @@ let stringField (name : string) (m : DvalMap) : string = |> Dval.asString |> unwrap $"Expected '{name}' field to be a string" [] -let listField (name : string) (m : DvalMap) : List = - m - |> field name - |> Dval.asList - |> unwrap $"Expected '{name}' field to be a list" [] - -let stringListField (name : string) (m : DvalMap) : List = - m - |> listField name - |> List.map (fun s -> - s |> Dval.asString |> unwrap $"Expected string values in '{name}' list" []) +// let listField (name : string) (m : DvalMap) : List = +// m +// |> field name +// |> Dval.asList +// |> unwrap $"Expected '{name}' field to be a list" [] + +// let stringListField (name : string) (m : DvalMap) : List = +// m +// |> listField name +// |> List.map (fun s -> +// s |> Dval.asString |> unwrap $"Expected string values in '{name}' list" []) let int64Field (name : string) (m : DvalMap) : int64 = m @@ -36,70 +36,70 @@ let int64Field (name : string) (m : DvalMap) : int64 = |> Dval.asInt64 |> unwrap $"Expected '{name}' field to be an int64" [] -let uint64Field (name : string) (m : DvalMap) : uint64 = - m - |> field name - |> Dval.asUInt64 - |> unwrap $"Expected '{name}' field to be an uint64" [] +// let uint64Field (name : string) (m : DvalMap) : uint64 = +// m +// |> field name +// |> Dval.asUInt64 +// |> unwrap $"Expected '{name}' field to be an uint64" [] let intField (name : string) (m : DvalMap) : int = m |> int64Field name |> int -let int8Field (name : string) (m : DvalMap) : int8 = - m - |> field name - |> Dval.asInt8 - |> unwrap $"Expected '{name}' field to be an int8" [] - -let uint8Field (name : string) (m : DvalMap) : uint8 = - m - |> field name - |> Dval.asUInt8 - |> unwrap $"Expected '{name}' field to be a uint8" [] - -let int16Field (name : string) (m : DvalMap) : int16 = - m - |> field name - |> Dval.asInt16 - |> unwrap $"Expected '{name}' field to be an int16" [] - -let uint16Field (name : string) (m : DvalMap) : uint16 = - m - |> field name - |> Dval.asUInt16 - |> unwrap $"Expected '{name}' field to be a uint16" [] - -let int32Field (name : string) (m : DvalMap) : int32 = - m - |> field name - |> Dval.asInt32 - |> unwrap $"Expected '{name}' field to be an int32" [] - -let uint32Field (name : string) (m : DvalMap) : uint32 = - m - |> field name - |> Dval.asUInt32 - |> unwrap $"Expected '{name}' field to be a uint32" [] - -let int128Field (name : string) (m : DvalMap) : System.Int128 = - m - |> field name - |> Dval.asInt128 - |> unwrap $"Expected '{name}' field to be an int128" [] - -let uint128Field (name : string) (m : DvalMap) : System.UInt128 = - m - |> field name - |> Dval.asUInt128 - |> unwrap $"Expected '{name}' field to be a uint128" [] - -let uuidField (name : string) (m : DvalMap) : System.Guid = - m - |> field name - |> Dval.asUuid - |> unwrap $"Expected '{name}' field to be a uuid" [] - -let mapField (name : string) (m : DvalMap) : Map = - m - |> field name - |> Dval.asDict - |> unwrap $"Expected '{name}' field to be a dict" [] +// let int8Field (name : string) (m : DvalMap) : int8 = +// m +// |> field name +// |> Dval.asInt8 +// |> unwrap $"Expected '{name}' field to be an int8" [] + +// let uint8Field (name : string) (m : DvalMap) : uint8 = +// m +// |> field name +// |> Dval.asUInt8 +// |> unwrap $"Expected '{name}' field to be a uint8" [] + +// let int16Field (name : string) (m : DvalMap) : int16 = +// m +// |> field name +// |> Dval.asInt16 +// |> unwrap $"Expected '{name}' field to be an int16" [] + +// let uint16Field (name : string) (m : DvalMap) : uint16 = +// m +// |> field name +// |> Dval.asUInt16 +// |> unwrap $"Expected '{name}' field to be a uint16" [] + +// let int32Field (name : string) (m : DvalMap) : int32 = +// m +// |> field name +// |> Dval.asInt32 +// |> unwrap $"Expected '{name}' field to be an int32" [] + +// let uint32Field (name : string) (m : DvalMap) : uint32 = +// m +// |> field name +// |> Dval.asUInt32 +// |> unwrap $"Expected '{name}' field to be a uint32" [] + +// let int128Field (name : string) (m : DvalMap) : System.Int128 = +// m +// |> field name +// |> Dval.asInt128 +// |> unwrap $"Expected '{name}' field to be an int128" [] + +// let uint128Field (name : string) (m : DvalMap) : System.UInt128 = +// m +// |> field name +// |> Dval.asUInt128 +// |> unwrap $"Expected '{name}' field to be a uint128" [] + +// let uuidField (name : string) (m : DvalMap) : System.Guid = +// m +// |> field name +// |> Dval.asUuid +// |> unwrap $"Expected '{name}' field to be a uuid" [] + +// let mapField (name : string) (m : DvalMap) : Map = +// m +// |> field name +// |> Dval.asDict +// |> unwrap $"Expected '{name}' field to be a dict" [] diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index e7904e4a08..5ed539b837 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -10,94 +10,99 @@ let rec typeName (t : TypeReference) : string = | TUnit -> "Unit" | TBool -> "Bool" + // | TInt8 -> "Int8" + // | TUInt8 -> "UInt8" + // | TInt16 -> "Int16" + // | TUInt16 -> "UInt16" + // | TInt32 -> "Int32" + // | TUInt32 -> "UInt32" | TInt64 -> "Int64" - | TUInt64 -> "UInt64" - | TInt8 -> "Int8" - | TUInt8 -> "UInt8" - | TInt16 -> "Int16" - | TUInt16 -> "UInt16" - | TInt32 -> "Int32" - | TUInt32 -> "UInt32" - | TInt128 -> "Int128" - | TUInt128 -> "UInt128" - - | TFloat -> "Float" - | TChar -> "Char" + // | TUInt64 -> "UInt64" + // | TInt128 -> "Int128" + // | TUInt128 -> "UInt128" + + // | TFloat -> "Float" + // | TChar -> "Char" | TString -> "String" - | TDateTime -> "DateTime" - | TUuid -> "Uuid" + // | TDateTime -> "DateTime" + // | TUuid -> "Uuid" - | TList nested -> $"List<{typeName nested}>" - | TTuple(n1, n2, rest) -> - let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " - $"({nested})" - | TDict nested -> $"Dict<{typeName nested}>" + // | TList nested -> $"List<{typeName nested}>" + // | TTuple(n1, n2, rest) -> + // let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " + // $"({nested})" + // | TDict nested -> $"Dict<{typeName nested}>" | TFn _ -> "Function" - | TCustomType(Error _nre, _) -> "(Error during function resolution)" - | TCustomType(Ok t, typeArgs) -> - let typeArgsPortion = - match typeArgs with - | [] -> "" - | args -> - args - |> List.map (fun t -> typeName t) - |> String.concat ", " - |> fun betweenBrackets -> "<" + betweenBrackets + ">" - FQTypeName.toString t + typeArgsPortion + // | TCustomType(Error _nre, _) -> "(Error during function resolution)" + // | TCustomType(Ok t, typeArgs) -> + // let typeArgsPortion = + // match typeArgs with + // | [] -> "" + // | args -> + // args + // |> List.map (fun t -> typeName t) + // |> String.concat ", " + // |> fun betweenBrackets -> "<" + betweenBrackets + ">" + // FQTypeName.toString t + typeArgsPortion - | TDB _ -> "Datastore" - | TVariable varname -> $"'{varname}" + // | TDB _ -> "Datastore" + // | TVariable varname -> $"'{varname}" let rec private knownTypeName (vt : KnownType) : string = match vt with - | KTInt64 -> "Int64" - | KTUInt64 -> "UInt64" - | KTInt8 -> "Int8" - | KTUInt8 -> "UInt8" - | KTInt16 -> "Int16" - | KTUInt16 -> "UInt16" - | KTInt32 -> "Int32" - | KTUInt32 -> "UInt32" - | KTInt128 -> "Int128" - | KTUInt128 -> "UInt128" - | KTFloat -> "Float" - | KTBool -> "Bool" | KTUnit -> "Unit" - | KTChar -> "Char" + + | KTBool -> "Bool" + + // | KTInt8 -> "Int8" + // | KTUInt8 -> "UInt8" + // | KTInt16 -> "Int16" + // | KTUInt16 -> "UInt16" + // | KTInt32 -> "Int32" + // | KTUInt32 -> "UInt32" + | KTInt64 -> "Int64" + // | KTUInt64 -> "UInt64" + // | KTInt128 -> "Int128" + // | KTUInt128 -> "UInt128" + + // | KTFloat -> "Float" + + // | KTChar -> "Char" | KTString -> "String" - | KTDateTime -> "DateTime" - | KTUuid -> "Uuid" - | KTList typ -> $"List<{valueTypeName typ}>" - | KTDict typ -> $"Dict<{valueTypeName typ}>" - | KTDB typ -> $"Datastore<{valueTypeName typ}>" + // | KTDateTime -> "DateTime" + // | KTUuid -> "Uuid" + + // | KTList typ -> $"List<{valueTypeName typ}>" + // | KTDict typ -> $"Dict<{valueTypeName typ}>" + // | KTDB typ -> $"Datastore<{valueTypeName typ}>" | KTFn(argTypes, retType) -> (NEList.toList argTypes) @ [ retType ] |> List.map valueTypeName |> String.concat " -> " - | KTTuple(t1, t2, trest) -> - t1 :: t2 :: trest - |> List.map valueTypeName - |> String.concat ", " - |> fun s -> $"({s})" + // | KTTuple(t1, t2, trest) -> + // t1 :: t2 :: trest + // |> List.map valueTypeName + // |> String.concat ", " + // |> fun s -> $"({s})" - | KTCustomType(name, typeArgs) -> - let typeArgsPortion = - match typeArgs with - | [] -> "" - | args -> - args - |> List.map (fun t -> valueTypeName t) - |> String.concat ", " - |> fun betweenBrackets -> "<" + betweenBrackets + ">" + // | KTCustomType(name, typeArgs) -> + // let typeArgsPortion = + // match typeArgs with + // | [] -> "" + // | args -> + // args + // |> List.map (fun t -> valueTypeName t) + // |> String.concat ", " + // |> fun betweenBrackets -> "<" + betweenBrackets + ">" - FQTypeName.toString name + typeArgsPortion + // FQTypeName.toString name + typeArgsPortion and private valueTypeName (typ : ValueType) : string = match typ with @@ -116,13 +121,13 @@ let toTypeName (dv : Dval) : string = dv |> Dval.toValueType |> valueTypeName /// or other places a developer could rely on it (i.e. telemetry and error /// messages are OK) let toRepr (dv : Dval) : string = - let rec toRepr_ (indent : int) (dv : Dval) : string = - let makeSpaces len = "".PadRight(len, ' ') - let nl = "\n" + makeSpaces indent - let inl = "\n" + makeSpaces (indent + 2) - let indent = indent + 2 - let typename = toTypeName dv - let wrap str = $"<{typename}: {str}>" + let rec toRepr_ (_indent : int) (dv : Dval) : string = + // let makeSpaces len = "".PadRight(len, ' ') + // let nl = "\n" + makeSpaces indent + // let inl = "\n" + makeSpaces (indent + 2) + // let indent = indent + 2 + //let typename = toTypeName dv + // let wrap str = $"<{typename}: {str}>" match dv with | DUnit -> "()" @@ -130,114 +135,114 @@ let toRepr (dv : Dval) : string = | DBool true -> "true" | DBool false -> "false" - | DInt8 i -> string i - | DUInt8 i -> string i - | DInt16 i -> string i - | DUInt16 i -> string i - | DInt32 i -> string i - | DUInt32 i -> string i + // | DInt8 i -> string i + // | DUInt8 i -> string i + // | DInt16 i -> string i + // | DUInt16 i -> string i + // | DInt32 i -> string i + // | DUInt32 i -> string i | DInt64 i -> string i - | DUInt64 i -> string i - | DInt128 i -> string i - | DUInt128 i -> string i - - | DFloat f -> - if System.Double.IsPositiveInfinity f then - "Infinity" - else if System.Double.IsNegativeInfinity f then - "-Infinity" - else if System.Double.IsNaN f then - "NaN" - else - let result = sprintf "%.12g" f - if result.Contains "." then result else $"{result}.0" - - | DChar c -> $"'{c}'" + // | DUInt64 i -> string i + // | DInt128 i -> string i + // | DUInt128 i -> string i + + // | DFloat f -> + // if System.Double.IsPositiveInfinity f then + // "Infinity" + // else if System.Double.IsNegativeInfinity f then + // "-Infinity" + // else if System.Double.IsNaN f then + // "NaN" + // else + // let result = sprintf "%.12g" f + // if result.Contains "." then result else $"{result}.0" + + // | DChar c -> $"'{c}'" | DString s -> $"\"{s}\"" - | DDateTime d -> wrap (DarkDateTime.toIsoString d) - | DDB name -> wrap name - | DUuid uuid -> wrap (string uuid) - - | DList(_, l) -> - if List.isEmpty l then - wrap "[]" - else - let elems = String.concat ", " (List.map (toRepr_ indent) l) - $"[{inl}{elems}{nl}]" - - | DTuple(first, second, theRest) -> - let l = [ first; second ] @ theRest - let short = String.concat ", " (List.map (toRepr_ indent) l) - - if String.length short <= 80 then - $"({short})" - else - let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l) - $"({inl}{long}{nl})" - - - | DDict(_valueTypeTODO, o) -> - if Map.isEmpty o then - "{}" - else - let strs = - o - |> Map.toList - |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) - - let elems = String.concat $",{inl}" strs - "{" + $"{inl}{elems}{nl}" + "}" - - | DRecord(_, typeName, _typeArgsTODO, fields) -> - let fields = - fields - |> Map.toList - |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) - - let elems = String.concat $",{inl}" fields - let typeStr = FQTypeName.toString typeName - $"{typeStr} {{" + $"{inl}{elems}{nl}" + "}" - - - | DEnum(_, typeName, typeArgs, caseName, fields) -> - let typeArgsPart = - match typeArgs with - | [] -> "" - | typeArgs -> - typeArgs - |> List.map ValueType.toString - |> String.concat ", " - |> fun parts -> $"<{parts}>" - - let short = - let fieldStr = - fields - |> List.map (fun value -> toRepr_ indent value) - |> String.concat ", " - - let fieldStr = if fieldStr = "" then "" else $"({fieldStr})" - - let typeStr = FQTypeName.toString typeName - $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" - - if String.length short <= 80 then - short - else - let fieldStr = - fields - |> List.map (fun value -> toRepr_ indent value) - |> String.concat $",{inl}" - - let fieldStr = if fieldStr = "" then "" else $"({inl}{fieldStr}{nl})" - - let typeStr = FQTypeName.toString typeName - $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" + // | DDateTime d -> wrap (DarkDateTime.toIsoString d) + // | DDB name -> wrap name + // | DUuid uuid -> wrap (string uuid) + + // | DList(_, l) -> + // if List.isEmpty l then + // wrap "[]" + // else + // let elems = String.concat ", " (List.map (toRepr_ indent) l) + // $"[{inl}{elems}{nl}]" + + // | DTuple(first, second, theRest) -> + // let l = [ first; second ] @ theRest + // let short = String.concat ", " (List.map (toRepr_ indent) l) + + // if String.length short <= 80 then + // $"({short})" + // else + // let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l) + // $"({inl}{long}{nl})" + + + // | DDict(_valueTypeTODO, o) -> + // if Map.isEmpty o then + // "{}" + // else + // let strs = + // o + // |> Map.toList + // |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) + + // let elems = String.concat $",{inl}" strs + // "{" + $"{inl}{elems}{nl}" + "}" + + // | DRecord(_, typeName, _typeArgsTODO, fields) -> + // let fields = + // fields + // |> Map.toList + // |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) + + // let elems = String.concat $",{inl}" fields + // let typeStr = FQTypeName.toString typeName + // $"{typeStr} {{" + $"{inl}{elems}{nl}" + "}" + + + // | DEnum(_, typeName, typeArgs, caseName, fields) -> + // let typeArgsPart = + // match typeArgs with + // | [] -> "" + // | typeArgs -> + // typeArgs + // |> List.map ValueType.toString + // |> String.concat ", " + // |> fun parts -> $"<{parts}>" + + // let short = + // let fieldStr = + // fields + // |> List.map (fun value -> toRepr_ indent value) + // |> String.concat ", " + + // let fieldStr = if fieldStr = "" then "" else $"({fieldStr})" + + // let typeStr = FQTypeName.toString typeName + // $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" + + // if String.length short <= 80 then + // short + // else + // let fieldStr = + // fields + // |> List.map (fun value -> toRepr_ indent value) + // |> String.concat $",{inl}" + + // let fieldStr = if fieldStr = "" then "" else $"({inl}{fieldStr}{nl})" + + // let typeStr = FQTypeName.toString typeName + // $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" | DFnVal fnVal -> // TODO we can do better here. match fnVal with - | Lambda _impl -> "" + //| Lambda _impl -> "" | NamedFn name -> $"" toRepr_ 0 dv diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 1b568003b1..9f3c4fff4a 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -39,7 +39,8 @@ let createState packageManager = packageManager symbolTable = Map.empty - typeSymbolTable = Map.empty } + typeSymbolTable = Map.empty + } let executeExpr (state : RT.ExecutionState) @@ -83,90 +84,90 @@ let executeFunction } -let runtimeErrorToString - (state : RT.ExecutionState) - (rte : RT.RuntimeError) - : Task * RT.RuntimeError>> = - task { - let fnName = - RT.FQFnName.fqPackage PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toString - let args = NEList.singleton (RT.RuntimeError.toDT rte) - return! executeFunction state fnName [] args - } - - -let exprString - (state : RT.ExecutionState) - (expr : RT.Expr) - (id : Option) - : Ply = - match id with - | None -> Ply "Unknown Expr" - | Some id -> - let mutable foundExpr = None - - RuntimeTypesAst.preTraversal - (fun expr -> - if RT.Expr.toID expr = id then foundExpr <- Some expr - expr) - identity - identity - identity - identity - identity - identity - expr - |> ignore - - let prettyPrint (expr : RT.Expr) : Ply = - uply { - let fnName = - RT.FQFnName.fqPackage PackageIDs.Fn.PrettyPrinter.RuntimeTypes.expr - let args = NEList.singleton (RuntimeTypesToDarkTypes.Expr.toDT expr) - - match! executeFunction state fnName [] args with - | Ok(RT.DString s) -> return s - | _ -> return string expr - } - - match foundExpr with - | None -> - uply { - let! pretty = prettyPrint expr - return $"Root Expr:\n{pretty}" - } - | Some expr -> prettyPrint expr - - -// TODO: consider dumping symTable while we're at it. -// (beware of secrets in scope, though) -let callStackString - (state : RT.ExecutionState) - (callStack : Option) - : Ply = - match callStack with - | None -> Ply "No call stack" - | Some cs -> - let (executionPoint, exprId) = cs.lastCalled - - let handleFn (fn : Option) : Ply = - uply { - match fn with - | None -> return "" - | Some fn -> - let fnName = string fn.id - let! exprString = exprString state fn.body exprId - return fnName + ": " + exprString - } - - match executionPoint with - | RT.ExecutionPoint.Script -> Ply "Input script" - | RT.ExecutionPoint.Toplevel tlid -> Ply $"Toplevel {tlid}" - | RT.ExecutionPoint.Function fnName -> - match fnName with - | RT.FQFnName.Package name -> - state.packageManager.getFn name |> Ply.bind handleFn - | RT.FQFnName.Builtin name -> Ply $"Builtin {name}" +// let runtimeErrorToString +// (state : RT.ExecutionState) +// (rte : RT.RuntimeError) +// : Task * RT.RuntimeError>> = +// task { +// let fnName = +// RT.FQFnName.fqPackage PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toString +// let args = NEList.singleton (RT.RuntimeError.toDT rte) +// return! executeFunction state fnName [] args +// } + + +// let exprString +// (state : RT.ExecutionState) +// (expr : RT.Expr) +// (id : Option) +// : Ply = +// match id with +// | None -> Ply "Unknown Expr" +// | Some id -> +// let mutable foundExpr = None + +// RuntimeTypesAst.preTraversal +// (fun expr -> +// if RT.Expr.toID expr = id then foundExpr <- Some expr +// expr) +// identity +// identity +// identity +// identity +// identity +// identity +// expr +// |> ignore + +// let prettyPrint (expr : RT.Expr) : Ply = +// uply { +// let fnName = +// RT.FQFnName.fqPackage PackageIDs.Fn.PrettyPrinter.RuntimeTypes.expr +// let args = NEList.singleton (RuntimeTypesToDarkTypes.Expr.toDT expr) + +// match! executeFunction state fnName [] args with +// | Ok(RT.DString s) -> return s +// | _ -> return string expr +// } + +// match foundExpr with +// | None -> +// uply { +// let! pretty = prettyPrint expr +// return $"Root Expr:\n{pretty}" +// } +// | Some expr -> prettyPrint expr + + +// // TODO: consider dumping symTable while we're at it. +// // (beware of secrets in scope, though) +// let callStackString +// (state : RT.ExecutionState) +// (callStack : Option) +// : Ply = +// match callStack with +// | None -> Ply "No call stack" +// | Some cs -> +// let (executionPoint, exprId) = cs.lastCalled + +// let handleFn (fn : Option) : Ply = +// uply { +// match fn with +// | None -> return "" +// | Some fn -> +// let fnName = string fn.id +// let! exprString = exprString state fn.body exprId +// return fnName + ": " + exprString +// } + +// match executionPoint with +// | RT.ExecutionPoint.Script -> Ply "Input script" +// | RT.ExecutionPoint.Toplevel tlid -> Ply $"Toplevel {tlid}" +// | RT.ExecutionPoint.Function fnName -> +// match fnName with +// | RT.FQFnName.Package name -> +// state.packageManager.getFn name |> Ply.bind handleFn +// | RT.FQFnName.Builtin name -> Ply $"Builtin {name}" // /// Return a function to trace TLIDs (add it to state via @@ -191,23 +192,23 @@ let traceDvals () : Dictionary.T * RT.TraceDval = (results, trace) -let rec rteToString - (state : RT.ExecutionState) - (rte : RT.RuntimeError) - : Ply = - uply { - let errorMessageFn = - RT.FQFnName.fqPackage - PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage - - let rte = RT.RuntimeError.toDT rte - - let! rteMessage = executeFunction state errorMessageFn [] (NEList.ofList rte []) - - match rteMessage with - | Ok(RT.DString msg) -> return msg - | Ok(other) -> return string other - | Error(_, rte) -> - debuG "Error converting RTE to string" rte - return! rteToString state rte - } +// let rec rteToString +// (state : RT.ExecutionState) +// (rte : RT.RuntimeError) +// : Ply = +// uply { +// let errorMessageFn = +// RT.FQFnName.fqPackage +// PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage + +// let rte = RT.RuntimeError.toDT rte + +// let! rteMessage = executeFunction state errorMessageFn [] (NEList.ofList rte []) + +// match rteMessage with +// | Ok(RT.DString msg) -> return msg +// | Ok(other) -> return string other +// | Error(_, rte) -> +// debuG "Error converting RTE to string" rte +// return! rteToString state rte +// } diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 13843cacce..14d1ca630a 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -11,13 +11,16 @@ module VT = ValueType /// Gathers any global data (Secrets, DBs, etc.) /// that may be needed to evaluate an expression -let globalsFor (state : ExecutionState) : Symtable = +let globalsFor (_state : ExecutionState) : Symtable = let secrets = - state.program.secrets - |> List.map (fun (s : Secret.T) -> (s.name, DString s.value)) - |> Map.ofList + // state.program.secrets + // |> List.map (fun (s : Secret.T) -> (s.name, DString s.value)) + // |> Map.ofList + Map.empty - let dbs = Map.map (fun (db : DB.T) -> DDB db.name) state.program.dbs + let dbs = + //Map.map (fun (db : DB.T) -> DDB db.name) state.program.dbs + Map.empty Map.mergeFavoringLeft secrets dbs @@ -28,28 +31,28 @@ let withGlobals (state : ExecutionState) (symtable : Symtable) : Symtable = module ExecutionError = - module RT2DT = RuntimeTypesToDarkTypes + //module RT2DT = RuntimeTypesToDarkTypes type Error = - | MatchExprEnumPatternWrongCount of string * int * int - | MatchExprPatternWrongType of string * Dval - | MatchExprUnmatched of Dval + // | MatchExprEnumPatternWrongCount of string * int * int + // | MatchExprPatternWrongType of string * Dval + // | MatchExprUnmatched of Dval | NonStringInStringInterpolation of Dval - | ConstDoesntExist of FQConstantName.FQConstantName - | FieldAccessFieldDoesntExist of - typeName : FQTypeName.FQTypeName * - invalidFieldName : string - | RecordConstructionFieldDoesntExist of - FQTypeName.FQTypeName * - invalidFieldName : string - | RecordConstructionMissingField of - FQTypeName.FQTypeName * - missingFieldName : string - | RecordConstructionDuplicateField of - FQTypeName.FQTypeName * - duplicateFieldName : string - | FieldAccessNotRecord of ValueType * string - | EnumConstructionCaseNotFound of FQTypeName.FQTypeName * string + //| ConstDoesntExist of FQConstantName.FQConstantName + // | FieldAccessFieldDoesntExist of + // typeName : FQTypeName.FQTypeName * + // invalidFieldName : string + // | RecordConstructionFieldDoesntExist of + // FQTypeName.FQTypeName * + // invalidFieldName : string + // | RecordConstructionMissingField of + // FQTypeName.FQTypeName * + // missingFieldName : string + // | RecordConstructionDuplicateField of + // FQTypeName.FQTypeName * + // duplicateFieldName : string + // | FieldAccessNotRecord of ValueType * string + // | EnumConstructionCaseNotFound of FQTypeName.FQTypeName * string | WrongNumberOfFnArgs of fn : FQFnName.FQFnName * expectedTypeArgs : int * @@ -57,142 +60,143 @@ module ExecutionError = actualTypeArgs : int * actualArgs : int - let toDT (e : Error) : RuntimeError = - let typeName = - FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.Execution.error + let toDT (_e : Error) : RuntimeError = + // let typeName = + // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.Execution.error - let case (caseName : string) (fields : List) : RuntimeError = - DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.executionError + // let case (caseName : string) (fields : List) : RuntimeError = + // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.executionError - let (caseName, fields) = - match e with - | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> - "MatchExprEnumPatternWrongCount", - [ DString caseName; DInt64 expected; DInt64 actual ] + // let (caseName, fields) = + // match e with + // | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> + // "MatchExprEnumPatternWrongCount", + // [ DString caseName; DInt64 expected; DInt64 actual ] - | MatchExprPatternWrongType(expected, actual) -> - "MatchExprPatternWrongType", [ DString expected; RT2DT.Dval.toDT actual ] + // | MatchExprPatternWrongType(expected, actual) -> + // "MatchExprPatternWrongType", [ DString expected; RT2DT.Dval.toDT actual ] - | MatchExprUnmatched dv -> "MatchExprUnmatched", [ RT2DT.Dval.toDT dv ] + // | MatchExprUnmatched dv -> "MatchExprUnmatched", [ RT2DT.Dval.toDT dv ] - | NonStringInStringInterpolation dv -> - "NonStringInStringInterpolation", [ RT2DT.Dval.toDT dv ] + // | NonStringInStringInterpolation dv -> + // "NonStringInStringInterpolation", [ RT2DT.Dval.toDT dv ] - | ConstDoesntExist name -> - "ConstDoesntExist", [ RT2DT.FQConstantName.toDT name ] + // | ConstDoesntExist name -> + // "ConstDoesntExist", [ RT2DT.FQConstantName.toDT name ] - | FieldAccessFieldDoesntExist(typeName, invalidFieldName) -> - "FieldAccessFieldDoesntExist", - [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] + // | FieldAccessFieldDoesntExist(typeName, invalidFieldName) -> + // "FieldAccessFieldDoesntExist", + // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - | FieldAccessNotRecord(vt, fieldName) -> - "FieldAccessNotRecord", [ RT2DT.ValueType.toDT vt; DString fieldName ] + // | FieldAccessNotRecord(vt, fieldName) -> + // "FieldAccessNotRecord", [ RT2DT.ValueType.toDT vt; DString fieldName ] - | EnumConstructionCaseNotFound(typeName, caseName) -> - "EnumConstructionCaseNotFound", - [ RT2DT.FQTypeName.toDT typeName; DString caseName ] + // | EnumConstructionCaseNotFound(typeName, caseName) -> + // "EnumConstructionCaseNotFound", + // [ RT2DT.FQTypeName.toDT typeName; DString caseName ] - | WrongNumberOfFnArgs(fn, - expectedTypeArgs, - expectedArgs, - actualTypeArgs, - actualArgs) -> - "WrongNumberOfFnArgs", - [ RT2DT.FQFnName.toDT fn - DInt64 expectedTypeArgs - DInt64 expectedArgs - DInt64 actualTypeArgs - DInt64 actualArgs ] + // | WrongNumberOfFnArgs(fn, + // expectedTypeArgs, + // expectedArgs, + // actualTypeArgs, + // actualArgs) -> + // "WrongNumberOfFnArgs", + // [ RT2DT.FQFnName.toDT fn + // DInt64 expectedTypeArgs + // DInt64 expectedArgs + // DInt64 actualTypeArgs + // DInt64 actualArgs ] - | RecordConstructionFieldDoesntExist(typeName, invalidFieldName) -> - "RecordConstructionFieldDoesntExist", - [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] + // | RecordConstructionFieldDoesntExist(typeName, invalidFieldName) -> + // "RecordConstructionFieldDoesntExist", + // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - | RecordConstructionMissingField(typeName, missingFieldName) -> - "RecordConstructionMissingField", - [ RT2DT.FQTypeName.toDT typeName; DString missingFieldName ] + // | RecordConstructionMissingField(typeName, missingFieldName) -> + // "RecordConstructionMissingField", + // [ RT2DT.FQTypeName.toDT typeName; DString missingFieldName ] - | RecordConstructionDuplicateField(typeName, duplicateFieldName) -> - "RecordConstructionDuplicateField", - [ RT2DT.FQTypeName.toDT typeName; DString duplicateFieldName ] + // | RecordConstructionDuplicateField(typeName, duplicateFieldName) -> + // "RecordConstructionDuplicateField", + // [ RT2DT.FQTypeName.toDT typeName; DString duplicateFieldName ] - case caseName fields + // case caseName fields + RuntimeError.oldError "TODO" let raise (callStack : CallStack) (e : Error) : 'a = toDT e |> raiseRTE callStack -let rec evalConst (callStack : CallStack) (c : Const) : Dval = - let r = evalConst callStack +// let rec evalConst (callStack : CallStack) (c : Const) : Dval = +// let r = evalConst callStack - match c with - | CUnit -> DUnit - | CBool b -> DBool b +// match c with +// | CUnit -> DUnit +// | CBool b -> DBool b - | CInt8 i -> DInt8 i - | CUInt8 i -> DUInt8 i - | CInt16 i -> DInt16 i - | CUInt16 i -> DUInt16 i - | CInt32 i -> DInt32 i - | CUInt32 i -> DUInt32 i - | CInt64 i -> DInt64 i - | CUInt64 i -> DUInt64 i - | CInt128 i -> DInt128 i - | CUInt128 i -> DUInt128 i +// | CInt8 i -> DInt8 i +// | CUInt8 i -> DUInt8 i +// | CInt16 i -> DInt16 i +// | CUInt16 i -> DUInt16 i +// | CInt32 i -> DInt32 i +// | CUInt32 i -> DUInt32 i +// | CInt64 i -> DInt64 i +// | CUInt64 i -> DUInt64 i +// | CInt128 i -> DInt128 i +// | CUInt128 i -> DUInt128 i - | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) +// | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) - | CChar c -> DChar c - | CString s -> DString s +// | CChar c -> DChar c +// | CString s -> DString s - | CList items -> DList(ValueType.Unknown, (List.map r items)) - | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) - | CDict items -> - DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) +// | CList items -> DList(ValueType.Unknown, (List.map r items)) +// | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) +// | CDict items -> +// DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) - | CEnum(Ok typeName, caseName, fields) -> - // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the - DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) +// | CEnum(Ok typeName, caseName, fields) -> +// // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the +// DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) - | CEnum(Error msg, _caseName, _fields) -> - raiseRTE callStack (RuntimeError.oldError $"Invalid const name: {msg}") +// | CEnum(Error msg, _caseName, _fields) -> +// raiseRTE callStack (RuntimeError.oldError $"Invalid const name: {msg}") -/// Used in the ELet and ELambda evals -/// Answers: does the `dval` "match" the given pattern? -/// -/// Returns: -/// - whether or not the expr 'matches' the pattern -/// - new vars (name * value) -let rec checkPattern - (callStack : CallStack) - (dv : Dval) - (pattern : LetPattern) - : List = +// /// Used in the ELet and ELambda evals +// /// Answers: does the `dval` "match" the given pattern? +// /// +// /// Returns: +// /// - whether or not the expr 'matches' the pattern +// /// - new vars (name * value) +// let rec checkPattern +// (callStack : CallStack) +// (dv : Dval) +// (pattern : LetPattern) +// : List = - let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) - let chPat = checkPattern callStack +// let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) +// let chPat = checkPattern callStack - match pattern with +// match pattern with - | LPVariable(_, varName) -> [ (varName, dv) ] +// | LPVariable(_, varName) -> [ (varName, dv) ] - | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] +// | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] - | LPTuple(_, firstPat, secondPat, theRestPat) -> - let allPatterns = firstPat :: secondPat :: theRestPat +// | LPTuple(_, firstPat, secondPat, theRestPat) -> +// let allPatterns = firstPat :: secondPat :: theRestPat - match dv with - | DTuple(first, second, theRest) -> - let allVals = first :: second :: theRest +// match dv with +// | DTuple(first, second, theRest) -> +// let allVals = first :: second :: theRest - if List.length allVals = List.length allPatterns then - List.zip allVals allPatterns - |> List.map (fun (dv, pat) -> chPat dv pat) - |> List.concat - else - errStr "Tuple pattern has wrong number of elements" - | _ -> errStr "Tuple pattern does not match" +// if List.length allVals = List.length allPatterns then +// List.zip allVals allPatterns +// |> List.map (fun (dv, pat) -> chPat dv pat) +// |> List.concat +// else +// errStr "Tuple pattern has wrong number of elements" +// | _ -> errStr "Tuple pattern does not match" // fsharplint:disable FL0039 @@ -206,118 +210,118 @@ let typeResolutionError error |> NameResolutionError.RTE.toRuntimeError |> raiseRTE callStack -let recordMaybe - (callStack : CallStack) - (types : Types) - (typeName : FQTypeName.FQTypeName) - // TypeName, typeParam list, fully-resolved (except for typeParam) field list - : Ply * List> = - let rec inner (typeName : FQTypeName.FQTypeName) = - uply { - match! Types.find typeName types with - | Some({ typeParams = outerTypeParams - definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), - outerTypeArgs)) }) -> - // Here we have found an alias, so we need to combine the type's - // typeArgs with the aliased type's typeParams. - // e.g. in - // `type Var = Result` - // we need to combine Var's typeArgs () with Result's - // typeParams (<`Ok, `Error>) - // - // To do this, we use typeArgs from the alias definition - // (outerTypeArgs) and apply them to the aliased type - // (innerTypeName)'s params (which are returned from the lookup and - // used as innerTypeParams below). - // Example: suppose we have - // type Outer<'a> = Inner<'a, Int> - // type Inner<'x, 'y> = { x : 'x; y : 'y } - // The recursive search for Inner will get: - // innerTypeName = "Inner" - // innerTypeParams = ["x"; "y"] - // fields = [("x", TVar "x"); ("y", TVar "y")] - // The Outer definition provides: - // outerTypeArgs = [TVar "a"; TInt64] - // We combine this with innerTypeParams to get: - // fields = [("x", TVar "a"); ("y", TInt64)] - // outerTypeParams = ["a"] - // So the effective result of this is: - // type Outer<'a> = { x : 'a; y : Int } - let! (innerTypeName, innerTypeParams, fields) = inner innerTypeName - return - (innerTypeName, - outerTypeParams, - fields - |> List.map (fun (k, v) -> - (k, Types.substitute innerTypeParams outerTypeArgs v))) - - | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> - return raiseRTE callStack e - - | Some({ typeParams = typeParams; definition = TypeDeclaration.Record fields }) -> - return - (typeName, - typeParams, - fields |> NEList.toList |> List.map (fun f -> f.name, f.typ)) - - | Some({ definition = TypeDeclaration.Alias(_) }) - | Some({ definition = TypeDeclaration.Enum _ }) -> - let packageTypeID = - match typeName with - | FQTypeName.FQTypeName.Package id -> id - return! - typeResolutionError - callStack - (NameResolutionError.ExpectedRecordButNot packageTypeID) - - | None -> - return! typeResolutionError callStack (NameResolutionError.NotFound []) - } - inner typeName - - -let enumMaybe - (callStack : CallStack) - (types : Types) - (typeName : FQTypeName.FQTypeName) - : Ply * NEList> = - let rec inner (typeName : FQTypeName.FQTypeName) = - uply { - match! Types.find typeName types with - | Some({ typeParams = outerTypeParams - definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), - outerTypeArgs)) }) -> - let! (innerTypeName, innerTypeParams, cases) = inner innerTypeName - return - (innerTypeName, - outerTypeParams, - cases - |> NEList.map (fun (c : TypeDeclaration.EnumCase) -> - { c with - fields = - List.map - (Types.substitute innerTypeParams outerTypeArgs) - c.fields })) - - | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> - return raiseRTE callStack e - - | Some({ typeParams = typeParams; definition = TypeDeclaration.Enum cases }) -> - return (typeName, typeParams, cases) - - | Some({ definition = TypeDeclaration.Alias _ }) - | Some({ definition = TypeDeclaration.Record _ }) -> - let packageTypeID = - match typeName with - | FQTypeName.FQTypeName.Package id -> id - return! - typeResolutionError - callStack - (NameResolutionError.ExpectedEnumButNot packageTypeID) - | None -> - return! typeResolutionError callStack (NameResolutionError.NotFound []) // typeName - } - inner typeName +// let recordMaybe +// (callStack : CallStack) +// (types : Types) +// (typeName : FQTypeName.FQTypeName) +// // TypeName, typeParam list, fully-resolved (except for typeParam) field list +// : Ply * List> = +// let rec inner (typeName : FQTypeName.FQTypeName) = +// uply { +// match! Types.find typeName types with +// | Some({ typeParams = outerTypeParams +// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), +// outerTypeArgs)) }) -> +// // Here we have found an alias, so we need to combine the type's +// // typeArgs with the aliased type's typeParams. +// // e.g. in +// // `type Var = Result` +// // we need to combine Var's typeArgs () with Result's +// // typeParams (<`Ok, `Error>) +// // +// // To do this, we use typeArgs from the alias definition +// // (outerTypeArgs) and apply them to the aliased type +// // (innerTypeName)'s params (which are returned from the lookup and +// // used as innerTypeParams below). +// // Example: suppose we have +// // type Outer<'a> = Inner<'a, Int> +// // type Inner<'x, 'y> = { x : 'x; y : 'y } +// // The recursive search for Inner will get: +// // innerTypeName = "Inner" +// // innerTypeParams = ["x"; "y"] +// // fields = [("x", TVar "x"); ("y", TVar "y")] +// // The Outer definition provides: +// // outerTypeArgs = [TVar "a"; TInt64] +// // We combine this with innerTypeParams to get: +// // fields = [("x", TVar "a"); ("y", TInt64)] +// // outerTypeParams = ["a"] +// // So the effective result of this is: +// // type Outer<'a> = { x : 'a; y : Int } +// let! (innerTypeName, innerTypeParams, fields) = inner innerTypeName +// return +// (innerTypeName, +// outerTypeParams, +// fields +// |> List.map (fun (k, v) -> +// (k, Types.substitute innerTypeParams outerTypeArgs v))) + +// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> +// return raiseRTE callStack e + +// | Some({ typeParams = typeParams; definition = TypeDeclaration.Record fields }) -> +// return +// (typeName, +// typeParams, +// fields |> NEList.toList |> List.map (fun f -> f.name, f.typ)) + +// | Some({ definition = TypeDeclaration.Alias(_) }) +// | Some({ definition = TypeDeclaration.Enum _ }) -> +// let packageTypeID = +// match typeName with +// | FQTypeName.FQTypeName.Package id -> id +// return! +// typeResolutionError +// callStack +// (NameResolutionError.ExpectedRecordButNot packageTypeID) + +// | None -> +// return! typeResolutionError callStack (NameResolutionError.NotFound []) +// } +// inner typeName + + +// let enumMaybe +// (callStack : CallStack) +// (types : Types) +// (typeName : FQTypeName.FQTypeName) +// : Ply * NEList> = +// let rec inner (typeName : FQTypeName.FQTypeName) = +// uply { +// match! Types.find typeName types with +// | Some({ typeParams = outerTypeParams +// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), +// outerTypeArgs)) }) -> +// let! (innerTypeName, innerTypeParams, cases) = inner innerTypeName +// return +// (innerTypeName, +// outerTypeParams, +// cases +// |> NEList.map (fun (c : TypeDeclaration.EnumCase) -> +// { c with +// fields = +// List.map +// (Types.substitute innerTypeParams outerTypeArgs) +// c.fields })) + +// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> +// return raiseRTE callStack e + +// | Some({ typeParams = typeParams; definition = TypeDeclaration.Enum cases }) -> +// return (typeName, typeParams, cases) + +// | Some({ definition = TypeDeclaration.Alias _ }) +// | Some({ definition = TypeDeclaration.Record _ }) -> +// let packageTypeID = +// match typeName with +// | FQTypeName.FQTypeName.Package id -> id +// return! +// typeResolutionError +// callStack +// (NameResolutionError.ExpectedEnumButNot packageTypeID) +// | None -> +// return! typeResolutionError callStack (NameResolutionError.NotFound []) // typeName +// } +// inner typeName /// Interprets an expression and reduces it to a Dark value @@ -337,7 +341,7 @@ let rec eval (state : ExecutionState) (e : Expr) : DvalTask = // Some helper fns to make it easier to raise RTEs let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) - let err callStack rte : 'a = raiseRTE callStack rte + //let err callStack rte : 'a = raiseRTE callStack rte let raiseExeRTE callStack (e : ExecutionError.Error) : Ply<'a> = ExecutionError.raise callStack e @@ -347,20 +351,20 @@ let rec eval (state : ExecutionState) (e : Expr) : DvalTask = | EBool(_, b) -> return DBool b - | EInt8(_, i) -> return DInt8 i - | EUInt8(_, i) -> return DUInt8 i - | EInt16(_, i) -> return DInt16 i - | EUInt16(_, i) -> return DUInt16 i - | EInt32(_, i) -> return DInt32 i - | EUInt32(_, i) -> return DUInt32 i + // | EInt8(_, i) -> return DInt8 i + // | EUInt8(_, i) -> return DUInt8 i + // | EInt16(_, i) -> return DInt16 i + // | EUInt16(_, i) -> return DUInt16 i + // | EInt32(_, i) -> return DInt32 i + // | EUInt32(_, i) -> return DUInt32 i | EInt64(_, i) -> return DInt64 i - | EUInt64(_, i) -> return DUInt64 i - | EInt128(_, i) -> return DInt128 i - | EUInt128(_, i) -> return DUInt128 i + // | EUInt64(_, i) -> return DUInt64 i + // | EInt128(_, i) -> return DInt128 i + // | EUInt128(_, i) -> return DUInt128 i - | EFloat(_, value) -> return DFloat value + // | EFloat(_, value) -> return DFloat value - | EChar(_, s) -> return DChar s + // | EChar(_, s) -> return DChar s | EString(_, [ StringText s ]) -> // We expect strings to be normalized during parsing @@ -385,161 +389,161 @@ let rec eval (state : ExecutionState) (e : Expr) : DvalTask = return segments |> String.concat "" |> String.normalize |> DString - | EConstant(_, name) -> - match name with - | FQConstantName.Builtin c -> - match Map.find c state.builtins.constants with - | None -> - return! - ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - | Some constant -> return constant.body - - | FQConstantName.Package c -> - match! state.packageManager.getConstant c with - | None -> - return! - ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - | Some constant -> return evalConst callStack constant.body - - - | ELet(_, pattern, rhs, body) -> - let! rhs = eval state rhs - let newDefs = checkPattern callStack rhs pattern - let newSymtable = Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - - return! eval { state with symbolTable = newSymtable } body - - | EList(_, exprs) -> - let! results = Ply.List.mapSequentially (eval state) exprs - return TypeChecker.DvalCreator.list callStack VT.unknown results - - | ETuple(_, first, second, theRest) -> - let! firstResult = eval state first - let! secondResult = eval state second - let! otherResults = Ply.List.mapSequentially (eval state) theRest - return DTuple(firstResult, secondResult, otherResults) - - | EVariable(_, name) -> - match Map.find name state.symbolTable with - | None -> return errStr callStack $"There is no variable named: {name}" - | Some other -> return other - - - | ERecord(_, typeName, fields) -> - let types = ExecutionState.availableTypes state - - let! (aliasTypeName, _typeParams, expectedFields) = - recordMaybe callStack types typeName - let expectedFields = Map expectedFields - - let! fields = - fields - |> NEList.toList - |> Ply.List.foldSequentially - (fun fields (fieldName, expr) -> - uply { - match Map.find fieldName expectedFields with - | None -> - return - ExecutionError.raise - callStack - (ExecutionError.RecordConstructionFieldDoesntExist( - typeName, - fieldName - )) - | Some fieldType -> - let! v = eval state expr - if Map.containsKey fieldName fields then - return - ExecutionError.raise - callStack - (ExecutionError.RecordConstructionDuplicateField( - typeName, - fieldName - )) - - else - let context = - TypeChecker.RecordField(typeName, fieldName, fieldType) - let check = TypeChecker.unify context types Map.empty fieldType v - match! check with - | Ok() -> return Map.add fieldName v fields - | Error e -> return err callStack e - }) - Map.empty - - if Map.count fields = Map.count expectedFields then - return DRecord(aliasTypeName, typeName, VT.typeArgsTODO, fields) - else - let expectedFields = Map.keys expectedFields - let fieldName = - Seq.find (fun k -> not (Map.containsKey k fields)) expectedFields - return - ExecutionError.raise - callStack - (ExecutionError.RecordConstructionMissingField(typeName, fieldName)) - - - | ERecordUpdate(_, baseRecord, updates) -> - // CLEANUP refactor this impl - // namely, focus more on the `fields` and don't pass around DRecord so much - - let! baseRecord = eval state baseRecord - match baseRecord with - | DRecord(typeName, _, typ, _) -> - let typeStr = FQTypeName.toString typeName - let types = ExecutionState.availableTypes state - - let! (_, _, expected) = recordMaybe callStack types typeName - let expectedFields = Map expected - return! - updates - |> NEList.toList - |> Ply.List.foldSequentially - (fun record (fieldName, expr) -> - uply { - let! dv = eval state expr - - match record, fieldName, dv with - | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" - | _, _, _ when not (Map.containsKey fieldName expectedFields) -> - return - ExecutionError.raise - callStack - (ExecutionError.RecordConstructionFieldDoesntExist( - typeName, - fieldName - )) - - | DRecord(typeName, original, _, m), fieldName, dv -> - let fieldType = Map.findUnsafe fieldName expectedFields - - let context = - TypeChecker.RecordField(typeName, fieldName, fieldType) - - match! TypeChecker.unify context types Map.empty fieldType dv with - | Ok() -> - return DRecord(typeName, original, typ, Map.add fieldName dv m) - | Error rte -> return raiseRTE callStack rte - - | _ -> - return - errStr - callStack - $"Expected a record but {typeStr} is something else" - }) - baseRecord - | _ -> return errStr callStack "Expected a record in record update" - - | EDict(_, fields) -> - let! fields = - fields - |> Ply.List.mapSequentially (fun (k, v) -> - uply { - let! v = eval state v - return (k, v) - }) - return TypeChecker.DvalCreator.dict ValueType.Unknown fields + // | EConstant(_, name) -> + // match name with + // | FQConstantName.Builtin c -> + // match Map.find c state.builtins.constants with + // | None -> + // return! + // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) + // | Some constant -> return constant.body + + // | FQConstantName.Package c -> + // match! state.packageManager.getConstant c with + // | None -> + // return! + // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) + // | Some constant -> return evalConst callStack constant.body + + + // | ELet(_, pattern, rhs, body) -> + // let! rhs = eval state rhs + // let newDefs = checkPattern callStack rhs pattern + // let newSymtable = Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) + + // return! eval { state with symbolTable = newSymtable } body + + // | EList(_, exprs) -> + // let! results = Ply.List.mapSequentially (eval state) exprs + // return TypeChecker.DvalCreator.list callStack VT.unknown results + + // | ETuple(_, first, second, theRest) -> + // let! firstResult = eval state first + // let! secondResult = eval state second + // let! otherResults = Ply.List.mapSequentially (eval state) theRest + // return DTuple(firstResult, secondResult, otherResults) + + // | EVariable(_, name) -> + // match Map.find name state.symbolTable with + // | None -> return errStr callStack $"There is no variable named: {name}" + // | Some other -> return other + + + // | ERecord(_, typeName, fields) -> + // let types = ExecutionState.availableTypes state + + // let! (aliasTypeName, _typeParams, expectedFields) = + // recordMaybe callStack types typeName + // let expectedFields = Map expectedFields + + // let! fields = + // fields + // |> NEList.toList + // |> Ply.List.foldSequentially + // (fun fields (fieldName, expr) -> + // uply { + // match Map.find fieldName expectedFields with + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionFieldDoesntExist( + // typeName, + // fieldName + // )) + // | Some fieldType -> + // let! v = eval state expr + // if Map.containsKey fieldName fields then + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionDuplicateField( + // typeName, + // fieldName + // )) + + // else + // let context = + // TypeChecker.RecordField(typeName, fieldName, fieldType) + // let check = TypeChecker.unify context types Map.empty fieldType v + // match! check with + // | Ok() -> return Map.add fieldName v fields + // | Error e -> return err callStack e + // }) + // Map.empty + + // if Map.count fields = Map.count expectedFields then + // return DRecord(aliasTypeName, typeName, VT.typeArgsTODO, fields) + // else + // let expectedFields = Map.keys expectedFields + // let fieldName = + // Seq.find (fun k -> not (Map.containsKey k fields)) expectedFields + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionMissingField(typeName, fieldName)) + + + // | ERecordUpdate(_, baseRecord, updates) -> + // // CLEANUP refactor this impl + // // namely, focus more on the `fields` and don't pass around DRecord so much + + // let! baseRecord = eval state baseRecord + // match baseRecord with + // | DRecord(typeName, _, typ, _) -> + // let typeStr = FQTypeName.toString typeName + // let types = ExecutionState.availableTypes state + + // let! (_, _, expected) = recordMaybe callStack types typeName + // let expectedFields = Map expected + // return! + // updates + // |> NEList.toList + // |> Ply.List.foldSequentially + // (fun record (fieldName, expr) -> + // uply { + // let! dv = eval state expr + + // match record, fieldName, dv with + // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" + // | _, _, _ when not (Map.containsKey fieldName expectedFields) -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionFieldDoesntExist( + // typeName, + // fieldName + // )) + + // | DRecord(typeName, original, _, m), fieldName, dv -> + // let fieldType = Map.findUnsafe fieldName expectedFields + + // let context = + // TypeChecker.RecordField(typeName, fieldName, fieldType) + + // match! TypeChecker.unify context types Map.empty fieldType dv with + // | Ok() -> + // return DRecord(typeName, original, typ, Map.add fieldName dv m) + // | Error rte -> return raiseRTE callStack rte + + // | _ -> + // return + // errStr + // callStack + // $"Expected a record but {typeStr} is something else" + // }) + // baseRecord + // | _ -> return errStr callStack "Expected a record in record update" + + // | EDict(_, fields) -> + // let! fields = + // fields + // |> Ply.List.mapSequentially (fun (k, v) -> + // uply { + // let! v = eval state v + // return (k, v) + // }) + // return TypeChecker.DvalCreator.dict ValueType.Unknown fields | EFnName(_, name) -> return DFnVal(NamedFn name) @@ -555,343 +559,343 @@ let rec eval (state : ExecutionState) (e : Expr) : DvalTask = $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" - | EFieldAccess(_, e, fieldName) -> - let! obj = eval state e - - if fieldName = "" then - return errStr callStack "Field name is empty" - else - match obj with - | DRecord(_, typeName, _, fields) -> - match Map.find fieldName fields with - | Some v -> return v - | None -> - return - ExecutionError.raise - callStack - (ExecutionError.FieldAccessFieldDoesntExist(typeName, fieldName)) - | DDB _ -> - let msg = - $"Attempting to access field '{fieldName}' of a Datastore " - + "(use `DB.*` standard library functions to interact with Datastores. " - + "Field access only work with records)" - return errStr callStack msg - | _ -> - - return - ExecutionError.raise - callStack - (ExecutionError.FieldAccessNotRecord(Dval.toValueType obj, fieldName)) - - - | ELambda(_, parameters, body) -> - // It is the responsibility of wherever executes the DBlock to pass in - // args and execute the body. - return - DFnVal( - Lambda - { typeSymbolTable = state.typeSymbolTable - symtable = state.symbolTable - parameters = parameters - body = body } - ) - - - | EMatch(_, matchExpr, cases) -> - /// Does the dval 'match' the given pattern? - /// - /// Returns: - /// - whether or not the expr 'matches' the pattern - /// - new vars (name * value) - let rec checkPattern - (dv : Dval) - (pattern : MatchPattern) - : Ply> = - uply { - // CLEANUP things down the line assume that the `id` in the callStack is an _Expression_ ID. - // It might be nice to also allow for MP IDs. This would require a change in the callStack here. - // let state = stateWithUpdatedCallStack (MatchPattern.toID pattern) - // let callStack = state.tracing.callStack - - let errWrongType expected = - raiseExeRTE - callStack - (ExecutionError.MatchExprPatternWrongType(expected, dv)) - - match pattern with - | MPUnit(_) -> - match dv with - | DUnit -> return true, [] - | _ -> return! errWrongType "Unit" - - | MPBool(_, pb) -> - match dv with - | DBool db -> return (db = pb), [] - | _ -> return! errWrongType "Bool" - - | MPInt8(_, pi) -> - match dv with - | DInt8 di -> return (di = pi), [] - | _ -> return! errWrongType "Int8" - | MPUInt8(_, pi) -> - match dv with - | DUInt8 di -> return (di = pi), [] - | _ -> return! errWrongType "UInt8" - | MPInt16(_, pi) -> - match dv with - | DInt16 di -> return (di = pi), [] - | _ -> return! errWrongType "Int16" - | MPUInt16(_, pi) -> - match dv with - | DUInt16 di -> return (di = pi), [] - | _ -> return! errWrongType "UInt16" - | MPInt32(_, pi) -> - match dv with - | DInt32 di -> return (di = pi), [] - | _ -> return! errWrongType "Int32" - | MPUInt32(_, pi) -> - match dv with - | DUInt32 di -> return (di = pi), [] - | _ -> return! errWrongType "UInt32" - | MPInt64(_, pi) -> - match dv with - | DInt64 di -> return (di = pi), [] - | _ -> return! errWrongType "Int64" - | MPUInt64(_, pi) -> - match dv with - | DUInt64 di -> return (di = pi), [] - | _ -> return! errWrongType "UInt64" - | MPInt128(_, pi) -> - match dv with - | DInt128 di -> return (di = pi), [] - | _ -> return! errWrongType "Int128" - | MPUInt128(_, pi) -> - match dv with - | DUInt128 di -> return (di = pi), [] - | _ -> return! errWrongType "UInt128" - - | MPFloat(_, pf) -> - match dv with - | DFloat df -> return (df = pf), [] - | _ -> return! errWrongType "Float" - - | MPChar(_, pc) -> - match dv with - | DChar dc -> return (dc = pc), [] - | _ -> return! errWrongType "Char" - | MPString(_, ps) -> - match dv with - | DString ds -> return (ds = ps), [] - | _ -> return! errWrongType "String" - - | MPEnum(_, caseName, fieldPats) -> - match dv with - | DEnum(_dTypeName, _oTypeName, _typeArgsDEnumTODO, dCaseName, dFields) -> - if caseName <> dCaseName then - return false, [] - else - let dvFieldLength = List.length dFields - match fieldPats with - // wildcard - | [ MPVariable(_, "_") ] when dvFieldLength > 0 -> return true, [] - | _ -> - let patFieldLength = List.length fieldPats - if dvFieldLength <> patFieldLength then - return! - raiseExeRTE - callStack - (ExecutionError.MatchExprEnumPatternWrongCount( - dCaseName, - patFieldLength, - dvFieldLength - )) - else - let! (passResults, newVarResults) = - List.zip dFields fieldPats - |> Ply.List.mapSequentially (fun (dv, pat) -> - checkPattern dv pat) - |> Ply.map List.unzip - - let allPass = List.forall identity passResults - let allVars = newVarResults |> List.collect identity - return allPass, allVars - - | _dv -> return! errWrongType caseName - - - | MPTuple(_, firstPat, secondPat, theRestPat) -> - let allPatterns = firstPat :: secondPat :: theRestPat - - match dv with - | DTuple(first, second, theRest) -> - let allVals = first :: second :: theRest - - if List.length allVals = List.length allPatterns then - let! (passResults, newVarResults) = - List.zip allVals allPatterns - |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - |> Ply.map List.unzip - - let allPass = List.forall identity passResults - let allVars = newVarResults |> List.collect identity - return allPass, allVars - else - return false, [] - | _ -> - // TODO: specify length? - return! errWrongType "Tuple" - - - | MPListCons(_, headPat, tailPat) -> - match dv with - | DList(_, []) -> return false, [] - | DList(vt, headVal :: tailVals) -> - let! (headPass, headVars) = checkPattern headVal headPat - let! (tailPass, tailVars) = - checkPattern - (TypeChecker.DvalCreator.list callStack vt tailVals) - tailPat - - let allSubVars = headVars @ tailVars - let pass = headPass && tailPass - return pass, allSubVars - | _ -> return! errWrongType "List" - - | MPList(_, pats) -> - match dv with - | DList(_, vals) -> - if List.length vals = List.length pats then - let! (passResults, newVarResults) = - List.zip vals pats - |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - |> Ply.map List.unzip - - let allPass = List.forall identity passResults - let allVars = newVarResults |> List.collect identity - return allPass, allVars - else - return false, [] - | _ -> return! errWrongType "List" - - | MPVariable(_, varName) -> return true, [ (varName, dv) ] - } - - - // The value we're matching against - let! matchVal = eval state matchExpr - - let mutable matchResult = None - - for case in NEList.toList cases do - if Option.isSome matchResult then - () - else - let! passesPattern, newDefs = checkPattern matchVal case.pat - let newSymtable = - Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - let state = { state with symbolTable = newSymtable } - let! passesWhenCondition = - uply { - match case.whenCondition with - | Some whenCondition when passesPattern -> - match! eval state whenCondition with - | DBool b -> return b - | _ -> return errStr callStack "When condition should be a boolean" - | _ -> return true - } - if passesPattern && passesWhenCondition then - let! r = eval state case.rhs - matchResult <- Some r - - match matchResult with - | Some r -> return r - | None -> - return! raiseExeRTE callStack (ExecutionError.MatchExprUnmatched matchVal) - - - | EIf(_, cond, thenBody, elseBody) -> - match! eval state cond with - | DBool false -> - match elseBody with - | None -> return DUnit - | Some eb -> return! eval state eb - | DBool true -> return! eval state thenBody - | _ -> return errStr callStack "If only supports Booleans" - - - | EOr(_, left, right) -> - match! eval state left with - | DBool true -> return DBool true - | DBool false -> - match! eval state right with - | DBool _ as b -> return b - | _ -> return errStr callStack "|| only supports Booleans" - | _ -> return errStr callStack "|| only supports Booleans" - - - | EAnd(_, left, right) -> - match! eval state left with - | DBool false -> return DBool false - | DBool true -> - match! eval state right with - | DBool _ as b -> return b - | _ -> return errStr callStack "&& only supports Booleans" - | _ -> return errStr callStack "&& only supports Booleans" - - - | EEnum(_, sourceTypeName, caseName, fields) -> - let types = ExecutionState.availableTypes state - - let! (resolvedTypeName, _, cases) = enumMaybe callStack types sourceTypeName - let case = cases |> NEList.find (fun c -> c.name = caseName) - - match case with - | None -> - return - ExecutionError.raise - callStack - (ExecutionError.EnumConstructionCaseNotFound(sourceTypeName, caseName)) - - | Some case -> - if case.fields.Length <> fields.Length then - let msg = - $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" - return errStr callStack msg - else - let! (fields : List) = - Ply.List.foldSequentiallyWithIndex - (fun - fieldIndex - fieldsSoFar - ((enumFieldType : TypeReference), fieldExpr) -> - uply { - let! v = eval state fieldExpr - - let context = - TypeChecker.EnumField( - sourceTypeName, - case.name, - fieldIndex, - List.length fields, - enumFieldType - ) - - // VTTODO: we should be passing in a proper tst, not Map.empty - right? - match! - TypeChecker.unify context types Map.empty enumFieldType v - with - | Ok() -> return (List.append fieldsSoFar [ v ]) - | Error rte -> return raiseRTE callStack rte - }) - [] - (List.zip case.fields fields) - - return! - TypeChecker.DvalCreator.enum - resolvedTypeName - sourceTypeName - caseName - fields + // | EFieldAccess(_, e, fieldName) -> + // let! obj = eval state e + + // if fieldName = "" then + // return errStr callStack "Field name is empty" + // else + // match obj with + // | DRecord(_, typeName, _, fields) -> + // match Map.find fieldName fields with + // | Some v -> return v + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.FieldAccessFieldDoesntExist(typeName, fieldName)) + // | DDB _ -> + // let msg = + // $"Attempting to access field '{fieldName}' of a Datastore " + // + "(use `DB.*` standard library functions to interact with Datastores. " + // + "Field access only work with records)" + // return errStr callStack msg + // | _ -> + + // return + // ExecutionError.raise + // callStack + // (ExecutionError.FieldAccessNotRecord(Dval.toValueType obj, fieldName)) + + + // | ELambda(_, parameters, body) -> + // // It is the responsibility of wherever executes the DBlock to pass in + // // args and execute the body. + // return + // DFnVal( + // Lambda + // { typeSymbolTable = state.typeSymbolTable + // symtable = state.symbolTable + // parameters = parameters + // body = body } + // ) + + + // | EMatch(_, matchExpr, cases) -> + // /// Does the dval 'match' the given pattern? + // /// + // /// Returns: + // /// - whether or not the expr 'matches' the pattern + // /// - new vars (name * value) + // let rec checkPattern + // (dv : Dval) + // (pattern : MatchPattern) + // : Ply> = + // uply { + // // CLEANUP things down the line assume that the `id` in the callStack is an _Expression_ ID. + // // It might be nice to also allow for MP IDs. This would require a change in the callStack here. + // // let state = stateWithUpdatedCallStack (MatchPattern.toID pattern) + // // let callStack = state.tracing.callStack + + // let errWrongType expected = + // raiseExeRTE + // callStack + // (ExecutionError.MatchExprPatternWrongType(expected, dv)) + + // match pattern with + // | MPUnit(_) -> + // match dv with + // | DUnit -> return true, [] + // | _ -> return! errWrongType "Unit" + + // | MPBool(_, pb) -> + // match dv with + // | DBool db -> return (db = pb), [] + // | _ -> return! errWrongType "Bool" + + // | MPInt8(_, pi) -> + // match dv with + // | DInt8 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int8" + // | MPUInt8(_, pi) -> + // match dv with + // | DUInt8 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt8" + // | MPInt16(_, pi) -> + // match dv with + // | DInt16 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int16" + // | MPUInt16(_, pi) -> + // match dv with + // | DUInt16 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt16" + // | MPInt32(_, pi) -> + // match dv with + // | DInt32 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int32" + // | MPUInt32(_, pi) -> + // match dv with + // | DUInt32 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt32" + // | MPInt64(_, pi) -> + // match dv with + // | DInt64 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int64" + // | MPUInt64(_, pi) -> + // match dv with + // | DUInt64 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt64" + // | MPInt128(_, pi) -> + // match dv with + // | DInt128 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int128" + // | MPUInt128(_, pi) -> + // match dv with + // | DUInt128 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt128" + + // | MPFloat(_, pf) -> + // match dv with + // | DFloat df -> return (df = pf), [] + // | _ -> return! errWrongType "Float" + + // | MPChar(_, pc) -> + // match dv with + // | DChar dc -> return (dc = pc), [] + // | _ -> return! errWrongType "Char" + // | MPString(_, ps) -> + // match dv with + // | DString ds -> return (ds = ps), [] + // | _ -> return! errWrongType "String" + + // | MPEnum(_, caseName, fieldPats) -> + // match dv with + // | DEnum(_dTypeName, _oTypeName, _typeArgsDEnumTODO, dCaseName, dFields) -> + // if caseName <> dCaseName then + // return false, [] + // else + // let dvFieldLength = List.length dFields + // match fieldPats with + // // wildcard + // | [ MPVariable(_, "_") ] when dvFieldLength > 0 -> return true, [] + // | _ -> + // let patFieldLength = List.length fieldPats + // if dvFieldLength <> patFieldLength then + // return! + // raiseExeRTE + // callStack + // (ExecutionError.MatchExprEnumPatternWrongCount( + // dCaseName, + // patFieldLength, + // dvFieldLength + // )) + // else + // let! (passResults, newVarResults) = + // List.zip dFields fieldPats + // |> Ply.List.mapSequentially (fun (dv, pat) -> + // checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + + // | _dv -> return! errWrongType caseName + + + // | MPTuple(_, firstPat, secondPat, theRestPat) -> + // let allPatterns = firstPat :: secondPat :: theRestPat + + // match dv with + // | DTuple(first, second, theRest) -> + // let allVals = first :: second :: theRest + + // if List.length allVals = List.length allPatterns then + // let! (passResults, newVarResults) = + // List.zip allVals allPatterns + // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + // else + // return false, [] + // | _ -> + // // TODO: specify length? + // return! errWrongType "Tuple" + + + // | MPListCons(_, headPat, tailPat) -> + // match dv with + // | DList(_, []) -> return false, [] + // | DList(vt, headVal :: tailVals) -> + // let! (headPass, headVars) = checkPattern headVal headPat + // let! (tailPass, tailVars) = + // checkPattern + // (TypeChecker.DvalCreator.list callStack vt tailVals) + // tailPat + + // let allSubVars = headVars @ tailVars + // let pass = headPass && tailPass + // return pass, allSubVars + // | _ -> return! errWrongType "List" + + // | MPList(_, pats) -> + // match dv with + // | DList(_, vals) -> + // if List.length vals = List.length pats then + // let! (passResults, newVarResults) = + // List.zip vals pats + // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + // else + // return false, [] + // | _ -> return! errWrongType "List" + + // | MPVariable(_, varName) -> return true, [ (varName, dv) ] + // } + + + // // The value we're matching against + // let! matchVal = eval state matchExpr + + // let mutable matchResult = None + + // for case in NEList.toList cases do + // if Option.isSome matchResult then + // () + // else + // let! passesPattern, newDefs = checkPattern matchVal case.pat + // let newSymtable = + // Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) + // let state = { state with symbolTable = newSymtable } + // let! passesWhenCondition = + // uply { + // match case.whenCondition with + // | Some whenCondition when passesPattern -> + // match! eval state whenCondition with + // | DBool b -> return b + // | _ -> return errStr callStack "When condition should be a boolean" + // | _ -> return true + // } + // if passesPattern && passesWhenCondition then + // let! r = eval state case.rhs + // matchResult <- Some r + + // match matchResult with + // | Some r -> return r + // | None -> + // return! raiseExeRTE callStack (ExecutionError.MatchExprUnmatched matchVal) + + + // | EIf(_, cond, thenBody, elseBody) -> + // match! eval state cond with + // | DBool false -> + // match elseBody with + // | None -> return DUnit + // | Some eb -> return! eval state eb + // | DBool true -> return! eval state thenBody + // | _ -> return errStr callStack "If only supports Booleans" + + + // | EOr(_, left, right) -> + // match! eval state left with + // | DBool true -> return DBool true + // | DBool false -> + // match! eval state right with + // | DBool _ as b -> return b + // | _ -> return errStr callStack "|| only supports Booleans" + // | _ -> return errStr callStack "|| only supports Booleans" + + + // | EAnd(_, left, right) -> + // match! eval state left with + // | DBool false -> return DBool false + // | DBool true -> + // match! eval state right with + // | DBool _ as b -> return b + // | _ -> return errStr callStack "&& only supports Booleans" + // | _ -> return errStr callStack "&& only supports Booleans" + + + // | EEnum(_, sourceTypeName, caseName, fields) -> + // let types = ExecutionState.availableTypes state + + // let! (resolvedTypeName, _, cases) = enumMaybe callStack types sourceTypeName + // let case = cases |> NEList.find (fun c -> c.name = caseName) + + // match case with + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.EnumConstructionCaseNotFound(sourceTypeName, caseName)) + + // | Some case -> + // if case.fields.Length <> fields.Length then + // let msg = + // $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" + // return errStr callStack msg + // else + // let! (fields : List) = + // Ply.List.foldSequentiallyWithIndex + // (fun + // fieldIndex + // fieldsSoFar + // ((enumFieldType : TypeReference), fieldExpr) -> + // uply { + // let! v = eval state fieldExpr + + // let context = + // TypeChecker.EnumField( + // sourceTypeName, + // case.name, + // fieldIndex, + // List.length fields, + // enumFieldType + // ) + + // // VTTODO: we should be passing in a proper tst, not Map.empty - right? + // match! + // TypeChecker.unify context types Map.empty enumFieldType v + // with + // | Ok() -> return (List.append fieldsSoFar [ v ]) + // | Error rte -> return raiseRTE callStack rte + // }) + // [] + // (List.zip case.fields fields) + + // return! + // TypeChecker.DvalCreator.enum + // resolvedTypeName + // sourceTypeName + // caseName + // fields | EError(_, rte, exprs) -> let! (_ : List) = Ply.List.mapSequentially (eval state) exprs @@ -906,40 +910,40 @@ and applyFnVal (args : NEList) : DvalTask = match fnVal with - | Lambda l -> executeLambda state l args + //| Lambda l -> executeLambda state l args | NamedFn fn -> callFn state fn typeArgs args -and executeLambda - (state : ExecutionState) - (l : LambdaImpl) - (args : NEList) - : DvalTask = - - // One of the reasons to take a separate list of params and args is to - // provide this error message here. We don't have this information in - // other places, and the alternative is just to provide incompletes - // with no context - let expectedLength = NEList.length l.parameters - let actualLength = NEList.length args - if expectedLength <> actualLength then - raiseRTE - state.tracing.callStack - (RuntimeError.oldError - $"Expected {expectedLength} arguments, got {actualLength}") - - else - let checkPattern' = checkPattern state.tracing.callStack - - let paramSyms = - NEList.map2 checkPattern' args l.parameters - |> NEList.toList - |> List.flatten - |> Map - - let state = - { state with symbolTable = Map.mergeFavoringRight l.symtable paramSyms } - - eval state l.body +// and executeLambda +// (state : ExecutionState) +// (l : LambdaImpl) +// (args : NEList) +// : DvalTask = + +// // One of the reasons to take a separate list of params and args is to +// // provide this error message here. We don't have this information in +// // other places, and the alternative is just to provide incompletes +// // with no context +// let expectedLength = NEList.length l.parameters +// let actualLength = NEList.length args +// if expectedLength <> actualLength then +// raiseRTE +// state.tracing.callStack +// (RuntimeError.oldError +// $"Expected {expectedLength} arguments, got {actualLength}") + +// else +// let checkPattern' = checkPattern state.tracing.callStack + +// let paramSyms = +// NEList.map2 checkPattern' args l.parameters +// |> NEList.toList +// |> List.flatten +// |> Map + +// let state = +// { state with symbolTable = Map.mergeFavoringRight l.symtable paramSyms } + +// eval state l.body and callFn (state : ExecutionState) diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index fbc653897f..24e14b865e 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -15,24 +15,24 @@ - - + + - - - + + + - + - - + + - + diff --git a/backend/src/LibExecution/NameResolutionError.fs b/backend/src/LibExecution/NameResolutionError.fs index 07a1f80f91..9dd2814e6a 100644 --- a/backend/src/LibExecution/NameResolutionError.fs +++ b/backend/src/LibExecution/NameResolutionError.fs @@ -4,8 +4,8 @@ open Prelude module RT = RuntimeTypes module VT = RT.ValueType -module D = DvalDecoder -module RT2DT = RuntimeTypesToDarkTypes +//module D = DvalDecoder +//module RT2DT = RuntimeTypesToDarkTypes type ErrorType = @@ -24,88 +24,89 @@ type Error = { errorType : ErrorType; nameType : NameType } /// to RuntimeError module RTE = - module ErrorType = - let typeName = - RT.FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.errorType - - let toDT (et : ErrorType) : RT.Dval = - let (caseName, fields) = - match et with - | NotFound names -> - "NotFound", [ RT.DList(VT.string, List.map RT.DString names) ] - | ExpectedEnumButNot packageTypeID -> - "ExpectedEnumButNot", [ RT.DUuid packageTypeID ] - | ExpectedRecordButNot packageTypeID -> - "ExpectedRecordButNot", [ RT.DUuid packageTypeID ] - | MissingEnumModuleName caseName -> - "MissingEnumModuleName", [ RT.DString caseName ] - | InvalidPackageName names -> - "InvalidPackageName", [ RT.DList(VT.string, List.map RT.DString names) ] - - RT.DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (dv : RT.Dval) : ErrorType = - let string (dv : RT.Dval) : string = - match dv with - | RT.DString s -> s - | _ -> Exception.raiseInternal "Invalid ErrorType" [] - - match dv with - | RT.DEnum(_, _, [], "NotFound", [ RT.DList(_, names) ]) -> - NotFound(List.map string names) - | RT.DEnum(_, _, [], "ExpectedEnumButNot", [ RT.DUuid packageTypeID ]) -> - ExpectedEnumButNot packageTypeID - | RT.DEnum(_, _, [], "ExpectedRecordButNot", [ RT.DUuid packageTypeID ]) -> - ExpectedRecordButNot packageTypeID - | RT.DEnum(_, _, [], "MissingEnumModuleName", [ RT.DString caseName ]) -> - MissingEnumModuleName caseName - | RT.DEnum(_, _, [], "InvalidPackageName", [ RT.DList(_, names) ]) -> - InvalidPackageName(List.map string names) - | _ -> Exception.raiseInternal "Invalid ErrorType" [] - - module NameType = - let typeName = - RT.FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.nameType - let toDT (nt : NameType) : RT.Dval = - let (caseName, fields) = - match nt with - | Function -> "Function", [] - | Type -> "Type", [] - | Constant -> "Constant", [] - - RT.DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (dv : RT.Dval) : NameType = - match dv with - | RT.DEnum(_, _, [], "Function", []) -> Function - | RT.DEnum(_, _, [], "Type", []) -> Type - | RT.DEnum(_, _, [], "Constant", []) -> Constant - | _ -> Exception.raiseInternal "Invalid NameType" [] - - module Error = - let typeName = - RT.FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.error - let toDT (e : Error) : RT.Dval = - let fields = - [ ("errorType", ErrorType.toDT e.errorType) - ("nameType", NameType.toDT e.nameType) ] - RT.DRecord(typeName, typeName, [], Map fields) - - let fromDT (dv : RT.Dval) : Error = - match dv with - | RT.DRecord(_, _, _, m) -> - let errorType = m |> D.field "errorType" |> ErrorType.fromDT - let nameType = m |> D.field "nameType" |> NameType.fromDT - { errorType = errorType; nameType = nameType } - | _ -> Exception.raiseInternal "Expected DRecord" [] - - let toRuntimeError (e : Error) : RT.RuntimeError = - Error.toDT e |> RT.RuntimeError.nameResolutionError - - let fromRuntimeError (re : RT.RuntimeError) : Error = - // TODO: this probably doesn't unwrap the type - // see above function - RT.RuntimeError.toDT re |> Error.fromDT + // module ErrorType = + // let typeName = + // RT.FQTypeName.fqPackage + // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.errorType + + // let toDT (et : ErrorType) : RT.Dval = + // let (caseName, fields) = + // match et with + // | NotFound names -> + // "NotFound", [ RT.DList(VT.string, List.map RT.DString names) ] + // | ExpectedEnumButNot packageTypeID -> + // "ExpectedEnumButNot", [ RT.DUuid packageTypeID ] + // | ExpectedRecordButNot packageTypeID -> + // "ExpectedRecordButNot", [ RT.DUuid packageTypeID ] + // | MissingEnumModuleName caseName -> + // "MissingEnumModuleName", [ RT.DString caseName ] + // | InvalidPackageName names -> + // "InvalidPackageName", [ RT.DList(VT.string, List.map RT.DString names) ] + + // RT.DEnum(typeName, typeName, [], caseName, fields) + + // let fromDT (dv : RT.Dval) : ErrorType = + // let string (dv : RT.Dval) : string = + // match dv with + // | RT.DString s -> s + // | _ -> Exception.raiseInternal "Invalid ErrorType" [] + + // match dv with + // | RT.DEnum(_, _, [], "NotFound", [ RT.DList(_, names) ]) -> + // NotFound(List.map string names) + // | RT.DEnum(_, _, [], "ExpectedEnumButNot", [ RT.DUuid packageTypeID ]) -> + // ExpectedEnumButNot packageTypeID + // | RT.DEnum(_, _, [], "ExpectedRecordButNot", [ RT.DUuid packageTypeID ]) -> + // ExpectedRecordButNot packageTypeID + // | RT.DEnum(_, _, [], "MissingEnumModuleName", [ RT.DString caseName ]) -> + // MissingEnumModuleName caseName + // | RT.DEnum(_, _, [], "InvalidPackageName", [ RT.DList(_, names) ]) -> + // InvalidPackageName(List.map string names) + // | _ -> Exception.raiseInternal "Invalid ErrorType" [] + + // module NameType = + // let typeName = + // RT.FQTypeName.fqPackage + // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.nameType + // let toDT (nt : NameType) : RT.Dval = + // let (caseName, fields) = + // match nt with + // | Function -> "Function", [] + // | Type -> "Type", [] + // | Constant -> "Constant", [] + + // RT.DEnum(typeName, typeName, [], caseName, fields) + + // let fromDT (dv : RT.Dval) : NameType = + // match dv with + // | RT.DEnum(_, _, [], "Function", []) -> Function + // | RT.DEnum(_, _, [], "Type", []) -> Type + // | RT.DEnum(_, _, [], "Constant", []) -> Constant + // | _ -> Exception.raiseInternal "Invalid NameType" [] + + // module Error = + // let typeName = + // RT.FQTypeName.fqPackage + // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.error + // let toDT (e : Error) : RT.Dval = + // let fields = + // [ ("errorType", ErrorType.toDT e.errorType) + // ("nameType", NameType.toDT e.nameType) ] + // RT.DRecord(typeName, typeName, [], Map fields) + + // let fromDT (dv : RT.Dval) : Error = + // match dv with + // | RT.DRecord(_, _, _, m) -> + // let errorType = m |> D.field "errorType" |> ErrorType.fromDT + // let nameType = m |> D.field "nameType" |> NameType.fromDT + // { errorType = errorType; nameType = nameType } + // | _ -> Exception.raiseInternal "Expected DRecord" [] + + let toRuntimeError (_e : Error) : RT.RuntimeError = + //Error.toDT e |> RT.RuntimeError.nameResolutionError + "TODO" |> RT.RuntimeError.oldError + + // let fromRuntimeError (re : RT.RuntimeError) : Error = + // // TODO: this probably doesn't unwrap the type + // // see above function + // RT.RuntimeError.toDT re |> Error.fromDT diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 40e7485305..c5537ea15f 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -9,10 +9,10 @@ type NamePrinter<'name> = 'name -> string // Lowercase starting letter for modules and users let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$" -let typeNamePattern = @"^[A-Z][a-z0-9A-Z_]*$" +//let typeNamePattern = @"^[A-Z][a-z0-9A-Z_]*$" let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$" -let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" +//let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let assertBuiltin (name : string) @@ -23,45 +23,45 @@ let assertBuiltin assert_ "version can't be negative" [ "version", version ] (version >= 0) -/// Fully-Qualified Type Name -/// -/// Used to reference a type defined in a Package or by a User -module FQTypeName = - /// The id of a type in the package manager - type Package = uuid +// /// Fully-Qualified Type Name +// /// +// /// Used to reference a type defined in a Package or by a User +// module FQTypeName = +// /// The id of a type in the package manager +// type Package = uuid - type FQTypeName = Package of Package +// type FQTypeName = Package of Package - let package (id : uuid) : Package = id +// let package (id : uuid) : Package = id -/// A Fully-Qualified Constant Name -/// -/// Used to reference a constant defined by the runtime, in a Package, or by a User -module FQConstantName = - /// A constant built into the runtime - type Builtin = { name : string; version : int } +// /// A Fully-Qualified Constant Name +// /// +// /// Used to reference a constant defined by the runtime, in a Package, or by a User +// module FQConstantName = +// /// A constant built into the runtime +// type Builtin = { name : string; version : int } - /// The id of a constant in the package manager - type Package = uuid +// /// The id of a constant in the package manager +// type Package = uuid - type FQConstantName = - | Builtin of Builtin - | Package of Package +// type FQConstantName = +// | Builtin of Builtin +// | Package of Package - let assertConstantName (name : string) : unit = - assertRe "Constant name must match" constantNamePattern name +// let assertConstantName (name : string) : unit = +// assertRe "Constant name must match" constantNamePattern name - let builtIn (name : string) (version : int) : Builtin = - assertBuiltin name version assertConstantName - { name = name; version = version } +// let builtIn (name : string) (version : int) : Builtin = +// assertBuiltin name version assertConstantName +// { name = name; version = version } - let fqBuiltIn (name : string) (version : int) : FQConstantName = - Builtin(builtIn name version) +// let fqBuiltIn (name : string) (version : int) : FQConstantName = +// Builtin(builtIn name version) - let package (id : uuid) : Package = id +// let package (id : uuid) : Package = id @@ -115,67 +115,67 @@ module FQFnName = type NameResolution<'a> = Result<'a, NameResolutionError.Error> -type LetPattern = - | LPUnit of id - | LPTuple of - id * - first : LetPattern * - second : LetPattern * - theRest : List - | LPVariable of id * name : string - -/// Used for pattern matching in a match statement -type MatchPattern = - | MPUnit of id - - | MPBool of id * bool - - | MPInt8 of id * int8 - | MPUInt8 of id * uint8 - | MPInt16 of id * int16 - | MPUInt16 of id * uint16 - | MPInt32 of id * int32 - | MPUInt32 of id * uint32 - | MPInt64 of id * int64 - | MPUInt64 of id * uint64 - | MPInt128 of id * System.Int128 - | MPUInt128 of id * System.UInt128 - - | MPFloat of id * Sign * string * string - - | MPChar of id * string - | MPString of id * string - - | MPList of id * List - | MPListCons of id * head : MatchPattern * tail : MatchPattern - | MPTuple of id * MatchPattern * MatchPattern * List - - | MPEnum of id * caseName : string * fieldPats : List - - | MPVariable of id * string - -type BinaryOperation = - | BinOpAnd - | BinOpOr - -type InfixFnName = - | ArithmeticPlus - | ArithmeticMinus - | ArithmeticMultiply - | ArithmeticDivide - | ArithmeticModulo - | ArithmeticPower - | ComparisonGreaterThan - | ComparisonGreaterThanOrEqual - | ComparisonLessThan - | ComparisonLessThanOrEqual - | ComparisonEquals - | ComparisonNotEquals - | StringConcat - -type Infix = - | InfixFnCall of InfixFnName - | BinOp of BinaryOperation +// type LetPattern = +// // | LPUnit of id +// // | LPTuple of +// // id * +// // first : LetPattern * +// // second : LetPattern * +// // theRest : List +// | LPVariable of id * name : string + +// /// Used for pattern matching in a match statement +// type MatchPattern = +// | MPUnit of id + +// | MPBool of id * bool + +// | MPInt8 of id * int8 +// | MPUInt8 of id * uint8 +// | MPInt16 of id * int16 +// | MPUInt16 of id * uint16 +// | MPInt32 of id * int32 +// | MPUInt32 of id * uint32 +// | MPInt64 of id * int64 +// | MPUInt64 of id * uint64 +// | MPInt128 of id * System.Int128 +// | MPUInt128 of id * System.UInt128 + +// | MPFloat of id * Sign * string * string + +// | MPChar of id * string +// | MPString of id * string + +// | MPList of id * List +// | MPListCons of id * head : MatchPattern * tail : MatchPattern +// | MPTuple of id * MatchPattern * MatchPattern * List + +// | MPEnum of id * caseName : string * fieldPats : List + +// | MPVariable of id * string + +// type BinaryOperation = +// | BinOpAnd +// | BinOpOr + +// type InfixFnName = +// | ArithmeticPlus +// | ArithmeticMinus +// | ArithmeticMultiply +// | ArithmeticDivide +// | ArithmeticModulo +// | ArithmeticPower +// | ComparisonGreaterThan +// | ComparisonGreaterThanOrEqual +// | ComparisonLessThan +// | ComparisonLessThanOrEqual +// | ComparisonEquals +// | ComparisonNotEquals +// | StringConcat + +// type Infix = +// | InfixFnCall of InfixFnName +// | BinOp of BinaryOperation /// Darklang's available types /// - `Int64` @@ -187,43 +187,43 @@ type TypeReference = | TBool - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 + // | TInt8 + // | TUInt8 + // | TInt16 + // | TUInt16 + // | TInt32 + // | TUInt32 | TInt64 - | TUInt64 - | TInt128 - | TUInt128 + // | TUInt64 + // | TInt128 + // | TUInt128 - | TFloat + // | TFloat - | TChar + // | TChar | TString - | TUuid - | TDateTime + // | TUuid + // | TDateTime - | TList of TypeReference - | TTuple of TypeReference * TypeReference * List - | TDict of TypeReference + // | TList of TypeReference + // | TTuple of TypeReference * TypeReference * List + // | TDict of TypeReference - | TFn of arguments : NEList * ret : TypeReference + //| TFn of arguments : NEList * ret : TypeReference - | TDB of TypeReference + //| TDB of TypeReference // A named variable, eg `a` in `List`, matches anything - /// A type defined by a standard library module, a canvas/user, or a package - /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` - /// `typeArgs` is the list of type arguments, if any - | TCustomType of - // TODO: this reference should be by-hash - NameResolution * - typeArgs : List + // /// A type defined by a standard library module, a canvas/user, or a package + // /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` + // /// `typeArgs` is the list of type arguments, if any + // | TCustomType of + // // TODO: this reference should be by-hash + // NameResolution * + // typeArgs : List - | TVariable of string + //| TVariable of string /// Expressions - the main part of the language. type Expr = @@ -231,67 +231,67 @@ type Expr = | EUnit of id | EBool of id * bool - | EInt8 of id * int8 - | EUInt8 of id * uint8 - | EInt16 of id * int16 - | EUInt16 of id * uint16 - | EInt32 of id * int32 - | EUInt32 of id * uint32 + // | EInt8 of id * int8 + // | EUInt8 of id * uint8 + // | EInt16 of id * int16 + // | EUInt16 of id * uint16 + // | EInt32 of id * int32 + // | EUInt32 of id * uint32 | EInt64 of id * int64 - | EUInt64 of id * uint64 - | EInt128 of id * System.Int128 - | EUInt128 of id * System.UInt128 - - // Allow the user to have arbitrarily big numbers, even if they don't make sense as - // floats. The float is split as we want to preserve what the user entered. - // Strings are used as numbers lose the leading zeros (eg 7.00007) - | EFloat of id * Sign * string * string - - /// A character is an Extended Grapheme Cluster (hence why we use a string). This - /// is equivalent to one screen-visible "character" in Unicode. - | EChar of id * string + // | EUInt64 of id * uint64 + // | EInt128 of id * System.Int128 + // | EUInt128 of id * System.UInt128 + + // // Allow the user to have arbitrarily big numbers, even if they don't make sense as + // // floats. The float is split as we want to preserve what the user entered. + // // Strings are used as numbers lose the leading zeros (eg 7.00007) + // | EFloat of id * Sign * string * string + + // /// A character is an Extended Grapheme Cluster (hence why we use a string). This + // /// is equivalent to one screen-visible "character" in Unicode. + // | EChar of id * string | EString of id * List - // -- Flow control -- - /// `if cond then thenExpr else elseExpr` - | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option - - /// `(1 + 2) |> fnName |> (+) 3` - | EPipe of id * Expr * List - - /// Supports `match` expressions - /// ```fsharp - /// match x + 2 with // arg - /// | pattern -> expr // cases[0] - /// | pattern -> expr - /// | ... - /// ``` - // cases is a list to represent when a user starts typing but doesn't complete it - | EMatch of id * arg : Expr * cases : List - - // - // Composed of binding pattern, the expression to create bindings for, - // and the expression that follows, where the bound values are available - // - // - // - // let str = expr1 - // expr2 - // - | ELet of id * LetPattern * Expr * Expr - // Reference some local variable by name - // - // i.e. after a `let binding = value`, any use of `binding` - | EVariable of id * string - // Access a field of some expression (e.g. `someExpr.fieldName`) - | EFieldAccess of id * Expr * string + // // -- Flow control -- + // /// `if cond then thenExpr else elseExpr` + // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option + + // /// `(1 + 2) |> fnName |> (+) 3` + // | EPipe of id * Expr * List + + // /// Supports `match` expressions + // /// ```fsharp + // /// match x + 2 with // arg + // /// | pattern -> expr // cases[0] + // /// | pattern -> expr + // /// | ... + // /// ``` + // // cases is a list to represent when a user starts typing but doesn't complete it + // | EMatch of id * arg : Expr * cases : List + + // // + // // Composed of binding pattern, the expression to create bindings for, + // // and the expression that follows, where the bound values are available + // // + // // + // // + // // let str = expr1 + // // expr2 + // // + // | ELet of id * LetPattern * Expr * Expr + // // Reference some local variable by name + // // + // // i.e. after a `let binding = value`, any use of `binding` + // | EVariable of id * string + // // Access a field of some expression (e.g. `someExpr.fieldName`) + // | EFieldAccess of id * Expr * string // -- Basic structures -- - | EList of id * List - | EDict of id * List - | ETuple of id * Expr * Expr * List + // | EList of id * List + // | EDict of id * List + // | ETuple of id * Expr * Expr * List // -- "Applying" args to things, such as fns and lambdas -- @@ -304,165 +304,166 @@ type Expr = /// Reference a function name, _usually_ so we can _apply_ it with args | EFnName of id * NameResolution - // Composed of a parameters * the expression itself - // The id in the varname list is the analysis id, used to get a livevalue - // from the analysis engine - | ELambda of id * pats : NEList * body : Expr - - /// Calls upon an infix function - | EInfix of id * Infix * lhs : Expr * rhs : Expr - - - // -- References to custom types and data -- - | EConstant of - id * - // TODO: this reference should be by-hash - NameResolution - - // See NameResolution comment above - | ERecord of - id * - // TODO: this reference should be by-hash - typeName : NameResolution * - // User is allowed type `Name {}` even if that's an error - fields : List - | ERecordUpdate of id * record : Expr * updates : NEList - - // Enums include `Some`, `None`, `Error`, `Ok`, as well - // as user-defined enums. - // - /// Given an Enum type of: - /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` - /// , this is the expression - /// `C (1, "title")` - /// represented as - /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` - | EEnum of - id * - // TODO: this reference should be by-hash - typeName : NameResolution * - caseName : string * - fields : List - - -and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } + // // Composed of a parameters * the expression itself + // // The id in the varname list is the analysis id, used to get a livevalue + // // from the analysis engine + // | ELambda of id * pats : NEList * body : Expr + + // /// Calls upon an infix function + // | EInfix of id * Infix * lhs : Expr * rhs : Expr + + + // // -- References to custom types and data -- + // | EConstant of + // id * + // // TODO: this reference should be by-hash + // NameResolution + + // // See NameResolution comment above + // | ERecord of + // id * + // // TODO: this reference should be by-hash + // typeName : NameResolution * + // // User is allowed type `Name {}` even if that's an error + // fields : List + // | ERecordUpdate of id * record : Expr * updates : NEList + + // // Enums include `Some`, `None`, `Error`, `Ok`, as well + // // as user-defined enums. + // // + // /// Given an Enum type of: + // /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` + // /// , this is the expression + // /// `C (1, "title")` + // /// represented as + // /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` + // | EEnum of + // id * + // // TODO: this reference should be by-hash + // typeName : NameResolution * + // caseName : string * + // fields : List + + +//and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } and StringSegment = | StringText of string | StringInterpolation of Expr -and PipeExpr = - | EPipeVariable of id * string * List // value is an fn taking one or more arguments - | EPipeLambda of id * pats : NEList * body : Expr - | EPipeInfix of id * Infix * Expr - | EPipeFnCall of - id * - NameResolution * - typeArgs : List * - args : List - | EPipeEnum of - id * - // TODO: this reference should be by-hash - typeName : NameResolution * - caseName : string * - fields : List +// and PipeExpr = +// | EPipeVariable of id * string * List // value is an fn taking one or more arguments +// | EPipeLambda of id * pats : NEList * body : Expr +// | EPipeInfix of id * Infix * Expr +// | EPipeFnCall of +// id * +// NameResolution * +// typeArgs : List * +// args : List +// | EPipeEnum of +// id * +// // TODO: this reference should be by-hash +// typeName : NameResolution * +// caseName : string * +// fields : List module Expr = let toID (expr : Expr) : id = match expr with - | EInt64(id, _) - | EUInt64(id, _) - | EInt8(id, _) - | EUInt8(id, _) - | EInt16(id, _) - | EUInt16(id, _) - | EInt32(id, _) - | EUInt32(id, _) - | EInt128(id, _) - | EUInt128(id, _) + | EUnit id | EBool(id, _) + // | EInt8(id, _) + // | EUInt8(id, _) + // | EInt16(id, _) + // | EUInt16(id, _) + // | EInt32(id, _) + // | EUInt32(id, _) + | EInt64(id, _) + // | EUInt64(id, _) + // | EInt128(id, _) + // | EUInt128(id, _) + // | EChar(id, _) | EString(id, _) - | EChar(id, _) - | EFloat(id, _, _, _) - | EUnit id - | EConstant(id, _) - | ELet(id, _, _, _) - | EIf(id, _, _, _) - | EInfix(id, _, _, _) - | ELambda(id, _, _) + // | EFloat(id, _, _, _) + // | EConstant(id, _) + // | ELet(id, _, _, _) + // | EIf(id, _, _, _) + // | EInfix(id, _, _, _) + // | ELambda(id, _, _) | EFnName(id, _) - | EFieldAccess(id, _, _) - | EVariable(id, _) + // | EFieldAccess(id, _, _) + // | EVariable(id, _) | EApply(id, _, _, _) - | EList(id, _) - | EDict(id, _) - | ETuple(id, _, _, _) - | EPipe(id, _, _) - | ERecord(id, _, _) - | ERecordUpdate(id, _, _) - | EEnum(id, _, _, _) - | EMatch(id, _, _) -> id - -module PipeExpr = - let toID (expr : PipeExpr) : id = - match expr with - | EPipeVariable(id, _, _) - | EPipeLambda(id, _, _) - | EPipeInfix(id, _, _) - | EPipeFnCall(id, _, _, _) - | EPipeEnum(id, _, _, _) -> id - - -/// A type defined by a package or canvas/user -module TypeDeclaration = - type RecordField = { name : string; typ : TypeReference; description : string } - - type EnumField = - { typ : TypeReference; label : Option; description : string } - - type EnumCase = { name : string; fields : List; description : string } - - /// The right-hand-side of the declaration: eg List<'a> - type Definition = - /// `type MyAlias = Int64` - | Alias of TypeReference - - /// `type MyRecord = { a : int; b : string }` - | Record of NEList - - /// `type MyEnum = A | B of int | C of int * (label: string)` - | Enum of NEList - - /// Combined the RHS definition, with the list of type parameters. Eg type - /// MyType<'a> = List<'a> - type T = { typeParams : List; definition : Definition } - - -type Const = - | CInt64 of int64 - | CUInt64 of uint64 - | CInt8 of int8 - | CUInt8 of uint8 - | CInt16 of int16 - | CUInt16 of uint16 - | CInt32 of int32 - | CUInt32 of uint32 - | CInt128 of System.Int128 - | CUInt128 of System.UInt128 - | CBool of bool - | CString of string - | CChar of string - | CFloat of Sign * string * string - | CUnit - | CTuple of first : Const * second : Const * rest : List - - | CEnum of - // TODO: this reference should be by-hash - NameResolution * - caseName : string * - fields : List - | CList of List - | CDict of List + // | EList(id, _) + // | EDict(id, _) + // | ETuple(id, _, _, _) + // | EPipe(id, _, _) + // | ERecord(id, _, _) + // | ERecordUpdate(id, _, _) + // | EEnum(id, _, _, _) + // | EMatch(id, _, _) + -> id + +// module PipeExpr = +// let toID (expr : PipeExpr) : id = +// match expr with +// | EPipeVariable(id, _, _) +// | EPipeLambda(id, _, _) +// | EPipeInfix(id, _, _) +// | EPipeFnCall(id, _, _, _) +// | EPipeEnum(id, _, _, _) -> id + + +// /// A type defined by a package or canvas/user +// module TypeDeclaration = +// type RecordField = { name : string; typ : TypeReference; description : string } + +// type EnumField = +// { typ : TypeReference; label : Option; description : string } + +// type EnumCase = { name : string; fields : List; description : string } + +// /// The right-hand-side of the declaration: eg List<'a> +// type Definition = +// /// `type MyAlias = Int64` +// | Alias of TypeReference + +// /// `type MyRecord = { a : int; b : string }` +// | Record of NEList + +// /// `type MyEnum = A | B of int | C of int * (label: string)` +// | Enum of NEList + +// /// Combined the RHS definition, with the list of type parameters. Eg type +// /// MyType<'a> = List<'a> +// type T = { typeParams : List; definition : Definition } + + +// type Const = +// | CInt64 of int64 +// | CUInt64 of uint64 +// | CInt8 of int8 +// | CUInt8 of uint8 +// | CInt16 of int16 +// | CUInt16 of uint16 +// | CInt32 of int32 +// | CUInt32 of uint32 +// | CInt128 of System.Int128 +// | CUInt128 of System.UInt128 +// | CBool of bool +// | CString of string +// | CChar of string +// | CFloat of Sign * string * string +// | CUnit +// | CTuple of first : Const * second : Const * rest : List + +// | CEnum of +// // TODO: this reference should be by-hash +// NameResolution * +// caseName : string * +// fields : List +// | CList of List +// | CDict of List @@ -503,33 +504,33 @@ type Deprecation<'name> = // nameParts |> String.concat "." -module PackageType = - type Name = { owner : string; modules : List; name : string } +// module PackageType = +// type Name = { owner : string; modules : List; name : string } - let name (owner : string) (modules : List) (name : string) : Name = - // TODO: assert OK - { owner = owner; modules = modules; name = name } +// let name (owner : string) (modules : List) (name : string) : Name = +// // TODO: assert OK +// { owner = owner; modules = modules; name = name } - type PackageType = - { id : uuid - name : Name - declaration : TypeDeclaration.T - description : string - deprecated : Deprecation } +// type PackageType = +// { id : uuid +// name : Name +// declaration : TypeDeclaration.T +// description : string +// deprecated : Deprecation } -module PackageConstant = - type Name = { owner : string; modules : List; name : string } +// module PackageConstant = +// type Name = { owner : string; modules : List; name : string } - let name (owner : string) (modules : List) (name : string) : Name = - // TODO: assert OK - { owner = owner; modules = modules; name = name } +// let name (owner : string) (modules : List) (name : string) : Name = +// // TODO: assert OK +// { owner = owner; modules = modules; name = name } - type PackageConstant = - { id : uuid - name : Name - description : string - deprecated : Deprecation - body : Const } +// type PackageConstant = +// { id : uuid +// name : Name +// description : string +// deprecated : Deprecation +// body : Const } module PackageFn = type Name = { owner : string; modules : List; name : string } @@ -551,13 +552,13 @@ module PackageFn = deprecated : Deprecation } type Packages = - { types : List - constants : List + { //types : List + //constants : List fns : List } static member combine(packages : List) : Packages = - { types = packages |> List.collect _.types - constants = packages |> List.collect _.constants + { //types = packages |> List.collect _.types + //constants = packages |> List.collect _.constants fns = packages |> List.collect _.fns } @@ -567,25 +568,25 @@ type Packages = /// but there's a chance of Local <-> Cloud not being fully in sync, /// for whatever reasons. type PackageManager = - { findType : PackageType.Name -> Ply> - findConstant : PackageConstant.Name -> Ply> + { //findType : PackageType.Name -> Ply> + //findConstant : PackageConstant.Name -> Ply> findFn : PackageFn.Name -> Ply> - getType : FQTypeName.Package -> Ply> - getConstant : - FQConstantName.Package -> Ply> + //getType : FQTypeName.Package -> Ply> + // getConstant : + // FQConstantName.Package -> Ply> getFn : FQFnName.Package -> Ply> init : Ply } static member empty = - { findType = (fun _ -> Ply None) + { //findType = (fun _ -> Ply None) findFn = (fun _ -> Ply None) - findConstant = (fun _ -> Ply None) + //findConstant = (fun _ -> Ply None) - getType = (fun _ -> Ply None) + //getType = (fun _ -> Ply None) getFn = (fun _ -> Ply None) - getConstant = (fun _ -> Ply None) + //getConstant = (fun _ -> Ply None) init = uply { return () } } @@ -594,36 +595,37 @@ type PackageManager = /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras (pm : PackageManager) - (types : List) - (constants : List) + //(types : List) + //(constants : List) (fns : List) : PackageManager = - { findType = - fun name -> - match types |> List.tryFind (fun t -> t.name = name) with - | Some t -> Some t.id |> Ply - | None -> pm.findType name - findConstant = - fun name -> - match constants |> List.tryFind (fun c -> c.name = name) with - | Some c -> Some c.id |> Ply - | None -> pm.findConstant name + { + // findType = + // fun name -> + // match types |> List.tryFind (fun t -> t.name = name) with + // | Some t -> Some t.id |> Ply + // | None -> pm.findType name + // findConstant = + // fun name -> + // match constants |> List.tryFind (fun c -> c.name = name) with + // | Some c -> Some c.id |> Ply + // | None -> pm.findConstant name findFn = fun name -> match fns |> List.tryFind (fun f -> f.name = name) with | Some f -> Some f.id |> Ply | None -> pm.findFn name - getType = - fun id -> - match types |> List.tryFind (fun t -> t.id = id) with - | Some t -> Ply(Some t) - | None -> pm.getType id - getConstant = - fun id -> - match constants |> List.tryFind (fun c -> c.id = id) with - | Some c -> Ply(Some c) - | None -> pm.getConstant id + // getType = + // fun id -> + // match types |> List.tryFind (fun t -> t.id = id) with + // | Some t -> Ply(Some t) + // | None -> pm.getType id + // getConstant = + // fun id -> + // match constants |> List.tryFind (fun c -> c.id = id) with + // | Some c -> Ply(Some c) + // | None -> pm.getConstant id getFn = fun id -> match fns |> List.tryFind (fun f -> f.id = id) with @@ -634,48 +636,48 @@ type PackageManager = -// -- -// User things -// -- -module DB = - type T = { tlid : tlid; name : string; version : int; typ : TypeReference } - -module Secret = - type T = { name : string; value : string; version : int } - -module Handler = - type CronInterval = - | EveryDay - | EveryWeek - | EveryFortnight - | EveryHour - | Every12Hours - | EveryMinute - - /// User to represent handlers in their lowest-level form: a triple of space * name * modifier - /// "Space" is "HTTP", "WORKER", "REPL", etc. - /// - /// "Modifier" options differ based on space. - /// e.g. HTTP handler may have "GET" modifier. - /// - /// Handlers which don't have modifiers (e.g. repl, worker) nearly - /// always (but not actually always) have `_` as their modifier. - type HandlerDesc = (string * string * string) - - type Spec = - | HTTP of route : string * method : string - | Worker of name : string - | Cron of name : string * interval : CronInterval - | REPL of name : string - - type T = { tlid : tlid; ast : Expr; spec : Spec } - -module Toplevel = - type T = - | TLDB of DB.T - | TLHandler of Handler.T - - let toTLID (tl : T) : tlid = - match tl with - | TLDB db -> db.tlid - | TLHandler h -> h.tlid +// // -- +// // User things +// // -- +// module DB = +// type T = { tlid : tlid; name : string; version : int; typ : TypeReference } + +// module Secret = +// type T = { name : string; value : string; version : int } + +// module Handler = +// type CronInterval = +// | EveryDay +// | EveryWeek +// | EveryFortnight +// | EveryHour +// | Every12Hours +// | EveryMinute + +// /// User to represent handlers in their lowest-level form: a triple of space * name * modifier +// /// "Space" is "HTTP", "WORKER", "REPL", etc. +// /// +// /// "Modifier" options differ based on space. +// /// e.g. HTTP handler may have "GET" modifier. +// /// +// /// Handlers which don't have modifiers (e.g. repl, worker) nearly +// /// always (but not actually always) have `_` as their modifier. +// type HandlerDesc = (string * string * string) + +// type Spec = +// | HTTP of route : string * method : string +// | Worker of name : string +// | Cron of name : string * interval : CronInterval +// | REPL of name : string + +// type T = { tlid : tlid; ast : Expr; spec : Spec } + +// module Toplevel = +// type T = +// | TLDB of DB.T +// | TLHandler of Handler.T + +// let toTLID (tl : T) : tlid = +// match tl with +// | TLDB db -> db.tlid +// | TLHandler h -> h.tlid diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index da55b1e1d2..68faa37509 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -7,42 +7,42 @@ open Prelude module RT = RuntimeTypes module PT = ProgramTypes -module FQTypeName = - module Package = - let toRT (p : PT.FQTypeName.Package) : RT.FQTypeName.Package = p +// module FQTypeName = +// module Package = +// let toRT (p : PT.FQTypeName.Package) : RT.FQTypeName.Package = p - let fromRT (p : RT.FQTypeName.Package) : PT.FQTypeName.Package = p +// let fromRT (p : RT.FQTypeName.Package) : PT.FQTypeName.Package = p - let toRT (fqtn : PT.FQTypeName.FQTypeName) : RT.FQTypeName.FQTypeName = - match fqtn with - | PT.FQTypeName.Package p -> RT.FQTypeName.Package(Package.toRT p) +// let toRT (fqtn : PT.FQTypeName.FQTypeName) : RT.FQTypeName.FQTypeName = +// match fqtn with +// | PT.FQTypeName.Package p -> RT.FQTypeName.Package(Package.toRT p) - let fromRT (fqtn : RT.FQTypeName.FQTypeName) : Option = - match fqtn with - | RT.FQTypeName.Package p -> PT.FQTypeName.Package(Package.fromRT p) |> Some +// let fromRT (fqtn : RT.FQTypeName.FQTypeName) : Option = +// match fqtn with +// | RT.FQTypeName.Package p -> PT.FQTypeName.Package(Package.fromRT p) |> Some -module FQConstantName = - module Builtin = - let toRT (c : PT.FQConstantName.Builtin) : RT.FQConstantName.Builtin = - { name = c.name; version = c.version } +// module FQConstantName = +// module Builtin = +// let toRT (c : PT.FQConstantName.Builtin) : RT.FQConstantName.Builtin = +// { name = c.name; version = c.version } - let fromRT (c : RT.FQConstantName.Builtin) : PT.FQConstantName.Builtin = - { name = c.name; version = c.version } +// let fromRT (c : RT.FQConstantName.Builtin) : PT.FQConstantName.Builtin = +// { name = c.name; version = c.version } - module Package = - let toRT (c : PT.FQConstantName.Package) : RT.FQConstantName.Package = c +// module Package = +// let toRT (c : PT.FQConstantName.Package) : RT.FQConstantName.Package = c - let fromRT (c : RT.FQConstantName.Package) : PT.FQConstantName.Package = c +// let fromRT (c : RT.FQConstantName.Package) : PT.FQConstantName.Package = c - let toRT - (name : PT.FQConstantName.FQConstantName) - : RT.FQConstantName.FQConstantName = - match name with - | PT.FQConstantName.Builtin s -> RT.FQConstantName.Builtin(Builtin.toRT s) - | PT.FQConstantName.Package p -> RT.FQConstantName.Package(Package.toRT p) +// let toRT +// (name : PT.FQConstantName.FQConstantName) +// : RT.FQConstantName.FQConstantName = +// match name with +// | PT.FQConstantName.Builtin s -> RT.FQConstantName.Builtin(Builtin.toRT s) +// | PT.FQConstantName.Package p -> RT.FQConstantName.Package(Package.toRT p) module FQFnName = @@ -74,125 +74,134 @@ module NameResolution = module TypeReference = let rec toRT (t : PT.TypeReference) : RT.TypeReference = match t with - | PT.TInt64 -> RT.TInt64 - | PT.TUInt64 -> RT.TUInt64 - | PT.TInt8 -> RT.TInt8 - | PT.TUInt8 -> RT.TUInt8 - | PT.TInt16 -> RT.TInt16 - | PT.TUInt16 -> RT.TUInt16 - | PT.TInt32 -> RT.TInt32 - | PT.TUInt32 -> RT.TUInt32 - | PT.TInt128 -> RT.TInt128 - | PT.TUInt128 -> RT.TUInt128 - | PT.TFloat -> RT.TFloat - | PT.TBool -> RT.TBool | PT.TUnit -> RT.TUnit + + | PT.TBool -> RT.TBool + + // | PT.TInt8 -> RT.TInt8 + // | PT.TUInt8 -> RT.TUInt8 + // | PT.TInt16 -> RT.TInt16 + // | PT.TUInt16 -> RT.TUInt16 + // | PT.TInt32 -> RT.TInt32 + // | PT.TUInt32 -> RT.TUInt32 + | PT.TInt64 -> RT.TInt64 + // | PT.TUInt64 -> RT.TUInt64 + // | PT.TInt128 -> RT.TInt128 + // | PT.TUInt128 -> RT.TUInt128 + + // | PT.TFloat -> RT.TFloat + + // | PT.TChar -> RT.TChar | PT.TString -> RT.TString - | PT.TList inner -> RT.TList(toRT inner) - | PT.TTuple(first, second, theRest) -> - RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) - | PT.TDict typ -> RT.TDict(toRT typ) - | PT.TDB typ -> RT.TDB(toRT typ) - | PT.TDateTime -> RT.TDateTime - | PT.TChar -> RT.TChar - | PT.TUuid -> RT.TUuid - | PT.TCustomType(typeName, typeArgs) -> - RT.TCustomType( - NameResolution.toRT FQTypeName.toRT typeName, - List.map toRT typeArgs - ) - | PT.TVariable(name) -> RT.TVariable(name) - | PT.TFn(paramTypes, returnType) -> - RT.TFn(NEList.map toRT paramTypes, toRT returnType) - - -module InfixFnName = - let toFnName (name : PT.InfixFnName) : (string * int) = - match name with - | PT.ArithmeticPlus -> ("int64Add", 0) - | PT.ArithmeticMinus -> ("int64Subtract", 0) - | PT.ArithmeticMultiply -> ("int64Multiply", 0) - | PT.ArithmeticDivide -> ("floatDivide", 0) - | PT.ArithmeticModulo -> ("int64Mod", 0) - | PT.ArithmeticPower -> ("int64Power", 0) - | PT.ComparisonGreaterThan -> ("int64GreaterThan", 0) - | PT.ComparisonGreaterThanOrEqual -> ("int64GreaterThanOrEqualTo", 0) - | PT.ComparisonLessThan -> ("int64LessThan", 0) - | PT.ComparisonLessThanOrEqual -> ("int64LessThanOrEqualTo", 0) - | PT.StringConcat -> ("stringAppend", 0) - | PT.ComparisonEquals -> ("equals", 0) - | PT.ComparisonNotEquals -> ("notEquals", 0) - - -module LetPattern = - let rec toRT (p : PT.LetPattern) : RT.LetPattern = - match p with - | PT.LPVariable(id, str) -> RT.LPVariable(id, str) - | PT.LPUnit id -> RT.LPUnit id - | PT.LPTuple(id, first, second, theRest) -> - RT.LPTuple(id, toRT first, toRT second, List.map toRT theRest) - - -module MatchPattern = - let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = - match p with - | PT.MPVariable(id, str) -> RT.MPVariable(id, str) - | PT.MPEnum(id, caseName, fieldPats) -> - RT.MPEnum(id, caseName, List.map toRT fieldPats) - | PT.MPInt64(id, i) -> RT.MPInt64(id, i) - | PT.MPUInt64(id, i) -> RT.MPUInt64(id, i) - | PT.MPInt8(id, i) -> RT.MPInt8(id, i) - | PT.MPUInt8(id, i) -> RT.MPUInt8(id, i) - | PT.MPInt16(id, i) -> RT.MPInt16(id, i) - | PT.MPUInt16(id, i) -> RT.MPUInt16(id, i) - | PT.MPInt32(id, i) -> RT.MPInt32(id, i) - | PT.MPUInt32(id, i) -> RT.MPUInt32(id, i) - | PT.MPInt128(id, i) -> RT.MPInt128(id, i) - | PT.MPUInt128(id, i) -> RT.MPUInt128(id, i) - | PT.MPBool(id, b) -> RT.MPBool(id, b) - | PT.MPChar(id, c) -> RT.MPChar(id, c) - | PT.MPString(id, s) -> RT.MPString(id, s) - | PT.MPFloat(id, s, w, f) -> - let w = if w = "" then "0" else w - RT.MPFloat(id, makeFloat s w f) - | PT.MPUnit id -> RT.MPUnit id - | PT.MPTuple(id, first, second, theRest) -> - RT.MPTuple(id, toRT first, toRT second, List.map toRT theRest) - | PT.MPList(id, pats) -> RT.MPList(id, List.map toRT pats) - | PT.MPListCons(id, head, tail) -> RT.MPListCons(id, toRT head, toRT tail) + + // | PT.TList inner -> RT.TList(toRT inner) + // | PT.TTuple(first, second, theRest) -> + // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) + // | PT.TDict typ -> RT.TDict(toRT typ) + + // | PT.TDateTime -> RT.TDateTime + // | PT.TUuid -> RT.TUuid + // | PT.TCustomType(typeName, typeArgs) -> + // RT.TCustomType( + // NameResolution.toRT FQTypeName.toRT typeName, + // List.map toRT typeArgs + // ) + // | PT.TVariable(name) -> RT.TVariable(name) + // | PT.TFn(paramTypes, returnType) -> + // RT.TFn(NEList.map toRT paramTypes, toRT returnType) + //| PT.TDB typ -> RT.TDB(toRT typ) + + +// module InfixFnName = +// let toFnName (name : PT.InfixFnName) : (string * int) = +// match name with +// | PT.ArithmeticPlus -> ("int64Add", 0) +// | PT.ArithmeticMinus -> ("int64Subtract", 0) +// | PT.ArithmeticMultiply -> ("int64Multiply", 0) +// | PT.ArithmeticDivide -> ("floatDivide", 0) +// | PT.ArithmeticModulo -> ("int64Mod", 0) +// | PT.ArithmeticPower -> ("int64Power", 0) +// | PT.ComparisonGreaterThan -> ("int64GreaterThan", 0) +// | PT.ComparisonGreaterThanOrEqual -> ("int64GreaterThanOrEqualTo", 0) +// | PT.ComparisonLessThan -> ("int64LessThan", 0) +// | PT.ComparisonLessThanOrEqual -> ("int64LessThanOrEqualTo", 0) +// | PT.StringConcat -> ("stringAppend", 0) +// | PT.ComparisonEquals -> ("equals", 0) +// | PT.ComparisonNotEquals -> ("notEquals", 0) + + +// module LetPattern = +// let rec toRT (p : PT.LetPattern) : RT.LetPattern = +// match p with +// | PT.LPVariable(id, str) -> RT.LPVariable(id, str) +// | PT.LPUnit id -> RT.LPUnit id +// | PT.LPTuple(id, first, second, theRest) -> +// RT.LPTuple(id, toRT first, toRT second, List.map toRT theRest) + + +// module MatchPattern = +// let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = +// match p with +// | PT.MPVariable(id, str) -> RT.MPVariable(id, str) +// | PT.MPEnum(id, caseName, fieldPats) -> +// RT.MPEnum(id, caseName, List.map toRT fieldPats) +// | PT.MPInt64(id, i) -> RT.MPInt64(id, i) +// | PT.MPUInt64(id, i) -> RT.MPUInt64(id, i) +// | PT.MPInt8(id, i) -> RT.MPInt8(id, i) +// | PT.MPUInt8(id, i) -> RT.MPUInt8(id, i) +// | PT.MPInt16(id, i) -> RT.MPInt16(id, i) +// | PT.MPUInt16(id, i) -> RT.MPUInt16(id, i) +// | PT.MPInt32(id, i) -> RT.MPInt32(id, i) +// | PT.MPUInt32(id, i) -> RT.MPUInt32(id, i) +// | PT.MPInt128(id, i) -> RT.MPInt128(id, i) +// | PT.MPUInt128(id, i) -> RT.MPUInt128(id, i) +// | PT.MPBool(id, b) -> RT.MPBool(id, b) +// | PT.MPChar(id, c) -> RT.MPChar(id, c) +// | PT.MPString(id, s) -> RT.MPString(id, s) +// | PT.MPFloat(id, s, w, f) -> +// let w = if w = "" then "0" else w +// RT.MPFloat(id, makeFloat s w f) +// | PT.MPUnit id -> RT.MPUnit id +// | PT.MPTuple(id, first, second, theRest) -> +// RT.MPTuple(id, toRT first, toRT second, List.map toRT theRest) +// | PT.MPList(id, pats) -> RT.MPList(id, List.map toRT pats) +// | PT.MPListCons(id, head, tail) -> RT.MPListCons(id, toRT head, toRT tail) module Expr = let rec toRT (e : PT.Expr) : RT.Expr = match e with - | PT.EChar(id, char) -> RT.EChar(id, char) + | PT.EUnit id -> RT.EUnit id + + | PT.EBool(id, b) -> RT.EBool(id, b) + + // | PT.EInt8(id, num) -> RT.EInt8(id, num) + // | PT.EUInt8(id, num) -> RT.EUInt8(id, num) + // | PT.EInt16(id, num) -> RT.EInt16(id, num) + // | PT.EUInt16(id, num) -> RT.EUInt16(id, num) + // | PT.EInt32(id, num) -> RT.EInt32(id, num) + // | PT.EUInt32(id, num) -> RT.EUInt32(id, num) | PT.EInt64(id, num) -> RT.EInt64(id, num) - | PT.EUInt64(id, num) -> RT.EUInt64(id, num) - | PT.EInt8(id, num) -> RT.EInt8(id, num) - | PT.EUInt8(id, num) -> RT.EUInt8(id, num) - | PT.EInt16(id, num) -> RT.EInt16(id, num) - | PT.EUInt16(id, num) -> RT.EUInt16(id, num) - | PT.EInt32(id, num) -> RT.EInt32(id, num) - | PT.EUInt32(id, num) -> RT.EUInt32(id, num) - | PT.EInt128(id, num) -> RT.EInt128(id, num) - | PT.EUInt128(id, num) -> RT.EUInt128(id, num) + // | PT.EUInt64(id, num) -> RT.EUInt64(id, num) + // | PT.EInt128(id, num) -> RT.EInt128(id, num) + // | PT.EUInt128(id, num) -> RT.EUInt128(id, num) + + // | PT.EFloat(id, sign, whole, fraction) -> + // let whole = if whole = "" then "0" else whole + // let fraction = if fraction = "" then "0" else fraction + // RT.EFloat(id, makeFloat sign whole fraction) + // | PT.EChar(id, char) -> RT.EChar(id, char) | PT.EString(id, segments) -> RT.EString(id, List.map stringSegmentToRT segments) - | PT.EFloat(id, sign, whole, fraction) -> - let whole = if whole = "" then "0" else whole - let fraction = if fraction = "" then "0" else fraction - RT.EFloat(id, makeFloat sign whole fraction) - | PT.EBool(id, b) -> RT.EBool(id, b) - | PT.EUnit id -> RT.EUnit id - | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) - | PT.EConstant(id, Error err) -> - RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) + // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) + // | PT.EConstant(id, Error err) -> + // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - | PT.EVariable(id, var) -> RT.EVariable(id, var) + // | PT.EVariable(id, var) -> RT.EVariable(id, var) - | PT.EFieldAccess(id, obj, fieldname) -> RT.EFieldAccess(id, toRT obj, fieldname) + // | PT.EFieldAccess(id, obj, fieldname) -> RT.EFieldAccess(id, toRT obj, fieldname) | PT.EApply(id, fnName, typeArgs, args) -> RT.EApply( @@ -206,146 +215,146 @@ module Expr = | PT.EFnName(id, Error err) -> RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - // CLEANUP tidy infix stuff - extract to another fn? - | PT.EInfix(id, PT.InfixFnCall fnName, left, right) -> - let (fn, version) = InfixFnName.toFnName fnName - let name = RT.FQFnName.Builtin({ name = fn; version = version }) - RT.EApply( - id, - RT.EFnName(id, name), - [], - NEList.ofList (toRT left) [ toRT right ] - ) - | PT.EInfix(id, PT.BinOp PT.BinOpAnd, left, right) -> - RT.EAnd(id, toRT left, toRT right) - | PT.EInfix(id, PT.BinOp PT.BinOpOr, left, right) -> - RT.EOr(id, toRT left, toRT right) - - | PT.ELambda(id, pats, body) -> - RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) - - | PT.ELet(id, pattern, rhs, body) -> - RT.ELet(id, LetPattern.toRT pattern, toRT rhs, toRT body) - - | PT.EIf(id, cond, thenExpr, elseExpr) -> - RT.EIf(id, toRT cond, toRT thenExpr, elseExpr |> Option.map toRT) - - | PT.EList(id, exprs) -> RT.EList(id, List.map toRT exprs) - - | PT.ETuple(id, first, second, theRest) -> - RT.ETuple(id, toRT first, toRT second, List.map toRT theRest) - - | PT.ERecord(id, Ok typeName, fields) -> - match fields with - | [] -> - let fields = fields |> List.map Tuple2.second |> List.map toRT - RT.EError( - id, - RT.RuntimeError.oldError "Record must have at least one field", - fields - ) - | head :: tail -> - let fields = - NEList.ofList head tail - |> NEList.map (fun (name, expr) -> (name, toRT expr)) - RT.ERecord(id, FQTypeName.toRT typeName, fields) - | PT.ERecord(id, Error err, fields) -> - RT.EError( - id, - err |> NameResolutionError.RTE.toRuntimeError, - fields |> List.map Tuple2.second |> List.map toRT - ) - - | PT.ERecordUpdate(id, record, updates) -> - RT.ERecordUpdate( - id, - toRT record, - updates |> NEList.map (fun (fieldName, update) -> (fieldName, toRT update)) - ) - - | PT.EPipe(pipeID, expr1, rest) -> - // Convert v |> fn1 a |> fn2 |> fn3 b c - // into fn3 (fn2 (fn1 v a)) b c - let folder (prev : RT.Expr) (next : PT.PipeExpr) : RT.Expr = - let applyFn (expr : RT.Expr) (args : List) = - let typeArgs = [] - RT.EApply(pipeID, expr, typeArgs, NEList.ofList prev args) - - match next with - | PT.EPipeFnCall(id, Error err, _typeArgs, exprs) -> - let err = NameResolutionError.RTE.toRuntimeError err - let addlExprs = List.map toRT exprs - RT.EError(id, err, prev :: addlExprs) - | PT.EPipeFnCall(id, Ok fnName, typeArgs, exprs) -> - RT.EApply( - id, - RT.EFnName(id, FQFnName.toRT fnName), - List.map TypeReference.toRT typeArgs, - exprs |> List.map toRT |> NEList.ofList prev - ) - | PT.EPipeInfix(id, PT.InfixFnCall fnName, expr) -> - let (fn, version) = InfixFnName.toFnName fnName - let name = PT.FQFnName.Builtin({ name = fn; version = version }) - RT.EApply( - id, - RT.EFnName(id, FQFnName.toRT name), - [], - NEList.doubleton prev (toRT expr) - ) - // Binops work pretty naturally here - | PT.EPipeInfix(id, PT.BinOp op, expr) -> - match op with - | PT.BinOpAnd -> RT.EAnd(id, prev, toRT expr) - | PT.BinOpOr -> RT.EOr(id, prev, toRT expr) - | PT.EPipeEnum(id, Ok typeName, caseName, fields) -> - RT.EEnum( - id, - FQTypeName.toRT typeName, - caseName, - prev :: (List.map toRT fields) - ) - | PT.EPipeEnum(id, Error err, _caseName, fields) -> - RT.EError( - id, - NameResolutionError.RTE.toRuntimeError err, - prev :: (List.map toRT fields) - ) - | PT.EPipeVariable(id, name, exprs) -> - applyFn (RT.EVariable(id, name)) (List.map toRT exprs) - | PT.EPipeLambda(id, pats, body) -> - applyFn (RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body)) [] - - let init = toRT expr1 - List.fold folder init rest - - | PT.EMatch(id, mexpr, cases) -> - match cases with - | [] -> - RT.EError( - id, - RT.RuntimeError.oldError "Match must have at least one case", - [ toRT mexpr ] - ) - | head :: tail -> - let cases = - NEList.ofList head tail - |> NEList.map (fun case -> - let pattern = MatchPattern.toRT case.pat - let whenCondition = Option.map toRT case.whenCondition - let expr = toRT case.rhs - let result : RT.MatchCase = - { pat = pattern; whenCondition = whenCondition; rhs = expr } - result) - - RT.EMatch(id, toRT mexpr, cases) - - | PT.EEnum(id, Ok typeName, caseName, fields) -> - RT.EEnum(id, FQTypeName.toRT typeName, caseName, List.map toRT fields) - | PT.EEnum(id, Error err, _caseName, fields) -> - RT.EError(id, NameResolutionError.RTE.toRuntimeError err, List.map toRT fields) - - | PT.EDict(id, entries) -> - RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) + // // CLEANUP tidy infix stuff - extract to another fn? + // | PT.EInfix(id, PT.InfixFnCall fnName, left, right) -> + // let (fn, version) = InfixFnName.toFnName fnName + // let name = RT.FQFnName.Builtin({ name = fn; version = version }) + // RT.EApply( + // id, + // RT.EFnName(id, name), + // [], + // NEList.ofList (toRT left) [ toRT right ] + // ) + // | PT.EInfix(id, PT.BinOp PT.BinOpAnd, left, right) -> + // RT.EAnd(id, toRT left, toRT right) + // | PT.EInfix(id, PT.BinOp PT.BinOpOr, left, right) -> + // RT.EOr(id, toRT left, toRT right) + + // | PT.ELambda(id, pats, body) -> + // RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) + + // | PT.ELet(id, pattern, rhs, body) -> + // RT.ELet(id, LetPattern.toRT pattern, toRT rhs, toRT body) + + // | PT.EIf(id, cond, thenExpr, elseExpr) -> + // RT.EIf(id, toRT cond, toRT thenExpr, elseExpr |> Option.map toRT) + + // | PT.EList(id, exprs) -> RT.EList(id, List.map toRT exprs) + + // | PT.ETuple(id, first, second, theRest) -> + // RT.ETuple(id, toRT first, toRT second, List.map toRT theRest) + + // | PT.ERecord(id, Ok typeName, fields) -> + // match fields with + // | [] -> + // let fields = fields |> List.map Tuple2.second |> List.map toRT + // RT.EError( + // id, + // RT.RuntimeError.oldError "Record must have at least one field", + // fields + // ) + // | head :: tail -> + // let fields = + // NEList.ofList head tail + // |> NEList.map (fun (name, expr) -> (name, toRT expr)) + // RT.ERecord(id, FQTypeName.toRT typeName, fields) + // | PT.ERecord(id, Error err, fields) -> + // RT.EError( + // id, + // err |> NameResolutionError.RTE.toRuntimeError, + // fields |> List.map Tuple2.second |> List.map toRT + // ) + + // | PT.ERecordUpdate(id, record, updates) -> + // RT.ERecordUpdate( + // id, + // toRT record, + // updates |> NEList.map (fun (fieldName, update) -> (fieldName, toRT update)) + // ) + + // | PT.EPipe(pipeID, expr1, rest) -> + // // Convert v |> fn1 a |> fn2 |> fn3 b c + // // into fn3 (fn2 (fn1 v a)) b c + // let folder (prev : RT.Expr) (next : PT.PipeExpr) : RT.Expr = + // let applyFn (expr : RT.Expr) (args : List) = + // let typeArgs = [] + // RT.EApply(pipeID, expr, typeArgs, NEList.ofList prev args) + + // match next with + // | PT.EPipeFnCall(id, Error err, _typeArgs, exprs) -> + // let err = NameResolutionError.RTE.toRuntimeError err + // let addlExprs = List.map toRT exprs + // RT.EError(id, err, prev :: addlExprs) + // | PT.EPipeFnCall(id, Ok fnName, typeArgs, exprs) -> + // RT.EApply( + // id, + // RT.EFnName(id, FQFnName.toRT fnName), + // List.map TypeReference.toRT typeArgs, + // exprs |> List.map toRT |> NEList.ofList prev + // ) + // | PT.EPipeInfix(id, PT.InfixFnCall fnName, expr) -> + // let (fn, version) = InfixFnName.toFnName fnName + // let name = PT.FQFnName.Builtin({ name = fn; version = version }) + // RT.EApply( + // id, + // RT.EFnName(id, FQFnName.toRT name), + // [], + // NEList.doubleton prev (toRT expr) + // ) + // // Binops work pretty naturally here + // | PT.EPipeInfix(id, PT.BinOp op, expr) -> + // match op with + // | PT.BinOpAnd -> RT.EAnd(id, prev, toRT expr) + // | PT.BinOpOr -> RT.EOr(id, prev, toRT expr) + // | PT.EPipeEnum(id, Ok typeName, caseName, fields) -> + // RT.EEnum( + // id, + // FQTypeName.toRT typeName, + // caseName, + // prev :: (List.map toRT fields) + // ) + // | PT.EPipeEnum(id, Error err, _caseName, fields) -> + // RT.EError( + // id, + // NameResolutionError.RTE.toRuntimeError err, + // prev :: (List.map toRT fields) + // ) + // | PT.EPipeVariable(id, name, exprs) -> + // applyFn (RT.EVariable(id, name)) (List.map toRT exprs) + // | PT.EPipeLambda(id, pats, body) -> + // applyFn (RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body)) [] + + // let init = toRT expr1 + // List.fold folder init rest + + // | PT.EMatch(id, mexpr, cases) -> + // match cases with + // | [] -> + // RT.EError( + // id, + // RT.RuntimeError.oldError "Match must have at least one case", + // [ toRT mexpr ] + // ) + // | head :: tail -> + // let cases = + // NEList.ofList head tail + // |> NEList.map (fun case -> + // let pattern = MatchPattern.toRT case.pat + // let whenCondition = Option.map toRT case.whenCondition + // let expr = toRT case.rhs + // let result : RT.MatchCase = + // { pat = pattern; whenCondition = whenCondition; rhs = expr } + // result) + + // RT.EMatch(id, toRT mexpr, cases) + + // | PT.EEnum(id, Ok typeName, caseName, fields) -> + // RT.EEnum(id, FQTypeName.toRT typeName, caseName, List.map toRT fields) + // | PT.EEnum(id, Error err, _caseName, fields) -> + // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, List.map toRT fields) + + // | PT.EDict(id, entries) -> + // RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment = @@ -354,77 +363,77 @@ module Expr = | PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr) -module Const = - let rec toRT (c : PT.Const) : RT.Const = - match c with - | PT.Const.CInt64 i -> RT.CInt64 i - | PT.Const.CUInt64 i -> RT.CUInt64 i - | PT.Const.CInt8 i -> RT.CInt8 i - | PT.Const.CUInt8 i -> RT.CUInt8 i - | PT.Const.CInt16 i -> RT.CInt16 i - | PT.Const.CUInt16 i -> RT.CUInt16 i - | PT.Const.CInt32 i -> RT.CInt32 i - | PT.Const.CUInt32 i -> RT.CUInt32 i - | PT.Const.CInt128 i -> RT.CInt128 i - | PT.Const.CUInt128 i -> RT.CUInt128 i - | PT.Const.CBool b -> RT.CBool b - | PT.Const.CString s -> RT.CString s - | PT.Const.CChar c -> RT.CChar c - | PT.Const.CFloat(sign, w, f) -> RT.CFloat(sign, w, f) - | PT.Const.CUnit -> RT.CUnit - | PT.Const.CTuple(first, second, rest) -> - RT.CTuple(toRT first, toRT second, List.map toRT rest) - | PT.Const.CEnum(typeName, caseName, fields) -> - RT.CEnum( - NameResolution.toRT FQTypeName.toRT typeName, - caseName, - List.map toRT fields - ) - | PT.Const.CList items -> RT.CList(List.map toRT items) - | PT.Const.CDict entries -> RT.CDict(entries |> List.map (Tuple2.mapSecond toRT)) - - -module TypeDeclaration = - module RecordField = - let toRT (f : PT.TypeDeclaration.RecordField) : RT.TypeDeclaration.RecordField = - { name = f.name; typ = TypeReference.toRT f.typ } - - module EnumField = - let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = - TypeReference.toRT f.typ - - module EnumCase = - let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = - { name = c.name; fields = List.map EnumField.toRT c.fields } - - module Definition = - let toRT (d : PT.TypeDeclaration.Definition) : RT.TypeDeclaration.Definition = - match d with - | PT.TypeDeclaration.Definition.Alias(typ) -> - RT.TypeDeclaration.Alias(TypeReference.toRT typ) - - | PT.TypeDeclaration.Record fields -> - RT.TypeDeclaration.Record(NEList.map RecordField.toRT fields) - - | PT.TypeDeclaration.Enum cases -> - RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) - - let toRT (t : PT.TypeDeclaration.T) : RT.TypeDeclaration.T = - { typeParams = t.typeParams; definition = Definition.toRT t.definition } +// module Const = +// let rec toRT (c : PT.Const) : RT.Const = +// match c with +// | PT.Const.CInt64 i -> RT.CInt64 i +// | PT.Const.CUInt64 i -> RT.CUInt64 i +// | PT.Const.CInt8 i -> RT.CInt8 i +// | PT.Const.CUInt8 i -> RT.CUInt8 i +// | PT.Const.CInt16 i -> RT.CInt16 i +// | PT.Const.CUInt16 i -> RT.CUInt16 i +// | PT.Const.CInt32 i -> RT.CInt32 i +// | PT.Const.CUInt32 i -> RT.CUInt32 i +// | PT.Const.CInt128 i -> RT.CInt128 i +// | PT.Const.CUInt128 i -> RT.CUInt128 i +// | PT.Const.CBool b -> RT.CBool b +// | PT.Const.CString s -> RT.CString s +// | PT.Const.CChar c -> RT.CChar c +// | PT.Const.CFloat(sign, w, f) -> RT.CFloat(sign, w, f) +// | PT.Const.CUnit -> RT.CUnit +// | PT.Const.CTuple(first, second, rest) -> +// RT.CTuple(toRT first, toRT second, List.map toRT rest) +// | PT.Const.CEnum(typeName, caseName, fields) -> +// RT.CEnum( +// NameResolution.toRT FQTypeName.toRT typeName, +// caseName, +// List.map toRT fields +// ) +// | PT.Const.CList items -> RT.CList(List.map toRT items) +// | PT.Const.CDict entries -> RT.CDict(entries |> List.map (Tuple2.mapSecond toRT)) + + +// module TypeDeclaration = +// module RecordField = +// let toRT (f : PT.TypeDeclaration.RecordField) : RT.TypeDeclaration.RecordField = +// { name = f.name; typ = TypeReference.toRT f.typ } + +// module EnumField = +// let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = +// TypeReference.toRT f.typ + +// module EnumCase = +// let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = +// { name = c.name; fields = List.map EnumField.toRT c.fields } + +// module Definition = +// let toRT (d : PT.TypeDeclaration.Definition) : RT.TypeDeclaration.Definition = +// match d with +// | PT.TypeDeclaration.Definition.Alias(typ) -> +// RT.TypeDeclaration.Alias(TypeReference.toRT typ) + +// | PT.TypeDeclaration.Record fields -> +// RT.TypeDeclaration.Record(NEList.map RecordField.toRT fields) + +// | PT.TypeDeclaration.Enum cases -> +// RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) + +// let toRT (t : PT.TypeDeclaration.T) : RT.TypeDeclaration.T = +// { typeParams = t.typeParams; definition = Definition.toRT t.definition } // -- // Package stuff // -- -module PackageType = - let toRT (t : PT.PackageType.PackageType) : RT.PackageType.PackageType = - { id = t.id; declaration = TypeDeclaration.toRT t.declaration } +// module PackageType = +// let toRT (t : PT.PackageType.PackageType) : RT.PackageType.PackageType = +// { id = t.id; declaration = TypeDeclaration.toRT t.declaration } -module PackageConstant = - let toRT - (c : PT.PackageConstant.PackageConstant) - : RT.PackageConstant.PackageConstant = - { id = c.id; body = Const.toRT c.body } +// module PackageConstant = +// let toRT +// (c : PT.PackageConstant.PackageConstant) +// : RT.PackageConstant.PackageConstant = +// { id = c.id; body = Const.toRT c.body } module PackageFn = module Parameter = @@ -440,50 +449,50 @@ module PackageFn = -// -- -// User stuff -// -- -module Handler = - module CronInterval = - let toRT (ci : PT.Handler.CronInterval) : RT.Handler.CronInterval = - match ci with - | PT.Handler.EveryDay -> RT.Handler.EveryDay - | PT.Handler.EveryWeek -> RT.Handler.EveryWeek - | PT.Handler.EveryFortnight -> RT.Handler.EveryFortnight - | PT.Handler.EveryHour -> RT.Handler.EveryHour - | PT.Handler.Every12Hours -> RT.Handler.Every12Hours - | PT.Handler.EveryMinute -> RT.Handler.EveryMinute - - module Spec = - let toRT (s : PT.Handler.Spec) : RT.Handler.Spec = - match s with - | PT.Handler.HTTP(route, method) -> RT.Handler.HTTP(route, method) - | PT.Handler.Worker name -> RT.Handler.Worker name - | PT.Handler.Cron(name, interval) -> - RT.Handler.Cron(name, CronInterval.toRT interval) - | PT.Handler.REPL name -> RT.Handler.REPL name - - let toRT (h : PT.Handler.T) : RT.Handler.T = - { tlid = h.tlid; ast = Expr.toRT h.ast; spec = Spec.toRT h.spec } - -module DB = - let toRT (db : PT.DB.T) : RT.DB.T = - { tlid = db.tlid - name = db.name - version = db.version - typ = TypeReference.toRT db.typ } - -module Secret = - let toRT (s : PT.Secret.T) : RT.Secret.T = - { name = s.name; value = s.value; version = s.version } +// // -- +// // User stuff +// // -- +// module Handler = +// module CronInterval = +// let toRT (ci : PT.Handler.CronInterval) : RT.Handler.CronInterval = +// match ci with +// | PT.Handler.EveryDay -> RT.Handler.EveryDay +// | PT.Handler.EveryWeek -> RT.Handler.EveryWeek +// | PT.Handler.EveryFortnight -> RT.Handler.EveryFortnight +// | PT.Handler.EveryHour -> RT.Handler.EveryHour +// | PT.Handler.Every12Hours -> RT.Handler.Every12Hours +// | PT.Handler.EveryMinute -> RT.Handler.EveryMinute + +// module Spec = +// let toRT (s : PT.Handler.Spec) : RT.Handler.Spec = +// match s with +// | PT.Handler.HTTP(route, method) -> RT.Handler.HTTP(route, method) +// | PT.Handler.Worker name -> RT.Handler.Worker name +// | PT.Handler.Cron(name, interval) -> +// RT.Handler.Cron(name, CronInterval.toRT interval) +// | PT.Handler.REPL name -> RT.Handler.REPL name + +// let toRT (h : PT.Handler.T) : RT.Handler.T = +// { tlid = h.tlid; ast = Expr.toRT h.ast; spec = Spec.toRT h.spec } + +// module DB = +// let toRT (db : PT.DB.T) : RT.DB.T = +// { tlid = db.tlid +// name = db.name +// version = db.version +// typ = TypeReference.toRT db.typ } + +// module Secret = +// let toRT (s : PT.Secret.T) : RT.Secret.T = +// { name = s.name; value = s.value; version = s.version } module PackageManager = let toRT (pm : PT.PackageManager) : RT.PackageManager = - { getType = fun id -> pm.getType id |> Ply.map (Option.map PackageType.toRT) - getConstant = - fun id -> pm.getConstant id |> Ply.map (Option.map PackageConstant.toRT) + { //getType = fun id -> pm.getType id |> Ply.map (Option.map PackageType.toRT) + //getConstant = + // fun id -> pm.getConstant id |> Ply.map (Option.map PackageConstant.toRT) getFn = fun id -> pm.getFn id |> Ply.map (Option.map PackageFn.toRT) init = pm.init } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 043b6e62b0..a857253e0e 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -35,7 +35,7 @@ open Prelude let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$" let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$" -let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" +//let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let assertBuiltin @@ -47,65 +47,57 @@ let assertBuiltin assert_ "version can't be negative" [ "version", version ] (version >= 0) -// lol maybe pass this in, and satisfy secretly via PT PM? -// Then we could totally remove Name from the RT Package item types -// type FQToStringer = -// { type: uuid -> string -// constant: uuid -> string -// fn: uuid -> string } +// /// Fully-Qualified Type Name +// /// +// /// Used to reference a type defined in a Package +// module FQTypeName = +// /// The id of a type in the package manager +// type Package = uuid +// type FQTypeName = Package of Package -/// Fully-Qualified Type Name -/// -/// Used to reference a type defined in a Package -module FQTypeName = - /// The id of a type in the package manager - type Package = uuid +// let package (id : uuid) : Package = id - type FQTypeName = Package of Package +// let fqPackage (id : uuid) : FQTypeName = Package id - let package (id : uuid) : Package = id +// let toString (name : FQTypeName) : string = +// match name with +// | Package p -> string p // TODO: better - let fqPackage (id : uuid) : FQTypeName = Package id - let toString (name : FQTypeName) : string = - match name with - | Package p -> string p // TODO: better +// /// A Fully-Qualified Constant Name +// /// +// /// Used to reference a constant defined by the runtime or in a Package +// module FQConstantName = +// /// A constant built into the runtime +// type Builtin = { name : string; version : int } +// /// The id of a constant in the package manager +// type Package = uuid -/// A Fully-Qualified Constant Name -/// -/// Used to reference a constant defined by the runtime or in a Package -module FQConstantName = - /// A constant built into the runtime - type Builtin = { name : string; version : int } +// type FQConstantName = +// | Builtin of Builtin +// | Package of Package - /// The id of a constant in the package manager - type Package = uuid +// let assertConstantName (name : string) : unit = +// assertRe "Constant name must match" constantNamePattern name - type FQConstantName = - | Builtin of Builtin - | Package of Package +// let builtin (name : string) (version : int) : Builtin = +// assertBuiltin name version assertConstantName +// { name = name; version = version } - let assertConstantName (name : string) : unit = - assertRe "Constant name must match" constantNamePattern name +// let package (id : uuid) : Package = id - let builtin (name : string) (version : int) : Builtin = - assertBuiltin name version assertConstantName - { name = name; version = version } +// let fqPackage (id : uuid) : FQConstantName = Package id - let package (id : uuid) : Package = id +// let builtinToString (s : Builtin) : string = +// let name = s.name +// if s.version = 0 then name else $"{name}_v{s.version}" - let fqPackage (id : uuid) : FQConstantName = Package id - - let builtinToString (s : Builtin) : string = - let name = s.name - if s.version = 0 then name else $"{name}_v{s.version}" - - let toString (name : FQConstantName) : string = - match name with - | Builtin b -> builtinToString b - | Package p -> string p // TODO: better +// let toString (name : FQConstantName) : string = +// match name with +// | Builtin b -> builtinToString b +// | Package p -> string p // TODO: better /// A Fully-Qualified Function Name @@ -156,34 +148,34 @@ module FQFnName = type KnownType = | KTUnit | KTBool + // | KTInt8 + // | KTUInt8 + // | KTInt16 + // | KTUInt16 + // | KTInt32 + // | KTUInt32 | KTInt64 - | KTUInt64 - | KTInt8 - | KTUInt8 - | KTInt16 - | KTUInt16 - | KTInt32 - | KTUInt32 - | KTInt128 - | KTUInt128 - | KTFloat - | KTChar + // | KTUInt64 + // | KTInt128 + // | KTUInt128 + // | KTFloat + // | KTChar | KTString - | KTUuid - | KTDateTime - - /// let empty = [] // KTList Unknown - /// let intList = [1] // KTList (ValueType.Known KTInt64) - | KTList of ValueType - - /// Intuitively, since Dvals generate KnownTypes, you would think that we can - /// use KnownTypes in a KTTuple. - /// - /// However, we sometimes construct a KTTuple to repesent the type of a Tuple - /// which doesn't exist. For example, in `List.zip [] []`, we create the result - /// from the types of the two lists, which themselves might be (and likely are) - /// `Unknown`. - | KTTuple of ValueType * ValueType * List + // | KTUuid + // | KTDateTime + + // /// let empty = [] // KTList Unknown + // /// let intList = [1] // KTList (ValueType.Known KTInt64) + // | KTList of ValueType + + // /// Intuitively, since Dvals generate KnownTypes, you would think that we can + // /// use KnownTypes in a KTTuple. + // /// + // /// However, we sometimes construct a KTTuple to repesent the type of a Tuple + // /// which doesn't exist. For example, in `List.zip [] []`, we create the result + // /// from the types of the two lists, which themselves might be (and likely are) + // /// `Unknown`. + // | KTTuple of ValueType * ValueType * List /// let f = (fun x -> x) // KTFn([Unknown], Unknown) /// let intF = (fun (x: Int) -> x) // KTFn([Known KTInt64], Unknown) @@ -200,20 +192,20 @@ type KnownType = /// `[z1, z2]` is allowed now but might not be allowed later | KTFn of args : NEList * ret : ValueType - /// At time of writing, all DBs are of a specific type, and DBs may only be - /// referenced directly, but we expect to eventually allow references to DBs - /// where the type may be unknown - /// List.head ([]: List>) // KTDB (Unknown) - | KTDB of ValueType + // /// At time of writing, all DBs are of a specific type, and DBs may only be + // /// referenced directly, but we expect to eventually allow references to DBs + // /// where the type may be unknown + // /// List.head ([]: List>) // KTDB (Unknown) + // | KTDB of ValueType - /// let n = None // type args: [Unknown] - /// let s = Some(5) // type args: [Known KTInt64] - /// let o = Ok (5) // type args: [Known KTInt64, Unknown] - /// let e = Error ("str") // type args: [Unknown, Known KTString] - | KTCustomType of FQTypeName.FQTypeName * typeArgs : List + // /// let n = None // type args: [Unknown] + // /// let s = Some(5) // type args: [Known KTInt64] + // /// let o = Ok (5) // type args: [Known KTInt64, Unknown] + // /// let e = Error ("str") // type args: [Unknown, Known KTString] + // | KTCustomType of FQTypeName.FQTypeName * typeArgs : List - /// let myDict = {} // KTDict Unknown - | KTDict of ValueType + // /// let myDict = {} // KTDict Unknown + // | KTDict of ValueType /// Represents the actual type of a Dval /// @@ -235,36 +227,36 @@ module ValueType = let unit = known KTUnit let bool = known KTBool + // let int8 = known KTInt8 + // let uint8 = known KTUInt8 + // let int16 = known KTInt16 + // let uint16 = known KTUInt16 + // let int32 = known KTInt32 + // let uint32 = known KTUInt32 let int64 = known KTInt64 - let uint64 = known KTUInt64 - let int8 = known KTInt8 - let uint8 = known KTUInt8 - let int16 = known KTInt16 - let uint16 = known KTUInt16 - let int32 = known KTInt32 - let uint32 = known KTUInt32 - let int128 = known KTInt128 - let uint128 = known KTUInt128 - let float = known KTFloat - let char = known KTChar + // let uint64 = known KTUInt64 + // let int128 = known KTInt128 + // let uint128 = known KTUInt128 + // let float = known KTFloat + // let char = known KTChar let string = known KTString - let dateTime = known KTDateTime - let uuid = known KTUuid - - let list (inner : ValueType) : ValueType = known (KTList inner) - let dict (inner : ValueType) : ValueType = known (KTDict inner) - let tuple - (first : ValueType) - (second : ValueType) - (theRest : List) - : ValueType = - KTTuple(first, second, theRest) |> known - - let customType - (typeName : FQTypeName.FQTypeName) - (typeArgs : List) - : ValueType = - KTCustomType(typeName, typeArgs) |> known + // let dateTime = known KTDateTime + // let uuid = known KTUuid + + // let list (inner : ValueType) : ValueType = known (KTList inner) + // let dict (inner : ValueType) : ValueType = known (KTDict inner) + // let tuple + // (first : ValueType) + // (second : ValueType) + // (theRest : List) + // : ValueType = + // KTTuple(first, second, theRest) |> known + + // let customType + // (typeName : FQTypeName.FQTypeName) + // (typeArgs : List) + // : ValueType = + // KTCustomType(typeName, typeArgs) |> known let rec toString (vt : ValueType) : string = match vt with @@ -273,45 +265,45 @@ module ValueType = match kt with | KTUnit -> "Unit" | KTBool -> "Bool" + // | KTInt8 -> "Int8" + // | KTUInt8 -> "UInt8" + // | KTInt16 -> "Int16" + // | KTUInt16 -> "UInt16" + // | KTInt32 -> "Int32" + // | KTUInt32 -> "UInt32" | KTInt64 -> "Int64" - | KTUInt64 -> "UInt64" - | KTInt8 -> "Int8" - | KTUInt8 -> "UInt8" - | KTInt16 -> "Int16" - | KTUInt16 -> "UInt16" - | KTInt32 -> "Int32" - | KTUInt32 -> "UInt32" - | KTInt128 -> "Int128" - | KTUInt128 -> "UInt128" - | KTFloat -> "Float" - | KTChar -> "Char" + // | KTUInt64 -> "UInt64" + // | KTInt128 -> "Int128" + // | KTUInt128 -> "UInt128" + // | KTFloat -> "Float" + // | KTChar -> "Char" | KTString -> "String" - | KTUuid -> "Uuid" - | KTDateTime -> "DateTime" - - | KTList inner -> $"List<{toString inner}>" - | KTDict inner -> $"Dict<{toString inner}>" - | KTTuple(first, second, theRest) -> - first :: second :: theRest - |> List.map toString - |> String.concat " * " - |> fun inner -> $"({inner})" - | KTCustomType(typeName, typeArgs) -> - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> List.map toString - |> String.concat ", " - |> fun inner -> $"<{inner}>" - - $"{FQTypeName.toString typeName}{typeArgsPart}" + // | KTUuid -> "Uuid" + // | KTDateTime -> "DateTime" + + // | KTList inner -> $"List<{toString inner}>" + // | KTDict inner -> $"Dict<{toString inner}>" + // | KTTuple(first, second, theRest) -> + // first :: second :: theRest + // |> List.map toString + // |> String.concat " * " + // |> fun inner -> $"({inner})" + // | KTCustomType(typeName, typeArgs) -> + // let typeArgsPart = + // match typeArgs with + // | [] -> "" + // | _ -> + // typeArgs + // |> List.map toString + // |> String.concat ", " + // |> fun inner -> $"<{inner}>" + + // $"{FQTypeName.toString typeName}{typeArgsPart}" | KTFn(args, ret) -> NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " - | KTDB inner -> $"DB<{toString inner}>" + //| KTDB inner -> $"DB<{toString inner}>" let rec private mergeKnownTypes @@ -322,42 +314,42 @@ module ValueType = match left, right with | KTUnit, KTUnit -> KTUnit |> Ok | KTBool, KTBool -> KTBool |> Ok + // | KTInt8, KTInt8 -> KTInt8 |> Ok + // | KTUInt8, KTUInt8 -> KTUInt8 |> Ok + // | KTInt16, KTInt16 -> KTInt16 |> Ok + // | KTUInt16, KTUInt16 -> KTUInt16 |> Ok + // | KTInt32, KTInt32 -> KTInt32 |> Ok + // | KTUInt32, KTUInt32 -> KTUInt32 |> Ok | KTInt64, KTInt64 -> KTInt64 |> Ok - | KTUInt64, KTUInt64 -> KTUInt64 |> Ok - | KTInt8, KTInt8 -> KTInt8 |> Ok - | KTUInt8, KTUInt8 -> KTUInt8 |> Ok - | KTInt16, KTInt16 -> KTInt16 |> Ok - | KTUInt16, KTUInt16 -> KTUInt16 |> Ok - | KTInt32, KTInt32 -> KTInt32 |> Ok - | KTUInt32, KTUInt32 -> KTUInt32 |> Ok - | KTInt128, KTInt128 -> KTInt128 |> Ok - | KTUInt128, KTUInt128 -> KTUInt128 |> Ok - | KTFloat, KTFloat -> KTFloat |> Ok - | KTChar, KTChar -> KTChar |> Ok + // | KTUInt64, KTUInt64 -> KTUInt64 |> Ok + // | KTInt128, KTInt128 -> KTInt128 |> Ok + // | KTUInt128, KTUInt128 -> KTUInt128 |> Ok + // | KTFloat, KTFloat -> KTFloat |> Ok + // | KTChar, KTChar -> KTChar |> Ok | KTString, KTString -> KTString |> Ok - | KTUuid, KTUuid -> KTUuid |> Ok - | KTDateTime, KTDateTime -> KTDateTime |> Ok - - | KTList left, KTList right -> r left right |> Result.map KTList - | KTDict left, KTDict right -> r left right |> Result.map KTDict - | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> - let firstMerged = r l1 r1 - let secondMerged = r l2 r2 - let restMerged = List.map2 r ls rs |> Result.collect - - match firstMerged, secondMerged, restMerged with - | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) - | _ -> Error() - - | KTCustomType(lName, lArgs), KTCustomType(rName, rArgs) -> - if lName <> rName then - Error() - else if List.length lArgs <> List.length rArgs then - Error() - else - List.map2 r lArgs rArgs - |> Result.collect - |> Result.map (fun args -> KTCustomType(lName, args)) + // | KTUuid, KTUuid -> KTUuid |> Ok + // | KTDateTime, KTDateTime -> KTDateTime |> Ok + + // | KTList left, KTList right -> r left right |> Result.map KTList + // | KTDict left, KTDict right -> r left right |> Result.map KTDict + // | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> + // let firstMerged = r l1 r1 + // let secondMerged = r l2 r2 + // let restMerged = List.map2 r ls rs |> Result.collect + + // match firstMerged, secondMerged, restMerged with + // | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) + // | _ -> Error() + + // | KTCustomType(lName, lArgs), KTCustomType(rName, rArgs) -> + // if lName <> rName then + // Error() + // else if List.length lArgs <> List.length rArgs then + // Error() + // else + // List.map2 r lArgs rArgs + // |> Result.collect + // |> Result.map (fun args -> KTCustomType(lName, args)) | KTFn(lArgs, lRet), KTFn(rArgs, rRet) -> let argsMerged = NEList.map2 r lArgs rArgs |> Result.collectNE @@ -383,53 +375,53 @@ module ValueType = // Exprs // ------------ -/// The LHS pattern in -/// - a `let` binding (in `let x = 1`, the `x`) -/// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` -type LetPattern = - | LPUnit of id - | LPTuple of - id * - first : LetPattern * - second : LetPattern * - theRest : List - | LPVariable of id * name : string - - -/// The LHS of a `match` case -/// -/// i.e. the `true` (`MPBool true`) in -/// ```fsharp -/// match x with -/// | true -> "some text" -/// ``` -type MatchPattern = - | MPUnit of id - - | MPBool of id * bool - | MPInt8 of id * int8 - | MPUInt8 of id * uint8 - | MPInt16 of id * int16 - | MPUInt16 of id * uint16 - | MPInt32 of id * int32 - | MPUInt32 of id * uint32 - | MPInt64 of id * int64 - | MPUInt64 of id * uint64 - | MPInt128 of id * System.Int128 - | MPUInt128 of id * System.UInt128 - - | MPFloat of id * double - - | MPChar of id * string - | MPString of id * string - - | MPList of id * List - | MPListCons of id * head : MatchPattern * tail : MatchPattern - | MPTuple of id * MatchPattern * MatchPattern * List - - | MPEnum of id * caseName : string * fieldPatterns : List - - | MPVariable of id * string +// /// The LHS pattern in +// /// - a `let` binding (in `let x = 1`, the `x`) +// /// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` +// type LetPattern = +// | LPUnit of id +// | LPTuple of +// id * +// first : LetPattern * +// second : LetPattern * +// theRest : List +// | LPVariable of id * name : string + + +// /// The LHS of a `match` case +// /// +// /// i.e. the `true` (`MPBool true`) in +// /// ```fsharp +// /// match x with +// /// | true -> "some text" +// /// ``` +// type MatchPattern = +// | MPUnit of id + +// | MPBool of id * bool +// | MPInt8 of id * int8 +// | MPUInt8 of id * uint8 +// | MPInt16 of id * int16 +// | MPUInt16 of id * uint16 +// | MPInt32 of id * int32 +// | MPUInt32 of id * uint32 +// | MPInt64 of id * int64 +// | MPUInt64 of id * uint64 +// | MPInt128 of id * System.Int128 +// | MPUInt128 of id * System.UInt128 + +// | MPFloat of id * double + +// | MPChar of id * string +// | MPString of id * string + +// | MPList of id * List +// | MPListCons of id * head : MatchPattern * tail : MatchPattern +// | MPTuple of id * MatchPattern * MatchPattern * List + +// | MPEnum of id * caseName : string * fieldPatterns : List + +// | MPVariable of id * string type NameResolution<'a> = Result<'a, RuntimeError> @@ -437,30 +429,30 @@ type NameResolution<'a> = Result<'a, RuntimeError> and TypeReference = | TUnit | TBool + // | TInt8 + // | TUInt8 + // | TInt16 + // | TUInt16 + // | TInt32 + // | TUInt32 | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TFloat - | TChar + // | TUInt64 + // | TInt128 + // | TUInt128 + // | TFloat + // | TChar | TString - | TUuid - | TDateTime - | TList of TypeReference - | TTuple of TypeReference * TypeReference * List + // | TUuid + // | TDateTime + // | TList of TypeReference + // | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference - | TDB of TypeReference - | TVariable of string - | TCustomType of - NameResolution * - typeArgs : List - | TDict of TypeReference // CLEANUP add key type + // | TDB of TypeReference + // | TVariable of string + // | TCustomType of + // NameResolution * + // typeArgs : List + // | TDict of TypeReference // CLEANUP add key type member this.isFn() : bool = match this with @@ -472,31 +464,32 @@ and TypeReference = match t with | TUnit | TBool + // | TInt8 + // | TUInt8 + // | TInt16 + // | TUInt16 + // | TInt32 + // | TUInt32 | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TFloat - | TChar + // | TUInt64 + // | TInt128 + // | TUInt128 + // | TFloat + // | TChar | TString - | TUuid - | TDateTime -> true + // | TUuid + // | TDateTime + -> true - | TList t -> isConcrete t - | TTuple(t1, t2, ts) -> - isConcrete t1 && isConcrete t2 && List.forall isConcrete ts + // | TList t -> isConcrete t + // | TTuple(t1, t2, ts) -> + // isConcrete t1 && isConcrete t2 && List.forall isConcrete ts | TFn(ts, t) -> NEList.forall isConcrete ts && isConcrete t - | TDB t -> isConcrete t - | TCustomType(_, ts) -> List.forall isConcrete ts - | TDict t -> isConcrete t + // | TDB t -> isConcrete t + // | TCustomType(_, ts) -> List.forall isConcrete ts + // | TDict t -> isConcrete t - | TVariable _ -> false + //| TVariable _-> false isConcrete this @@ -508,48 +501,48 @@ and Expr = | EBool of id * bool - | EInt8 of id * int8 - | EUInt8 of id * uint8 - | EInt16 of id * int16 - | EUInt16 of id * uint16 - | EInt32 of id * int32 - | EUInt32 of id * uint32 + // | EInt8 of id * int8 + // | EUInt8 of id * uint8 + // | EInt16 of id * int16 + // | EUInt16 of id * uint16 + // | EInt32 of id * int32 + // | EUInt32 of id * uint32 | EInt64 of id * int64 - | EUInt64 of id * uint64 - | EInt128 of id * System.Int128 - | EUInt128 of id * System.UInt128 + // | EUInt64 of id * uint64 + // | EInt128 of id * System.Int128 + // | EUInt128 of id * System.UInt128 - | EFloat of id * double + // | EFloat of id * double - | EChar of id * string + // | EChar of id * string | EString of id * List - // flow control - | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option - | EMatch of id * Expr * NEList - | EAnd of id * lhs : Expr * rhs : Expr - | EOr of id * lhs : Expr * rhs : Expr + // // flow control + // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option + // | EMatch of id * Expr * NEList + // | EAnd of id * lhs : Expr * rhs : Expr + // | EOr of id * lhs : Expr * rhs : Expr - // declaring and referencing vars - | ELet of id * LetPattern * Expr * Expr - | EVariable of id * string - | EFieldAccess of id * Expr * string + // // declaring and referencing vars + // | ELet of id * LetPattern * Expr * Expr + // | EVariable of id * string + // | EFieldAccess of id * Expr * string // calling fns and other things | EFnName of id * FQFnName.FQFnName | EApply of id * Expr * typeArgs : List * args : NEList - | ELambda of id * pats : NEList * body : Expr + //| ELambda of id * pats : NEList * body : Expr - // structures - | EList of id * List - | ETuple of id * Expr * Expr * List - | EDict of id * List + // // structures + // | EList of id * List + // | ETuple of id * Expr * Expr * List + // | EDict of id * List - // working with custom types - | EConstant of id * FQConstantName.FQConstantName - | ERecord of id * FQTypeName.FQTypeName * NEList - | ERecordUpdate of id * record : Expr * updates : NEList - | EEnum of id * FQTypeName.FQTypeName * caseName : string * fields : List + // // working with custom types + // | EConstant of id * FQConstantName.FQConstantName + // | ERecord of id * FQTypeName.FQTypeName * NEList + // | ERecordUpdate of id * record : Expr * updates : NEList + // | EEnum of id * FQTypeName.FQTypeName * caseName : string * fields : List // A runtime error. This is included so that we can allow the program to run in the // presence of compile-time errors (which are converted to this error). We may @@ -557,7 +550,7 @@ and Expr = // subexpressions to evaluate before evaluating the error. | EError of id * RuntimeError * List -and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } +// and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } and StringSegment = | StringText of string @@ -566,24 +559,24 @@ and StringSegment = and DvalMap = Map -// Note to self: trying to remove symTable and typeSymbolTable here -// causes all sorts of scoping issues. Beware. -// (that said, typeSymbolTable seems the less-risky to remove...) -and LambdaImpl = - { typeSymbolTable : TypeSymbolTable - symtable : Symtable - parameters : NEList - body : Expr } +// // Note to self: trying to remove symTable and typeSymbolTable here +// // causes all sorts of scoping issues. Beware. +// // (that said, typeSymbolTable seems the less-risky to remove...) +// and LambdaImpl = +// { typeSymbolTable : TypeSymbolTable +// symtable : Symtable +// parameters : NEList +// body : Expr } and FnValImpl = - | Lambda of LambdaImpl + //| Lambda of LambdaImpl | NamedFn of FQFnName.FQFnName /// RuntimeError is the major way of representing errors in the runtime. These are /// primarily used for things where the user made an error, such as a type error, as /// opposed to a place where the runtime is flawed (use Exception.raiseInternal for those). /// See docs/errors.md for detailed discussion. -and RuntimeError = private RuntimeError of Dval +and RuntimeError = private RuntimeError of string //Dval // We use NoComparison here to avoid accidentally using structural comparison and [] Dval = @@ -592,57 +585,57 @@ and [] Dval = // Simple types | DBool of bool - | DInt8 of int8 - | DUInt8 of uint8 - | DInt16 of int16 - | DUInt16 of uint16 - | DInt32 of int32 - | DUInt32 of uint32 + // | DInt8 of int8 + // | DUInt8 of uint8 + // | DInt16 of int16 + // | DUInt16 of uint16 + // | DInt32 of int32 + // | DUInt32 of uint32 | DInt64 of int64 - | DUInt64 of uint64 - | DInt128 of System.Int128 - | DUInt128 of System.UInt128 + // | DUInt64 of uint64 + // | DInt128 of System.Int128 + // | DUInt128 of System.UInt128 - | DFloat of double + // | DFloat of double - | DChar of string // TextElements (extended grapheme clusters) are provided as strings + // | DChar of string // TextElements (extended grapheme clusters) are provided as strings | DString of string - | DDateTime of DarkDateTime.T - | DUuid of System.Guid - - // Compound types - | DList of ValueType * List - | DTuple of first : Dval * second : Dval * theRest : List - | DDict of - // This is the type of the _values_, not the keys. Once users can specify the - // key type, we likely will need to add a `keyType: ValueType` field here. - valueType : ValueType * - entries : DvalMap - - // custom types - | DRecord of - // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? - // CLEANUP we may need a sourceTypeArgs here as well - runtimeTypeName : FQTypeName.FQTypeName * - sourceTypeName : FQTypeName.FQTypeName * - typeArgs : List * - fields : DvalMap - - | DEnum of - // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? - // CLEANUP we may need a sourceTypeArgs here as well - runtimeTypeName : FQTypeName.FQTypeName * - sourceTypeName : FQTypeName.FQTypeName * - typeArgs : List * - caseName : string * - fields : List + // | DDateTime of DarkDateTime.T + // | DUuid of System.Guid + + // // Compound types + // | DList of ValueType * List + // | DTuple of first : Dval * second : Dval * theRest : List + // | DDict of + // // This is the type of the _values_, not the keys. Once users can specify the + // // key type, we likely will need to add a `keyType: ValueType` field here. + // valueType : ValueType * + // entries : DvalMap + + // // custom types + // | DRecord of + // // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? + // // CLEANUP we may need a sourceTypeArgs here as well + // runtimeTypeName : FQTypeName.FQTypeName * + // sourceTypeName : FQTypeName.FQTypeName * + // typeArgs : List * + // fields : DvalMap + + // | DEnum of + // // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? + // // CLEANUP we may need a sourceTypeArgs here as well + // runtimeTypeName : FQTypeName.FQTypeName * + // sourceTypeName : FQTypeName.FQTypeName * + // typeArgs : List * + // caseName : string * + // fields : List // Functions | DFnVal of FnValImpl // VTTODO I'm not sure how ValueType fits in here - // References - | DDB of name : string + // // References + // | DDB of name : string and DvalTask = Ply @@ -733,45 +726,46 @@ module CallStack = let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = { entrypoint = entrypoint; lastCalled = (entrypoint, None) } -module TypeReference = - let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = - TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.result), [ t1; t2 ]) +// module TypeReference = +// let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = +// TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.result), [ t1; t2 ]) - let option (t : TypeReference) : TypeReference = - TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.option), [ t ]) +// let option (t : TypeReference) : TypeReference = +// TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.option), [ t ]) module RuntimeError = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error - let toDT (RuntimeError e : RuntimeError) : Dval = e +// let toDT (RuntimeError e : RuntimeError) : Dval = e - let fromDT (dv : Dval) : RuntimeError = RuntimeError dv +// let fromDT (dv : Dval) : RuntimeError = RuntimeError dv - let case (caseName : string) (fields : List) : RuntimeError = - DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError +// let case (caseName : string) (fields : List) : RuntimeError = +// DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError - let cliError field = case "CliError" [ field ] +// let cliError field = case "CliError" [ field ] - let nameResolutionError field = case "NameResolutionError" [ field ] +// let nameResolutionError field = case "NameResolutionError" [ field ] - let typeCheckerError field = case "TypeCheckerError" [ field ] +// let typeCheckerError field = case "TypeCheckerError" [ field ] - let jsonError field = case "JsonError" [ field ] +// let jsonError field = case "JsonError" [ field ] - let sqlCompilerRuntimeError (internalError : RuntimeError) = - case "SqlCompilerRuntimeError" [ toDT internalError ] +// let sqlCompilerRuntimeError (internalError : RuntimeError) = +// case "SqlCompilerRuntimeError" [ toDT internalError ] - let executionError field = case "ExecutionError" [ field ] +// let executionError field = case "ExecutionError" [ field ] - let intError field = case "IntError" [ field ] +// let intError field = case "IntError" [ field ] // TODO remove all usages of this in favor of better error cases let oldError (msg : string) : RuntimeError = - case "OldStringErrorTODO" [ DString msg ] + //case "OldStringErrorTODO" [ DString msg ] + RuntimeError msg /// Note: in cases where it's awkward to niclude a CallStack, @@ -825,89 +819,95 @@ type Deprecation<'name> = | DeprecatedBecause of string -module TypeDeclaration = - type RecordField = { name : string; typ : TypeReference } +// module TypeDeclaration = +// type RecordField = { name : string; typ : TypeReference } - type EnumCase = { name : string; fields : List } +// type EnumCase = { name : string; fields : List } - type Definition = - | Alias of TypeReference - | Record of NEList - | Enum of NEList +// type Definition = +// | Alias of TypeReference +// | Record of NEList +// | Enum of NEList - type T = { typeParams : List; definition : Definition } +// type T = { typeParams : List; definition : Definition } // Functions for working with Dark runtime expressions module Expr = let toID (expr : Expr) : id = match expr with + | EUnit id + + | EBool(id, _) + + // | EInt8(id, _) + // | EUInt8(id, _) + // | EInt16(id, _) + // | EUInt16(id, _) + // | EInt32(id, _) + // | EUInt32(id, _) | EInt64(id, _) - | EUInt64(id, _) - | EInt8(id, _) - | EUInt8(id, _) - | EInt16(id, _) - | EUInt16(id, _) - | EInt32(id, _) - | EUInt32(id, _) - | EInt128(id, _) - | EUInt128(id, _) + // | EUInt64(id, _) + // | EInt128(id, _) + // | EUInt128(id, _) + + // | EFloat(id, _) + + // | EChar(id, _) | EString(id, _) - | EChar(id, _) - | EBool(id, _) - | EUnit id - | EConstant(id, _) - | EFloat(id, _) - | EVariable(id, _) - | EFieldAccess(id, _, _) - | ELambda(id, _, _) - | ELet(id, _, _, _) - | EIf(id, _, _, _) + + // | EConstant(id, _) + // | EVariable(id, _) + // | EFieldAccess(id, _, _) + // | ELambda(id, _, _) + // | ELet(id, _, _, _) + // | EIf(id, _, _, _) | EApply(id, _, _, _) | EFnName(id, _) - | EList(id, _) - | ETuple(id, _, _, _) - | ERecord(id, _, _) - | ERecordUpdate(id, _, _) - | EDict(id, _) - | EEnum(id, _, _, _) - | EMatch(id, _, _) + // | EList(id, _) + // | ETuple(id, _, _, _) + // | ERecord(id, _, _) + // | ERecordUpdate(id, _, _) + // | EDict(id, _) + // | EEnum(id, _, _, _) + // | EMatch(id, _, _) | EError(id, _, _) - | EAnd(id, _, _) - | EOr(id, _, _) -> id - -// Functions for working with Dark Let patterns -module LetPattern = - let toID (pat : LetPattern) : id = - match pat with - | LPVariable(id, _) -> id - | LPUnit id -> id - | LPTuple(id, _, _, _) -> id - -// Functions for working with Dark match patterns -module MatchPattern = - let toID (pat : MatchPattern) : id = - match pat with - | MPInt64(id, _) - | MPUInt64(id, _) - | MPInt8(id, _) - | MPUInt8(id, _) - | MPInt16(id, _) - | MPUInt16(id, _) - | MPInt32(id, _) - | MPUInt32(id, _) - | MPInt128(id, _) - | MPUInt128(id, _) - | MPString(id, _) - | MPChar(id, _) - | MPBool(id, _) - | MPUnit id - | MPFloat(id, _) - | MPVariable(id, _) - | MPTuple(id, _, _, _) - | MPEnum(id, _, _) - | MPListCons(id, _, _) - | MPList(id, _) -> id + // | EAnd(id, _, _) + // | EOr(id, _, _) + -> id + +// // Functions for working with Dark Let patterns +// module LetPattern = +// let toID (pat : LetPattern) : id = +// match pat with +// | LPVariable(id, _) -> id +// | LPUnit id -> id +// | LPTuple(id, _, _, _) -> id + +// // Functions for working with Dark match patterns +// module MatchPattern = +// let toID (pat : MatchPattern) : id = +// match pat with +// | MPInt64(id, _) +// | MPUInt64(id, _) +// | MPInt8(id, _) +// | MPUInt8(id, _) +// | MPInt16(id, _) +// | MPUInt16(id, _) +// | MPInt32(id, _) +// | MPUInt32(id, _) +// | MPInt128(id, _) +// | MPUInt128(id, _) +// | MPString(id, _) +// | MPChar(id, _) +// | MPBool(id, _) +// | MPUnit id +// | MPFloat(id, _) +// | MPVariable(id, _) +// | MPTuple(id, _, _, _) +// | MPEnum(id, _, _) +// | MPListCons(id, _, _) +// | MPList(id, _) -> id // Functions for working with Dark runtime values module Dval = @@ -922,77 +922,84 @@ module Dval = // accuracy is better, as the runtime is perfectly accurate. // let rec typeMatches (typ : TypeReference) (dv : Dval) : bool = - let r = typeMatches + //let r = typeMatches match (dv, typ) with - | _, TVariable _ -> true - | DInt64 _, TInt64 - | DUInt64 _, TUInt64 - | DInt8 _, TInt8 - | DUInt8 _, TUInt8 - | DInt16 _, TInt16 - | DUInt16 _, TUInt16 - | DInt32 _, TInt32 - | DUInt32 _, TUInt32 - | DInt128 _, TInt128 - | DUInt128 _, TUInt128 - | DFloat _, TFloat - | DBool _, TBool + //| _, TVariable _ -> true + | DUnit, TUnit + | DBool _, TBool + + // | DInt8 _, TInt8 + // | DUInt8 _, TUInt8 + // | DInt16 _, TInt16 + // | DUInt16 _, TUInt16 + // | DInt32 _, TInt32 + // | DUInt32 _, TUInt32 + | DInt64 _, TInt64 + // | DUInt64 _, TUInt64 + // | DInt128 _, TInt128 + // | DUInt128 _, TUInt128 + + // | DFloat _, TFloat + + // | DChar _, TChar | DString _, TString - | DDateTime _, TDateTime - | DUuid _, TUuid - | DChar _, TChar - | DDB _, TDB _ -> true - | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> - let pairs = - [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes - - pairs |> List.all (fun (v, subtype) -> r subtype v) - | DList(_vtTODO, l), TList t -> List.all (r t) l - | DDict(_vtTODO, m), TDict t -> Map.all (r t) m - | DFnVal(Lambda l), TFn(parameters, _) -> - NEList.length parameters = NEList.length l.parameters - - | DRecord(typeName, _, _typeArgsTODO, _fields), - TCustomType(Ok typeName', _typeArgs) -> - // TYPESCLEANUP: should load type by name - // TYPESCLEANUP: are we handling type arguments here? - // TYPESCLEANUP: do we need to check fields? - typeName = typeName' - - | DEnum(typeName, _, _typeArgsDEnumTODO, _casename, _fields), - TCustomType(Ok typeName', _typeArgsExpected) -> - // TYPESCLEANUP: should load type by name - // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare - // against the typeArgs in the DEnum - their zipped values should merge OK - typeName = typeName' + + // | DDateTime _, TDateTime + // | DUuid _, TUuid + + // | DDB _, TDB _ -> true + // | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> + // let pairs = + // [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes + + // pairs |> List.all (fun (v, subtype) -> r subtype v) + // | DList(_vtTODO, l), TList t -> List.all (r t) l + // | DDict(_vtTODO, m), TDict t -> Map.all (r t) m + // | DFnVal(Lambda l), TFn(parameters, _) -> + // NEList.length parameters = NEList.length l.parameters + + // | DRecord(typeName, _, _typeArgsTODO, _fields), + // TCustomType(Ok typeName', _typeArgs) -> + // // TYPESCLEANUP: should load type by name + // // TYPESCLEANUP: are we handling type arguments here? + // // TYPESCLEANUP: do we need to check fields? + // typeName = typeName' + + // | DEnum(typeName, _, _typeArgsDEnumTODO, _casename, _fields), + // TCustomType(Ok typeName', _typeArgsExpected) -> + // // TYPESCLEANUP: should load type by name + // // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare + // // against the typeArgs in the DEnum - their zipped values should merge OK + // typeName = typeName' // exhaustiveness checking - | DInt64 _, _ - | DUInt64 _, _ - | DInt8 _, _ - | DUInt8 _, _ - | DInt16 _, _ - | DUInt16 _, _ - | DInt32 _, _ - | DUInt32 _, _ - | DInt128 _, _ - | DUInt128 _, _ - | DFloat _, _ - | DBool _, _ | DUnit, _ + | DBool _, _ + // | DInt8 _, _ + // | DUInt8 _, _ + // | DInt16 _, _ + // | DUInt16 _, _ + // | DInt32 _, _ + // | DUInt32 _, _ + | DInt64 _, _ + // | DUInt64 _, _ + // | DInt128 _, _ + // | DUInt128 _, _ + // | DFloat _, _ | DString _, _ - | DDateTime _, _ - | DUuid _, _ - | DChar _, _ - | DDB _, _ - | DList _, _ - | DTuple _, _ - | DDict _, _ - | DRecord _, _ + // | DDateTime _, _ + // | DUuid _, _ + // | DChar _, _ + // | DDB _, _ + // | DList _, _ + // | DTuple _, _ + // | DDict _, _ + // | DRecord _, _ | DFnVal _, _ - | DEnum _, _ -> false + //| DEnum _, _ + -> false let rec toValueType (dv : Dval) : ValueType = @@ -1000,180 +1007,181 @@ module Dval = | DUnit -> ValueType.Known KTUnit | DBool _ -> ValueType.Known KTBool - | DInt8 _ -> ValueType.Known KTInt8 - | DUInt8 _ -> ValueType.Known KTUInt8 - | DInt16 _ -> ValueType.Known KTInt16 - | DUInt16 _ -> ValueType.Known KTUInt16 - | DInt32 _ -> ValueType.Known KTInt32 - | DUInt32 _ -> ValueType.Known KTUInt32 + + // | DInt8 _ -> ValueType.Known KTInt8 + // | DUInt8 _ -> ValueType.Known KTUInt8 + // | DInt16 _ -> ValueType.Known KTInt16 + // | DUInt16 _ -> ValueType.Known KTUInt16 + // | DInt32 _ -> ValueType.Known KTInt32 + // | DUInt32 _ -> ValueType.Known KTUInt32 | DInt64 _ -> ValueType.Known KTInt64 - | DUInt64 _ -> ValueType.Known KTUInt64 - | DInt128 _ -> ValueType.Known KTInt128 - | DUInt128 _ -> ValueType.Known KTUInt128 - | DFloat _ -> ValueType.Known KTFloat - | DChar _ -> ValueType.Known KTChar + // | DUInt64 _ -> ValueType.Known KTUInt64 + // | DInt128 _ -> ValueType.Known KTInt128 + // | DUInt128 _ -> ValueType.Known KTUInt128 + // | DFloat _ -> ValueType.Known KTFloat + // | DChar _ -> ValueType.Known KTChar | DString _ -> ValueType.Known KTString - | DDateTime _ -> ValueType.Known KTDateTime - | DUuid _ -> ValueType.Known KTUuid + // | DDateTime _ -> ValueType.Known KTDateTime + // | DUuid _ -> ValueType.Known KTUuid - | DList(t, _) -> ValueType.Known(KTList t) - | DDict(t, _) -> ValueType.Known(KTDict t) - | DTuple(first, second, theRest) -> - ValueType.Known( - KTTuple(toValueType first, toValueType second, List.map toValueType theRest) - ) + // | DList(t, _) -> ValueType.Known(KTList t) + // | DDict(t, _) -> ValueType.Known(KTDict t) + // | DTuple(first, second, theRest) -> + // ValueType.Known( + // KTTuple(toValueType first, toValueType second, List.map toValueType theRest) + // ) - | DRecord(typeName, _, typeArgs, _) -> - KTCustomType(typeName, typeArgs) |> ValueType.Known + // | DRecord(typeName, _, typeArgs, _) -> + // KTCustomType(typeName, typeArgs) |> ValueType.Known - | DEnum(typeName, _, typeArgs, _, _) -> - KTCustomType(typeName, typeArgs) |> ValueType.Known + // | DEnum(typeName, _, typeArgs, _, _) -> + // KTCustomType(typeName, typeArgs) |> ValueType.Known | DFnVal fnImpl -> match fnImpl with - | Lambda lambda -> - KTFn( - NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, - ValueType.Unknown - ) - |> ValueType.Known + // | Lambda lambda -> + // KTFn( + // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, + // ValueType.Unknown + // ) + // |> ValueType.Known // VTTODO look up type, etc | NamedFn _named -> ValueType.Unknown - // CLEANUP follow up when DDB has a typeReference - | DDB _ -> ValueType.Unknown + // // CLEANUP follow up when DDB has a typeReference + // | DDB _ -> ValueType.Unknown - let asList (dv : Dval) : Option> = - match dv with - | DList(_, l) -> Some l - | _ -> None + // let asList (dv : Dval) : Option> = + // match dv with + // | DList(_, l) -> Some l + // | _ -> None - let asDict (dv : Dval) : Option> = - match dv with - | DDict(_, d) -> Some d - | _ -> None + // let asDict (dv : Dval) : Option> = + // match dv with + // | DDict(_, d) -> Some d + // | _ -> None - let asTuple2 (dv : Dval) : Option = - match dv with - | DTuple(first, second, _) -> Some(first, second) - | _ -> None + // let asTuple2 (dv : Dval) : Option = + // match dv with + // | DTuple(first, second, _) -> Some(first, second) + // | _ -> None - let asTuple3 (dv : Dval) : Option = - match dv with - | DTuple(first, second, [ third ]) -> Some(first, second, third) - | _ -> None + // let asTuple3 (dv : Dval) : Option = + // match dv with + // | DTuple(first, second, [ third ]) -> Some(first, second, third) + // | _ -> None let asString (dv : Dval) : Option = match dv with | DString s -> Some s | _ -> None - let asInt8 (dv : Dval) : Option = - match dv with - | DInt8 i -> Some i - | _ -> None + // let asInt8 (dv : Dval) : Option = + // match dv with + // | DInt8 i -> Some i + // | _ -> None - let asUInt8 (dv : Dval) : Option = - match dv with - | DUInt8 i -> Some i - | _ -> None + // let asUInt8 (dv : Dval) : Option = + // match dv with + // | DUInt8 i -> Some i + // | _ -> None - let asInt16 (dv : Dval) : Option = - match dv with - | DInt16 i -> Some i - | _ -> None + // let asInt16 (dv : Dval) : Option = + // match dv with + // | DInt16 i -> Some i + // | _ -> None - let asUInt16 (dv : Dval) : Option = - match dv with - | DUInt16 i -> Some i - | _ -> None + // let asUInt16 (dv : Dval) : Option = + // match dv with + // | DUInt16 i -> Some i + // | _ -> None - let asInt32 (dv : Dval) : Option = - match dv with - | DInt32 i -> Some i - | _ -> None + // let asInt32 (dv : Dval) : Option = + // match dv with + // | DInt32 i -> Some i + // | _ -> None - let asUInt32 (dv : Dval) : Option = - match dv with - | DUInt32 i -> Some i - | _ -> None + // let asUInt32 (dv : Dval) : Option = + // match dv with + // | DUInt32 i -> Some i + // | _ -> None let asInt64 (dv : Dval) : Option = match dv with | DInt64 i -> Some i | _ -> None - let asUInt64 (dv : Dval) : Option = - match dv with - | DUInt64 i -> Some i - | _ -> None + // let asUInt64 (dv : Dval) : Option = + // match dv with + // | DUInt64 i -> Some i + // | _ -> None - let asInt128 (dv : Dval) : Option = - match dv with - | DInt128 i -> Some i - | _ -> None + // let asInt128 (dv : Dval) : Option = + // match dv with + // | DInt128 i -> Some i + // | _ -> None - let asUInt128 (dv : Dval) : Option = - match dv with - | DUInt128 i -> Some i - | _ -> None + // let asUInt128 (dv : Dval) : Option = + // match dv with + // | DUInt128 i -> Some i + // | _ -> None - let asFloat (dv : Dval) : Option = - match dv with - | DFloat f -> Some f - | _ -> None + // let asFloat (dv : Dval) : Option = + // match dv with + // | DFloat f -> Some f + // | _ -> None let asBool (dv : Dval) : Option = match dv with | DBool b -> Some b | _ -> None - let asUuid (dv : Dval) : Option = - match dv with - | DUuid u -> Some u - | _ -> None + // let asUuid (dv : Dval) : Option = + // match dv with + // | DUuid u -> Some u + // | _ -> None -type Const = - | CUnit - | CBool of bool +// type Const = +// | CUnit +// | CBool of bool - | CInt8 of int8 - | CUInt8 of uint8 - | CInt16 of int16 - | CUInt16 of uint16 - | CInt32 of int32 - | CUInt32 of uint32 - | CInt64 of int64 - | CUInt64 of uint64 - | CInt128 of System.Int128 - | CUInt128 of System.UInt128 +// | CInt8 of int8 +// | CUInt8 of uint8 +// | CInt16 of int16 +// | CUInt16 of uint16 +// | CInt32 of int32 +// | CUInt32 of uint32 +// | CInt64 of int64 +// | CUInt64 of uint64 +// | CInt128 of System.Int128 +// | CUInt128 of System.UInt128 - | CFloat of Sign * string * string +// | CFloat of Sign * string * string - | CChar of string - | CString of string +// | CChar of string +// | CString of string - | CList of List - | CTuple of first : Const * second : Const * rest : List - | CDict of List +// | CList of List +// | CTuple of first : Const * second : Const * rest : List +// | CDict of List - | CEnum of NameResolution * caseName : string * List +// | CEnum of NameResolution * caseName : string * List -// ------------ -// Package-Space -// ------------ -module PackageType = - // TODO: hash - type PackageType = { id : uuid; declaration : TypeDeclaration.T } +// // ------------ +// // Package-Space +// // ------------ +// module PackageType = +// // TODO: hash +// type PackageType = { id : uuid; declaration : TypeDeclaration.T } -module PackageConstant = - // TODO: hash - type PackageConstant = { id : uuid; body : Const } +// module PackageConstant = +// // TODO: hash +// type PackageConstant = { id : uuid; body : Const } module PackageFn = type Parameter = { name : string; typ : TypeReference } @@ -1187,41 +1195,41 @@ module PackageFn = body : Expr } -// ------------ -// User-/Canvas- Space -// ------------ -module DB = - type T = { tlid : tlid; name : string; typ : TypeReference; version : int } +// // ------------ +// // User-/Canvas- Space +// // ------------ +// module DB = +// type T = { tlid : tlid; name : string; typ : TypeReference; version : int } -module Secret = - type T = { name : string; value : string; version : int } +// module Secret = +// type T = { name : string; value : string; version : int } -module Handler = - type CronInterval = - | EveryDay - | EveryWeek - | EveryFortnight - | EveryHour - | Every12Hours - | EveryMinute +// module Handler = +// type CronInterval = +// | EveryDay +// | EveryWeek +// | EveryFortnight +// | EveryHour +// | Every12Hours +// | EveryMinute - type Spec = - | HTTP of path : string * method : string - | Worker of name : string - | Cron of name : string * interval : CronInterval - | REPL of name : string +// type Spec = +// | HTTP of path : string * method : string +// | Worker of name : string +// | Cron of name : string * interval : CronInterval +// | REPL of name : string - type T = { tlid : tlid; ast : Expr; spec : Spec } +// type T = { tlid : tlid; ast : Expr; spec : Spec } -module Toplevel = - type T = - | TLHandler of Handler.T - | TLDB of DB.T +// module Toplevel = +// type T = +// | TLHandler of Handler.T +// | TLDB of DB.T - let toTLID (tl : T) : tlid = - match tl with - | TLHandler h -> h.tlid - | TLDB db -> db.tlid +// let toTLID (tl : T) : tlid = +// match tl with +// | TLHandler h -> h.tlid +// | TLDB db -> db.tlid @@ -1255,57 +1263,57 @@ type Previewable = | Impure -/// Used to mark whether a function has an equivalent that can be -/// used within a Postgres query. -type SqlSpec = - /// Can be implemented, but we haven't yet - | NotYetImplemented +// /// Used to mark whether a function has an equivalent that can be +// /// used within a Postgres query. +// type SqlSpec = +// /// Can be implemented, but we haven't yet +// | NotYetImplemented - /// This is not a function which can be queried - | NotQueryable +// /// This is not a function which can be queried +// | NotQueryable - /// A query function (it can't be called inside a query, but its argument can be a query) - | QueryFunction +// /// A query function (it can't be called inside a query, but its argument can be a query) +// | QueryFunction - /// Can be implemented by a given builtin postgres 9.6 operator with 1 arg (eg `@ x`) - | SqlUnaryOp of string +// /// Can be implemented by a given builtin postgres 9.6 operator with 1 arg (eg `@ x`) +// | SqlUnaryOp of string - /// Can be implemented by a given builtin postgres 9.6 operator with 2 args (eg `x + y`) - | SqlBinOp of string +// /// Can be implemented by a given builtin postgres 9.6 operator with 2 args (eg `x + y`) +// | SqlBinOp of string - /// Can be implemented by a given builtin postgres 9.6 function - | SqlFunction of string +// /// Can be implemented by a given builtin postgres 9.6 function +// | SqlFunction of string - /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go first - | SqlFunctionWithPrefixArgs of string * List +// /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go first +// | SqlFunctionWithPrefixArgs of string * List - /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go last - | SqlFunctionWithSuffixArgs of string * List +// /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go last +// | SqlFunctionWithSuffixArgs of string * List - /// Can be implemented by given callback that receives 1 SQLified-string argument - /// | SqlCallback of (string -> string) - /// Can be implemented by given callback that receives 2 SQLified-string argument - | SqlCallback2 of (string -> string -> string) +// /// Can be implemented by given callback that receives 1 SQLified-string argument +// /// | SqlCallback of (string -> string) +// /// Can be implemented by given callback that receives 2 SQLified-string argument +// | SqlCallback2 of (string -> string -> string) - member this.isQueryable() : bool = - match this with - | NotYetImplemented - | NotQueryable - | QueryFunction -> false - | SqlUnaryOp _ - | SqlBinOp _ - | SqlFunction _ - | SqlFunctionWithPrefixArgs _ - | SqlFunctionWithSuffixArgs _ - | SqlCallback2 _ -> true - - -type BuiltInConstant = - { name : FQConstantName.Builtin - typ : TypeReference - description : string - deprecated : Deprecation - body : Dval } +// member this.isQueryable() : bool = +// match this with +// | NotYetImplemented +// | NotQueryable +// | QueryFunction -> false +// | SqlUnaryOp _ +// | SqlBinOp _ +// | SqlFunction _ +// | SqlFunctionWithPrefixArgs _ +// | SqlFunctionWithSuffixArgs _ +// | SqlCallback2 _ -> true + + +// type BuiltInConstant = +// { name : FQConstantName.Builtin +// typ : TypeReference +// description : string +// deprecated : Deprecation +// body : Dval } /// A built-in standard library function @@ -1320,7 +1328,7 @@ type BuiltInFn = description : string previewable : Previewable deprecated : Deprecation - sqlSpec : SqlSpec + //sqlSpec : SqlSpec fn : BuiltInFnSig } and Fn = @@ -1330,7 +1338,7 @@ and Fn = parameters : NEList returnType : TypeReference previewable : Previewable - sqlSpec : SqlSpec + //sqlSpec : SqlSpec /// /// May throw an exception, though we're trying to get them to never throw exceptions. @@ -1363,8 +1371,9 @@ and StoreFnResult = FunctionRecord -> NEList -> Dval -> unit and Program = { canvasID : CanvasID internalFnsAllowed : bool - dbs : Map - secrets : List } + //dbs : Map + //secrets : List + } /// Set of callbacks used to trace the interpreter, and other context needed to run code and Tracing = @@ -1385,7 +1394,7 @@ and TestContext = /// Functionally written in F# and shipped with the executable and Builtins = - { constants : Map + { //constants : Map fns : Map } /// Functionality written in Dark stored and managed outside of user space @@ -1396,17 +1405,17 @@ and Builtins = /// not yet in the Cloud PM. /// (though, we'll likely demand deps. in the PM before committing something upstream...) and PackageManager = - { getType : FQTypeName.Package -> Ply> - getConstant : - FQConstantName.Package -> Ply> + { //getType : FQTypeName.Package -> Ply> + //getConstant : + // FQConstantName.Package -> Ply> getFn : FQFnName.Package -> Ply> init : Ply } static member empty = - { getType = (fun _ -> Ply None) + { //getType = (fun _ -> Ply None) getFn = (fun _ -> Ply None) - getConstant = (fun _ -> Ply None) + //getConstant = (fun _ -> Ply None) init = uply { return () } } @@ -1414,20 +1423,21 @@ and PackageManager = /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras (pm : PackageManager) - (types : List) - (constants : List) + //(types : List) + //(constants : List) (fns : List) : PackageManager = - { getType = - fun id -> - match types |> List.tryFind (fun t -> t.id = id) with - | Some t -> Some t |> Ply - | None -> pm.getType id - getConstant = - fun id -> - match constants |> List.tryFind (fun c -> c.id = id) with - | Some c -> Some c |> Ply - | None -> pm.getConstant id + { + // getType = + // fun id -> + // match types |> List.tryFind (fun t -> t.id = id) with + // | Some t -> Some t |> Ply + // | None -> pm.getType id + // getConstant = + // fun id -> + // match constants |> List.tryFind (fun c -> c.id = id) with + // | Some c -> Some c |> Ply + // | None -> pm.getConstant id getFn = fun id -> match fns |> List.tryFind (fun f -> f.id = id) with @@ -1469,11 +1479,12 @@ and ExecutionState = and Types = { typeSymbolTable : TypeSymbolTable - package : FQTypeName.Package -> Ply> } + //package : FQTypeName.Package -> Ply> + } -and Constants = - { builtIn : Map - package : FQConstantName.Package -> Ply> } +// and Constants = +// { builtIn : Map +// package : FQConstantName.Package -> Ply> } and Functions = { builtIn : Map @@ -1484,95 +1495,96 @@ and Functions = module ExecutionState = let availableTypes (state : ExecutionState) : Types = { typeSymbolTable = state.typeSymbolTable - package = state.packageManager.getType } + //package = state.packageManager.getType + } - let availableConstants (state : ExecutionState) : Constants = - { builtIn = state.builtins.constants - package = state.packageManager.getConstant } + // let availableConstants (state : ExecutionState) : Constants = + // { builtIn = state.builtins.constants + // package = state.packageManager.getConstant } let availableFunctions (state : ExecutionState) : Functions = { builtIn = state.builtins.fns; package = state.packageManager.getFn } -module Types = - let empty = { typeSymbolTable = Map.empty; package = (fun _ -> Ply None) } - - let find - // TODO: swap these args - (name : FQTypeName.FQTypeName) - (types : Types) - : Ply> = - match name with - | FQTypeName.Package pkg -> - types.package pkg |> Ply.map (Option.map _.declaration) - - /// Swap concrete types for type parameters - let rec substitute - (typeParams : List) - (typeArguments : List) - (typ : TypeReference) - : TypeReference = - let substitute = substitute typeParams typeArguments - match typ with - | TVariable v -> - if typeParams.Length = typeArguments.Length then - List.zip typeParams typeArguments - |> List.find (fun (param, _) -> param = v) - |> Option.map snd - |> Exception.unwrapOptionInternal - "No type argument found for type parameter" - [] - else - Exception.raiseInternal - $"typeParams and typeArguments have different lengths" - [ "typeParams", typeParams; "typeArguments", typeArguments ] - - - | TUnit - | TBool - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt64 - | TUInt64 - | TInt128 - | TUInt128 - | TFloat - | TChar - | TString - | TUuid - | TDateTime -> typ - - | TList t -> TList(substitute t) - | TTuple(t1, t2, rest) -> - TTuple(substitute t1, substitute t2, List.map substitute rest) - | TFn _ -> typ // TYPESTODO - | TDB _ -> typ // TYPESTODO - | TCustomType(typeName, typeArgs) -> - TCustomType(typeName, List.map substitute typeArgs) - | TDict t -> TDict(substitute t) +// module Types = +// let empty = { typeSymbolTable = Map.empty; package = (fun _ -> Ply None) } + +// let find +// // TODO: swap these args +// (name : FQTypeName.FQTypeName) +// (types : Types) +// : Ply> = +// match name with +// | FQTypeName.Package pkg -> +// types.package pkg |> Ply.map (Option.map _.declaration) + +// /// Swap concrete types for type parameters +// let rec substitute +// (typeParams : List) +// (typeArguments : List) +// (typ : TypeReference) +// : TypeReference = +// let substitute = substitute typeParams typeArguments +// match typ with +// | TVariable v -> +// if typeParams.Length = typeArguments.Length then +// List.zip typeParams typeArguments +// |> List.find (fun (param, _) -> param = v) +// |> Option.map snd +// |> Exception.unwrapOptionInternal +// "No type argument found for type parameter" +// [] +// else +// Exception.raiseInternal +// $"typeParams and typeArguments have different lengths" +// [ "typeParams", typeParams; "typeArguments", typeArguments ] + + +// | TUnit +// | TBool +// | TInt8 +// | TUInt8 +// | TInt16 +// | TUInt16 +// | TInt32 +// | TUInt32 +// | TInt64 +// | TUInt64 +// | TInt128 +// | TUInt128 +// | TFloat +// | TChar +// | TString +// | TUuid +// | TDateTime -> typ + +// | TList t -> TList(substitute t) +// | TTuple(t1, t2, rest) -> +// TTuple(substitute t1, substitute t2, List.map substitute rest) +// | TFn _ -> typ // TYPESTODO +// | TDB _ -> typ // TYPESTODO +// | TCustomType(typeName, typeArgs) -> +// TCustomType(typeName, List.map substitute typeArgs) +// | TDict t -> TDict(substitute t) let rec getTypeReferenceFromAlias - (types : Types) + (_types : Types) (typ : TypeReference) : Ply> = match typ with - | TCustomType(Ok outerTypeName, outerTypeArgs) -> - uply { - match! Types.find outerTypeName types with - | Some { definition = TypeDeclaration.Alias typ; typeParams = typeParams } -> - let typ = Types.substitute typeParams outerTypeArgs typ - return! getTypeReferenceFromAlias types typ - | _ -> return Ok typ - } + // | TCustomType(Ok outerTypeName, outerTypeArgs) -> + // uply { + // match! Types.find outerTypeName types with + // | Some { definition = TypeDeclaration.Alias typ; typeParams = typeParams } -> + // let typ = Types.substitute typeParams outerTypeArgs typ + // return! getTypeReferenceFromAlias types typ + // | _ -> return Ok typ + // } - | TCustomType(Error err, _) -> Ply(Error err) + // | TCustomType(Error err, _) -> Ply(Error err) | _ -> Ply(Ok typ) @@ -1599,7 +1611,7 @@ let builtInFnToFn (fn : BuiltInFn) : Fn = |> NEList.ofListUnsafe "builtInFnToFn" [ "name", fn.name ] returnType = fn.returnType previewable = fn.previewable - sqlSpec = fn.sqlSpec + //sqlSpec = fn.sqlSpec fn = BuiltInFunction fn.fn } let packageFnToFn (fn : PackageFn.PackageFn) : Fn = @@ -1610,5 +1622,5 @@ let packageFnToFn (fn : PackageFn.PackageFn) : Fn = parameters = fn.parameters |> NEList.map toParam returnType = fn.returnType previewable = Impure - sqlSpec = NotQueryable + //sqlSpec = NotQueryable fn = PackageFunction(fn.id, fn.body) } diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index 3a72c18163..6c3928e0ef 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -18,115 +18,116 @@ type Context = parameter : Param * paramIndex : int | FunctionCallResult of fnName : FQFnName.FQFnName * returnType : TypeReference - | RecordField of - recordTypeName : FQTypeName.FQTypeName * - fieldName : string * - fieldType : TypeReference - | DictKey of key : string * typ : TypeReference - | EnumField of - enumTypeName : FQTypeName.FQTypeName * - caseName : string * - fieldIndex : int * - fieldCount : int * - fieldType : TypeReference - | DBQueryVariable of varName : string * expected : TypeReference - | DBSchemaType of name : string * expectedType : TypeReference - | ListIndex of index : int * listTyp : TypeReference * parent : Context - | TupleIndex of index : int * elementType : TypeReference * parent : Context + // | RecordField of + // recordTypeName : FQTypeName.FQTypeName * + // fieldName : string * + // fieldType : TypeReference + // | DictKey of key : string * typ : TypeReference + // | EnumField of + // enumTypeName : FQTypeName.FQTypeName * + // caseName : string * + // fieldIndex : int * + // fieldCount : int * + // fieldType : TypeReference + // | DBQueryVariable of varName : string * expected : TypeReference + // | DBSchemaType of name : string * expectedType : TypeReference + // | ListIndex of index : int * listTyp : TypeReference * parent : Context + // | TupleIndex of index : int * elementType : TypeReference * parent : Context | FnValResult of returnType : TypeReference type ErrorType = // TODO? swap these fields | ValueNotExpectedType of actualValue : Dval * expectedType : TypeReference - | TypeDoesntExist of FQTypeName.FQTypeName + //| TypeDoesntExist of FQTypeName.FQTypeName type Error = { errorType : ErrorType; context : Context } module Error = - module RT2DT = RuntimeTypesToDarkTypes +// module RT2DT = RuntimeTypesToDarkTypes - module Context = - let typeName = - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.context +// module Context = +// let typeName = +// FQTypeName.Package +// PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.context - let rec toDT (context : Context) : Dval = - let (caseName, fields) = - match context with - | FunctionCallParameter(fnName, param, paramIndex) -> - "FunctionCallParameter", - [ RT2DT.FQFnName.toDT fnName; RT2DT.Param.toDT param; DInt64 paramIndex ] +// let rec toDT (context : Context) : Dval = +// let (caseName, fields) = +// match context with +// | FunctionCallParameter(fnName, param, paramIndex) -> +// "FunctionCallParameter", +// [ RT2DT.FQFnName.toDT fnName; RT2DT.Param.toDT param; DInt64 paramIndex ] - | FunctionCallResult(fnName, returnType) -> - "FunctionCallResult", - [ RT2DT.FQFnName.toDT fnName; RT2DT.TypeReference.toDT returnType ] +// | FunctionCallResult(fnName, returnType) -> +// "FunctionCallResult", +// [ RT2DT.FQFnName.toDT fnName; RT2DT.TypeReference.toDT returnType ] - | RecordField(recordTypeName, fieldName, fieldType) -> - "RecordField", - [ RT2DT.FQTypeName.toDT recordTypeName - DString fieldName - RT2DT.TypeReference.toDT fieldType ] +// | RecordField(recordTypeName, fieldName, fieldType) -> +// "RecordField", +// [ RT2DT.FQTypeName.toDT recordTypeName +// DString fieldName +// RT2DT.TypeReference.toDT fieldType ] - | DictKey(key, typ) -> - "DictKey", [ DString key; RT2DT.TypeReference.toDT typ ] +// | DictKey(key, typ) -> +// "DictKey", [ DString key; RT2DT.TypeReference.toDT typ ] - | EnumField(enumTypeName, caseName, fieldIndex, fieldCount, fieldType) -> - "EnumField", - [ RT2DT.FQTypeName.toDT enumTypeName - DString caseName - DInt64 fieldIndex - DInt64 fieldCount - RT2DT.TypeReference.toDT fieldType ] +// | EnumField(enumTypeName, caseName, fieldIndex, fieldCount, fieldType) -> +// "EnumField", +// [ RT2DT.FQTypeName.toDT enumTypeName +// DString caseName +// DInt64 fieldIndex +// DInt64 fieldCount +// RT2DT.TypeReference.toDT fieldType ] - | DBQueryVariable(varName, expected) -> - "DBQueryVariable", [ DString varName; RT2DT.TypeReference.toDT expected ] +// | DBQueryVariable(varName, expected) -> +// "DBQueryVariable", [ DString varName; RT2DT.TypeReference.toDT expected ] - | DBSchemaType(name, expectedType) -> - "DBSchemaType", [ DString name; RT2DT.TypeReference.toDT expectedType ] +// | DBSchemaType(name, expectedType) -> +// "DBSchemaType", [ DString name; RT2DT.TypeReference.toDT expectedType ] - | ListIndex(index, listTyp, parent) -> - "ListIndex", - [ DInt64 index; RT2DT.TypeReference.toDT listTyp; toDT parent ] +// | ListIndex(index, listTyp, parent) -> +// "ListIndex", +// [ DInt64 index; RT2DT.TypeReference.toDT listTyp; toDT parent ] - | TupleIndex(index, elementType, parent) -> - "TupleIndex", - [ DInt64 index; RT2DT.TypeReference.toDT elementType; toDT parent ] +// | TupleIndex(index, elementType, parent) -> +// "TupleIndex", +// [ DInt64 index; RT2DT.TypeReference.toDT elementType; toDT parent ] - | FnValResult(returnType) -> - "FnValResult", [ RT2DT.TypeReference.toDT returnType ] +// | FnValResult(returnType) -> +// "FnValResult", [ RT2DT.TypeReference.toDT returnType ] - DEnum(typeName, typeName, [], caseName, fields) +// DEnum(typeName, typeName, [], caseName, fields) - module ErrorType = - let typeName = - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.errorType +// module ErrorType = +// let typeName = +// FQTypeName.Package +// PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.errorType - let toDT (et : ErrorType) : Dval = - let (caseName, fields) = - match et with - | ValueNotExpectedType(actualValue, expectedType) -> - "ValueNotExpectedType", - [ actualValue |> RT2DT.Dval.toDT - expectedType |> RT2DT.TypeReference.toDT ] +// let toDT (et : ErrorType) : Dval = +// let (caseName, fields) = +// match et with +// | ValueNotExpectedType(actualValue, expectedType) -> +// "ValueNotExpectedType", +// [ actualValue |> RT2DT.Dval.toDT +// expectedType |> RT2DT.TypeReference.toDT ] - | TypeDoesntExist(typeName) -> - "TypeDoesntExist", [ RT2DT.FQTypeName.toDT typeName ] +// | TypeDoesntExist(typeName) -> +// "TypeDoesntExist", [ RT2DT.FQTypeName.toDT typeName ] - DEnum(typeName, typeName, [], caseName, fields) +// DEnum(typeName, typeName, [], caseName, fields) - let typeName = - FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.error +// let typeName = +// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.error - let toRuntimeError (e : Error) : RuntimeError = - let fields = - [ ("errorType", ErrorType.toDT e.errorType) - ("context", Context.toDT e.context) ] + let toRuntimeError (_e : Error) : RuntimeError = + // let fields = + // [ ("errorType", ErrorType.toDT e.errorType) + // ("context", Context.toDT e.context) ] - DRecord(typeName, typeName, [], Map fields) |> RuntimeError.typeCheckerError + // DRecord(typeName, typeName, [], Map fields) |> RuntimeError.typeCheckerError + RuntimeError.oldError "TODO" let raiseValueNotExpectedType @@ -151,23 +152,23 @@ let raiseFnValResultNotExpectedType let rec valueTypeUnifies - (tst : TypeSymbolTable) + (_tst : TypeSymbolTable) (expected : TypeReference) (actual : ValueType) : Ply = - let r = valueTypeUnifies tst - - let rMult (expected : List) (actual : List) : Ply = - if List.length expected <> List.length actual then - Ply false - else - List.zip expected actual - |> Ply.List.foldSequentially - (fun acc (e, a) -> - match acc with - | false -> Ply acc - | true -> r e a) - true + // let r = valueTypeUnifies tst + + // let rMult (expected : List) (actual : List) : Ply = + // if List.length expected <> List.length actual then + // Ply false + // else + // List.zip expected actual + // |> Ply.List.foldSequentially + // (fun acc (e, a) -> + // match acc with + // | false -> Ply acc + // | true -> r e a) + // true uply { match expected, actual with @@ -175,47 +176,48 @@ let rec valueTypeUnifies | TUnit, ValueType.Known KTUnit -> return true | TBool, ValueType.Known KTBool -> return true + + // | TInt8, ValueType.Known KTInt8 -> return true + // | TUInt8, ValueType.Known KTUInt8 -> return true + // | TInt16, ValueType.Known KTInt16 -> return true + // | TUInt16, ValueType.Known KTUInt16 -> return true + // | TInt32, ValueType.Known KTInt32 -> return true + // | TUInt32, ValueType.Known KTUInt32 -> return true | TInt64, ValueType.Known KTInt64 -> return true - | TUInt64, ValueType.Known KTUInt64 -> return true - | TInt8, ValueType.Known KTInt8 -> return true - | TUInt8, ValueType.Known KTUInt8 -> return true - | TInt16, ValueType.Known KTInt16 -> return true - | TUInt16, ValueType.Known KTUInt16 -> return true - | TInt32, ValueType.Known KTInt32 -> return true - | TUInt32, ValueType.Known KTUInt32 -> return true - | TInt128, ValueType.Known KTInt128 -> return true - | TUInt128, ValueType.Known KTUInt128 -> return true - | TFloat, ValueType.Known KTFloat -> return true - | TChar, ValueType.Known KTChar -> return true + // | TUInt64, ValueType.Known KTUInt64 -> return true + // | TInt128, ValueType.Known KTInt128 -> return true + // | TUInt128, ValueType.Known KTUInt128 -> return true + // | TFloat, ValueType.Known KTFloat -> return true + // | TChar, ValueType.Known KTChar -> return true | TString, ValueType.Known KTString -> return true - | TUuid, ValueType.Known KTUuid -> return true - | TDateTime, ValueType.Known KTDateTime -> return true - - | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV - - | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV - - | TTuple(tFirst, tSecond, tRest), - ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> - let expected = tFirst :: tSecond :: tRest - let actual = vFirst :: vSecond :: vRest - return! rMult expected actual - - | TCustomType(Error err, _), _ -> - return - Exception.raiseInternal - $"Unexpected - can't unify valueType against unknown/error type reference" - [ "err", err ] - | TCustomType(Ok _typeNameT, _typeArgsT), - ValueType.Known(KTCustomType(_typeNameV, _typeArgsV)) -> - // TODO: follow up here when: - // - type name aliases are and resolved - // - type args are properly passed around and handled - - // TODO: assert type names are the same, - // after we've handled all type aliases - //return! rMult typeArgsT typeArgsV - return true + // | TUuid, ValueType.Known KTUuid -> return true + // | TDateTime, ValueType.Known KTDateTime -> return true + + // | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV + + // | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV + + // | TTuple(tFirst, tSecond, tRest), + // ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> + // let expected = tFirst :: tSecond :: tRest + // let actual = vFirst :: vSecond :: vRest + // return! rMult expected actual + + // | TCustomType(Error err, _), _ -> + // return + // Exception.raiseInternal + // $"Unexpected - can't unify valueType against unknown/error type reference" + // [ "err", err ] + // | TCustomType(Ok _typeNameT, _typeArgsT), + // ValueType.Known(KTCustomType(_typeNameV, _typeArgsV)) -> + // // TODO: follow up here when: + // // - type name aliases are and resolved + // // - type args are properly passed around and handled + + // // TODO: assert type names are the same, + // // after we've handled all type aliases + // //return! rMult typeArgsT typeArgsV + // return true | TFn(_argTypes, _returnType), ValueType.Known(KTFn(_vArgs, _vRet)) -> // TODO: follow up here when type args are properly passed around and handled @@ -225,12 +227,12 @@ let rec valueTypeUnifies // return! rMult expected actual return true - | TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV + //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV - | TVariable name, _ -> - match Map.get name tst with - | None -> return true - | Some t -> return! r t actual + // | TVariable name, _ -> + // match Map.get name tst with + // | None -> return true + // | Some t -> return! r t actual | _, _ -> return false } @@ -238,7 +240,7 @@ let rec valueTypeUnifies let rec unify (context : Context) (types : Types) - (tst : TypeSymbolTable) + (_tst : TypeSymbolTable) (expected : TypeReference) (value : Dval) : Ply> = @@ -247,198 +249,208 @@ let rec unify | Error rte -> return Error rte | Ok expected -> match (expected, value) with - // Any should be removed, but we currently allow it as a param type - // in user functions, so we should allow it here. - // - // Potentially needs to be removed before we use this type checker for DBs? - // - Could always have a type checking context that allows/disallows any - | TVariable name, _ -> - match Map.get name tst with - // for now, allow undefined type variables. In the future, we would create a - // type from the value and return any variables defined this way for usage in - // further arguments and return values. - | None -> return Ok() - | Some t -> return! unify context types tst t value - | TInt64, DInt64 _ -> return Ok() - | TUInt64, DUInt64 _ -> return Ok() - | TInt8, DInt8 _ -> return Ok() - | TUInt8, DUInt8 _ -> return Ok() - | TInt16, DInt16 _ -> return Ok() - | TUInt16, DUInt16 _ -> return Ok() - | TInt32, DInt32 _ -> return Ok() - | TUInt32, DUInt32 _ -> return Ok() - | TInt128, DInt128 _ -> return Ok() - | TUInt128, DUInt128 _ -> return Ok() - | TFloat, DFloat _ -> return Ok() + // // Any should be removed, but we currently allow it as a param type + // // in user functions, so we should allow it here. + // // + // // Potentially needs to be removed before we use this type checker for DBs? + // // - Could always have a type checking context that allows/disallows any + // | TVariable name, _ -> + // match Map.get name tst with + // // for now, allow undefined type variables. In the future, we would create a + // // type from the value and return any variables defined this way for usage in + // // further arguments and return values. + // | None -> return Ok() + // | Some t -> return! unify context types tst t value + | TBool, DBool _ -> return Ok() | TUnit, DUnit -> return Ok() + + // | TInt8, DInt8 _ -> return Ok() + // | TUInt8, DUInt8 _ -> return Ok() + // | TInt16, DInt16 _ -> return Ok() + // | TUInt16, DUInt16 _ -> return Ok() + // | TInt32, DInt32 _ -> return Ok() + // | TUInt32, DUInt32 _ -> return Ok() + | TInt64, DInt64 _ -> return Ok() + // | TUInt64, DUInt64 _ -> return Ok() + // | TInt128, DInt128 _ -> return Ok() + // | TUInt128, DUInt128 _ -> return Ok() + + // | TFloat, DFloat _ -> return Ok() + + //| TChar, DChar _ -> return Ok() | TString, DString _ -> return Ok() - | TDateTime, DDateTime _ -> return Ok() - | TUuid, DUuid _ -> return Ok() - | TChar, DChar _ -> return Ok() - | TDB _, DDB _ -> return Ok() // TODO: check DB type - | TList expected, DList(actual, _dvs) -> - match! valueTypeUnifies tst expected actual with - | false -> - return - { errorType = ValueNotExpectedType(value, TList expected) - context = context } - |> Error.toRuntimeError - |> Error - - | true -> return! Ply() - - | TDict _expected, DDict(_actual, _entries) -> - // VTTODO uncomment this - // match! valueTypeUnifies tst expected actual with - // | false -> - // return - // ValueNotExpectedType(value, expected, context) - // |> Error.toRuntimeError - // |> Error - - // | true -> return! Ply() - return Ok() + + // | TDateTime, DDateTime _ -> return Ok() + // | TUuid, DUuid _ -> return Ok() + + // | TDB _, DDB _ -> return Ok() // TODO: check DB type + // | TList expected, DList(actual, _dvs) -> + // match! valueTypeUnifies tst expected actual with + // | false -> + // return + // { errorType = ValueNotExpectedType(value, TList expected) + // context = context } + // |> Error.toRuntimeError + // |> Error + + // | true -> return! Ply() + + // | TDict _expected, DDict(_actual, _entries) -> + // // VTTODO uncomment this + // // match! valueTypeUnifies tst expected actual with + // // | false -> + // // return + // // ValueNotExpectedType(value, expected, context) + // // |> Error.toRuntimeError + // // |> Error + + // // | true -> return! Ply() + // return Ok() | TFn(_argTypes, _returnType), DFnVal _fnVal -> return Ok() // TYPESTODO check lambdas and fnVals - | TTuple(t1, t2, tRest), DTuple(v1, v2, vRest) -> - let ts = t1 :: t2 :: tRest - let vs = v1 :: v2 :: vRest - if List.length ts <> List.length vs then - return - { errorType = ValueNotExpectedType(value, expected); context = context } - |> Error.toRuntimeError - |> Error - else - // let! results = - // List.zip ts vs - // |> Ply.List.mapSequentiallyWithIndex (fun i (t, v) -> - // let context = TupleIndex(i, t, context) - // unify context types tst t v) - // return combineErrorsUnit results - // CLEANUP DTuple should include a TypeReference for each part, in which - // case the type-checking here would just be a comparison of typeRefs. - // (the construction of that DTuple should have already checked that the - // types match) - return Ok() - - // TYPESCLEANUP: handle typeArgs - | TCustomType(typeName, _typeArgs), value -> - - match typeName with - | Error rte -> return Error rte - | Ok typeName -> - match! Types.find typeName types with - | None -> - return - { errorType = TypeDoesntExist(typeName); context = context } - |> Error.toRuntimeError - |> Error - | Some ut -> - let err = - { errorType = ValueNotExpectedType(value, expected) - context = context } - |> Error.toRuntimeError - |> Error - - match ut, value with - | { definition = TypeDeclaration.Alias aliasType }, _ -> - let! resolvedAliasType = getTypeReferenceFromAlias types aliasType - - match resolvedAliasType with - | Error rte -> return Error rte - | Ok resolvedAliasType -> - return! unify context types tst resolvedAliasType value - - | { definition = TypeDeclaration.Record _ }, - DRecord(tn, _, _valueTypesTODO, _fields) -> - // TYPESCLEANUP: this search should no longer be required - let! aliasedType = - getTypeReferenceFromAlias types (TCustomType(Ok tn, [])) - match aliasedType with - | Ok(TCustomType(Error rte, _)) -> return Error rte - | Ok(TCustomType(Ok concreteTn, _typeArgs)) -> - if concreteTn <> typeName then - return - { errorType = ValueNotExpectedType(value, expected) - context = context } - |> Error.toRuntimeError - |> Error - else - // CLEANUP DRecord should include a TypeReference, in which case - // the type-checking here would just be a `tField = dField` check. - // (the construction of that DRecord should have already checked - // that the fields match) - return Ok() - | _ -> return err - - | { definition = TypeDeclaration.Enum cases }, - DEnum(tn, _, _typeArgsDEnumTODO, caseName, valFields) -> - // TODO: deal with aliased type? - if tn <> typeName then - return - { errorType = ValueNotExpectedType(value, expected) - context = context } - |> Error.toRuntimeError - |> Error - else - let matchingCase : Option = - cases |> NEList.find (fun c -> c.name = caseName) - - match matchingCase with - | None -> return err - | Some case -> - if List.length case.fields = List.length valFields then - // let! unified = - // List.zip case.fields valFields - // |> List.mapi (fun i (expected, actual) -> - // let context = - // EnumField( - // tn, - // expected, - // case.name, - // i, - // Context.toLocation context - // ) - // unify context types tst expected.typ actual) - // |> Ply.List.mapSequentially identity - - // return combineErrorsUnit unified - // CLEANUP DEnum should include a TypeReference, in which case - // the type-checking here would just be a `tField = dField` check. - // (the construction of that DEnum should have already checked - // that the fields match) - return Ok() - else - return err - | _, _ -> return err + // | TTuple(t1, t2, tRest), DTuple(v1, v2, vRest) -> + // let ts = t1 :: t2 :: tRest + // let vs = v1 :: v2 :: vRest + // if List.length ts <> List.length vs then + // return + // { errorType = ValueNotExpectedType(value, expected); context = context } + // |> Error.toRuntimeError + // |> Error + // else + // // let! results = + // // List.zip ts vs + // // |> Ply.List.mapSequentiallyWithIndex (fun i (t, v) -> + // // let context = TupleIndex(i, t, context) + // // unify context types tst t v) + // // return combineErrorsUnit results + // // CLEANUP DTuple should include a TypeReference for each part, in which + // // case the type-checking here would just be a comparison of typeRefs. + // // (the construction of that DTuple should have already checked that the + // // types match) + // return Ok() + + // // TYPESCLEANUP: handle typeArgs + // | TCustomType(typeName, _typeArgs), value -> + + // match typeName with + // | Error rte -> return Error rte + // | Ok typeName -> + // match! Types.find typeName types with + // | None -> + // return + // { errorType = TypeDoesntExist(typeName); context = context } + // |> Error.toRuntimeError + // |> Error + // | Some ut -> + // let err = + // { errorType = ValueNotExpectedType(value, expected) + // context = context } + // |> Error.toRuntimeError + // |> Error + + // match ut, value with + // | { definition = TypeDeclaration.Alias aliasType }, _ -> + // let! resolvedAliasType = getTypeReferenceFromAlias types aliasType + + // match resolvedAliasType with + // | Error rte -> return Error rte + // | Ok resolvedAliasType -> + // return! unify context types tst resolvedAliasType value + + // | { definition = TypeDeclaration.Record _ }, + // DRecord(tn, _, _valueTypesTODO, _fields) -> + // // TYPESCLEANUP: this search should no longer be required + // let! aliasedType = + // getTypeReferenceFromAlias types (TCustomType(Ok tn, [])) + // match aliasedType with + // | Ok(TCustomType(Error rte, _)) -> return Error rte + // | Ok(TCustomType(Ok concreteTn, _typeArgs)) -> + // if concreteTn <> typeName then + // return + // { errorType = ValueNotExpectedType(value, expected) + // context = context } + // |> Error.toRuntimeError + // |> Error + // else + // // CLEANUP DRecord should include a TypeReference, in which case + // // the type-checking here would just be a `tField = dField` check. + // // (the construction of that DRecord should have already checked + // // that the fields match) + // return Ok() + // | _ -> return err + + // | { definition = TypeDeclaration.Enum cases }, + // DEnum(tn, _, _typeArgsDEnumTODO, caseName, valFields) -> + // // TODO: deal with aliased type? + // if tn <> typeName then + // return + // { errorType = ValueNotExpectedType(value, expected) + // context = context } + // |> Error.toRuntimeError + // |> Error + // else + // let matchingCase : Option = + // cases |> NEList.find (fun c -> c.name = caseName) + + // match matchingCase with + // | None -> return err + // | Some case -> + // if List.length case.fields = List.length valFields then + // // let! unified = + // // List.zip case.fields valFields + // // |> List.mapi (fun i (expected, actual) -> + // // let context = + // // EnumField( + // // tn, + // // expected, + // // case.name, + // // i, + // // Context.toLocation context + // // ) + // // unify context types tst expected.typ actual) + // // |> Ply.List.mapSequentially identity + + // // return combineErrorsUnit unified + // // CLEANUP DEnum should include a TypeReference, in which case + // // the type-checking here would just be a `tField = dField` check. + // // (the construction of that DEnum should have already checked + // // that the fields match) + // return Ok() + // else + // return err + // | _, _ -> return err // See https://github.com/darklang/dark/issues/4239#issuecomment-1175182695 // TODO: exhaustiveness check - | TTuple _, _ - | TCustomType _, _ - | TVariable _, _ - | TInt64, _ - | TUInt64, _ - | TInt8, _ - | TUInt8, _ - | TInt16, _ - | TUInt16, _ - | TInt32, _ - | TUInt32, _ - | TInt128, _ - | TUInt128, _ - | TFloat, _ - | TBool, _ | TUnit, _ + | TBool, _ + + // | TInt8, _ + // | TUInt8, _ + // | TInt16, _ + // | TUInt16, _ + // | TInt32, _ + // | TUInt32, _ + | TInt64, _ + // | TUInt64, _ + // | TInt128, _ + // | TUInt128, _ + + // | TFloat, _ + + // | TTuple _, _ + // | TCustomType _, _ + // | TVariable _, _ | TString, _ - | TList _, _ - | TDateTime, _ - | TDict _, _ + // | TList _, _ + // | TDateTime, _ + // | TDict _, _ | TFn _, _ - | TUuid, _ - | TChar, _ - | TDB _, _ -> + // | TUuid, _ + // | TChar, _ + // | TDB _, _ + -> return { errorType = ValueNotExpectedType(value, expected); context = context } |> Error.toRuntimeError @@ -494,212 +506,212 @@ let checkFunctionReturnType unify context types tst fn.returnType result -/// Helpers for creating type-checked Dvals -/// (lists, records, enums, etc.) -/// -/// Dvals should be created carefully: -/// - to have the correct valueTypes, where appropriate -/// i.e. we should not have DList(Known KTInt64, [ DString("hi") ]) -/// -/// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes -/// i.e. `List.append [1] ["hi"]` should fail -/// because we can't merge `Known KTInt64` and `Known KTString` -/// -/// These functions are intended to help with both of these, in cases where -/// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types -/// of a Dval in some F# code). -/// -/// TODO: review _all_ usages of these functions -/// -/// TODO: ideally we don't require a callStack to be input here -- too much data-passing -/// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) -module DvalCreator = - let list - (callStack : CallStack) - (initialType : ValueType) - (list : List) - : Dval = - let (typ, dvs) = - List.fold - (fun (typ, list) dv -> - let dvalType = Dval.toValueType dv - - match VT.merge typ dvalType with - | Ok newType -> newType, dv :: list - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" - |> raiseRTE callStack) - (initialType, []) - (List.rev list) - - DList(typ, dvs) - - - let dict (typ : ValueType) (entries : List) : Dval = - // TODO: dictPush, etc. - DDict(typ, Map entries) - - let dictFromMap (typ : ValueType) (entries : Map) : Dval = - // TODO: dictPush, etc. - DDict(typ, entries) - - // CLEANUP - this fn was unused so I commented it out - // remove? or will it be handy? - // let dict (fields : List) : Dval = - // // Give a warning for duplicate keys - // List.fold - // (DDict(Map.empty)) - // (fun m (k, v) -> - // match m, k, v with - // // TYPESCLEANUP: remove hacks - // // If we're propagating a fakeval keep doing it. We handle it without this line but let's be certain - // | m, _k, _v when isFake m -> m - // // Errors should propagate (but only if we're not already propagating an error) - // | DDict _, _, v when isFake v -> v - // // Skip empty rows - // | _, "", _ -> DError(None, $"Empty key: {k}") - // // Error if the key appears twice - // | DDict m, k, _v when Map.containsKey k m -> - // DError(None, $"Duplicate key: {k}") - // // Otherwise add it - // | DDict m, k, v -> DDict(Map.add k v m) - // // If we haven't got a DDict we're propagating an error so let it go - // | m, _, _ -> m) - // fields - - - - let optionSome (callStack : CallStack) (innerType : ValueType) (dv : Dval) : Dval = - let typeName = Dval.optionType - - let dvalType = Dval.toValueType dv - - match VT.merge innerType dvalType with - | Ok typ -> - DEnum(typeName, typeName, Dval.ignoreAndUseEmpty [ typ ], "Some", [ dv ]) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" - |> raiseRTE callStack - - let optionNone (innerType : ValueType) : Dval = - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ innerType ], - "None", - [] - ) - - let option - (callStack : CallStack) - (innerType : ValueType) - (dv : Option) - : Dval = - match dv with - | Some dv -> optionSome callStack innerType dv - | None -> optionNone innerType - - - - let resultOk - (callStack : CallStack) - (okType : ValueType) - (errorType : ValueType) - (dvOk : Dval) - : Dval = - let dvalType = Dval.toValueType dvOk - match VT.merge okType dvalType with - | Ok typ -> - DEnum( - Dval.resultType, - Dval.resultType, - Dval.ignoreAndUseEmpty [ typ; errorType ], - "Ok", - [ dvOk ] - ) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" - |> raiseRTE callStack - - let resultError - (callStack : CallStack) - (okType : ValueType) - (errorType : ValueType) - (dvError : Dval) - : Dval = - let dvalType = Dval.toValueType dvError - match VT.merge errorType dvalType with - | Ok typ -> - DEnum( - Dval.resultType, - Dval.resultType, - Dval.ignoreAndUseEmpty [ okType; typ ], - "Error", - [ dvError ] - ) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" - |> raiseRTE callStack - - let result - (callStack : CallStack) - (okType : ValueType) - (errorType : ValueType) - (dv : Result) - : Dval = - match dv with - | Ok dv -> resultOk callStack okType errorType dv - | Error dv -> resultError callStack okType errorType dv - - - /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape - /// - /// note: if provided, the typeArgs must match the # of typeArgs expected by the type - let record - (callStack : CallStack) - (typeName : FQTypeName.FQTypeName) - (fields : List) - : Ply = - let resolvedTypeName = typeName // TODO: alias lookup, etc. - - let fields = - List.fold - (fun fields (k, v) -> - match fields, k, v with - // skip empty rows - | _, "", _ -> raiseRTE callStack (RuntimeError.oldError "Empty key") - - // error if the key appears twice - | fields, k, _v when Map.containsKey k fields -> - raiseRTE callStack (RuntimeError.oldError $"Duplicate key: {k}") - - // otherwise add it - | fields, k, v -> Map.add k v fields) - Map.empty - fields - - // TODO: - // - pass in a (types: Types) arg - // - use it to determine type args of resultant Dval - // - ensure fields match the expected shape (defined by type args and field defs) - // - this process should also effect the type args of the resultant Dval - DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply - - - let enum - (resolvedTypeName : FQTypeName.FQTypeName) // todo: remove - (sourceTypeName : FQTypeName.FQTypeName) - (caseName : string) - (fields : List) - : Ply = - // TODO: - // - use passed-in Types to determine type args of resultant Dval - // - ensure fields match the expected shape (defined by type args and field defs) - // - this process should also effect the type args of the resultant Dval - - DEnum(resolvedTypeName, sourceTypeName, VT.typeArgsTODO, caseName, fields) - |> Ply +// /// Helpers for creating type-checked Dvals +// /// (lists, records, enums, etc.) +// /// +// /// Dvals should be created carefully: +// /// - to have the correct valueTypes, where appropriate +// /// i.e. we should not have DList(Known KTInt64, [ DString("hi") ]) +// /// +// /// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes +// /// i.e. `List.append [1] ["hi"]` should fail +// /// because we can't merge `Known KTInt64` and `Known KTString` +// /// +// /// These functions are intended to help with both of these, in cases where +// /// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types +// /// of a Dval in some F# code). +// /// +// /// TODO: review _all_ usages of these functions +// /// +// /// TODO: ideally we don't require a callStack to be input here -- too much data-passing +// /// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) +// module DvalCreator = +// // let list +// // (callStack : CallStack) +// // (initialType : ValueType) +// // (list : List) +// // : Dval = +// // let (typ, dvs) = +// // List.fold +// // (fun (typ, list) dv -> +// // let dvalType = Dval.toValueType dv + +// // match VT.merge typ dvalType with +// // | Ok newType -> newType, dv :: list +// // | Error() -> +// // RuntimeError.oldError +// // $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" +// // |> raiseRTE callStack) +// // (initialType, []) +// // (List.rev list) + +// // DList(typ, dvs) + + +// // let dict (typ : ValueType) (entries : List) : Dval = +// // // TODO: dictPush, etc. +// // DDict(typ, Map entries) + +// // let dictFromMap (typ : ValueType) (entries : Map) : Dval = +// // // TODO: dictPush, etc. +// // DDict(typ, entries) + +// // CLEANUP - this fn was unused so I commented it out +// // remove? or will it be handy? +// // let dict (fields : List) : Dval = +// // // Give a warning for duplicate keys +// // List.fold +// // (DDict(Map.empty)) +// // (fun m (k, v) -> +// // match m, k, v with +// // // TYPESCLEANUP: remove hacks +// // // If we're propagating a fakeval keep doing it. We handle it without this line but let's be certain +// // | m, _k, _v when isFake m -> m +// // // Errors should propagate (but only if we're not already propagating an error) +// // | DDict _, _, v when isFake v -> v +// // // Skip empty rows +// // | _, "", _ -> DError(None, $"Empty key: {k}") +// // // Error if the key appears twice +// // | DDict m, k, _v when Map.containsKey k m -> +// // DError(None, $"Duplicate key: {k}") +// // // Otherwise add it +// // | DDict m, k, v -> DDict(Map.add k v m) +// // // If we haven't got a DDict we're propagating an error so let it go +// // | m, _, _ -> m) +// // fields + + + +// let optionSome (callStack : CallStack) (innerType : ValueType) (dv : Dval) : Dval = +// let typeName = Dval.optionType + +// let dvalType = Dval.toValueType dv + +// match VT.merge innerType dvalType with +// | Ok typ -> +// DEnum(typeName, typeName, Dval.ignoreAndUseEmpty [ typ ], "Some", [ dv ]) +// | Error() -> +// RuntimeError.oldError +// $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" +// |> raiseRTE callStack + +// let optionNone (innerType : ValueType) : Dval = +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ innerType ], +// "None", +// [] +// ) + +// let option +// (callStack : CallStack) +// (innerType : ValueType) +// (dv : Option) +// : Dval = +// match dv with +// | Some dv -> optionSome callStack innerType dv +// | None -> optionNone innerType + + + +// let resultOk +// (callStack : CallStack) +// (okType : ValueType) +// (errorType : ValueType) +// (dvOk : Dval) +// : Dval = +// let dvalType = Dval.toValueType dvOk +// match VT.merge okType dvalType with +// | Ok typ -> +// DEnum( +// Dval.resultType, +// Dval.resultType, +// Dval.ignoreAndUseEmpty [ typ; errorType ], +// "Ok", +// [ dvOk ] +// ) +// | Error() -> +// RuntimeError.oldError +// $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" +// |> raiseRTE callStack + +// let resultError +// (callStack : CallStack) +// (okType : ValueType) +// (errorType : ValueType) +// (dvError : Dval) +// : Dval = +// let dvalType = Dval.toValueType dvError +// match VT.merge errorType dvalType with +// | Ok typ -> +// DEnum( +// Dval.resultType, +// Dval.resultType, +// Dval.ignoreAndUseEmpty [ okType; typ ], +// "Error", +// [ dvError ] +// ) +// | Error() -> +// RuntimeError.oldError +// $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" +// |> raiseRTE callStack + +// let result +// (callStack : CallStack) +// (okType : ValueType) +// (errorType : ValueType) +// (dv : Result) +// : Dval = +// match dv with +// | Ok dv -> resultOk callStack okType errorType dv +// | Error dv -> resultError callStack okType errorType dv + + +// /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape +// /// +// /// note: if provided, the typeArgs must match the # of typeArgs expected by the type +// let record +// (callStack : CallStack) +// (typeName : FQTypeName.FQTypeName) +// (fields : List) +// : Ply = +// let resolvedTypeName = typeName // TODO: alias lookup, etc. + +// let fields = +// List.fold +// (fun fields (k, v) -> +// match fields, k, v with +// // skip empty rows +// | _, "", _ -> raiseRTE callStack (RuntimeError.oldError "Empty key") + +// // error if the key appears twice +// | fields, k, _v when Map.containsKey k fields -> +// raiseRTE callStack (RuntimeError.oldError $"Duplicate key: {k}") + +// // otherwise add it +// | fields, k, v -> Map.add k v fields) +// Map.empty +// fields + +// // TODO: +// // - pass in a (types: Types) arg +// // - use it to determine type args of resultant Dval +// // - ensure fields match the expected shape (defined by type args and field defs) +// // - this process should also effect the type args of the resultant Dval +// DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply + + +// let enum +// (resolvedTypeName : FQTypeName.FQTypeName) // todo: remove +// (sourceTypeName : FQTypeName.FQTypeName) +// (caseName : string) +// (fields : List) +// : Ply = +// // TODO: +// // - use passed-in Types to determine type args of resultant Dval +// // - ensure fields match the expected shape (defined by type args and field defs) +// // - this process should also effect the type args of the resultant Dval + +// DEnum(resolvedTypeName, sourceTypeName, VT.typeArgsTODO, caseName, fields) +// |> Ply diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index 92325fb308..b50aafd0ac 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -6,8 +6,8 @@ module TestUtils.LibTest open System.Threading.Tasks open FSharp.Control.Tasks -open Npgsql.FSharp -open Npgsql +// open Npgsql.FSharp +// open Npgsql open Prelude open LibExecution.RuntimeTypes @@ -19,278 +19,262 @@ module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs -open LibCloud.Db +//open LibCloud.Db -let varA = TVariable "a" -let varB = TVariable "b" +// let varA = TVariable "a" +//let varB = TVariable "b" -let constants : List = - [ { name = constant "testNan" 0 - typ = TFloat - description = "Return a NaN" - body = DFloat(System.Double.NaN) - deprecated = NotDeprecated } +// let constants : List = +// [ { name = constant "testNan" 0 +// typ = TFloat +// description = "Return a NaN" +// body = DFloat(System.Double.NaN) +// deprecated = NotDeprecated } - { name = constant "testInfinity" 0 - typ = TFloat - description = "Returns positive infitity" - body = DFloat(System.Double.PositiveInfinity) - deprecated = NotDeprecated } +// { name = constant "testInfinity" 0 +// typ = TFloat +// description = "Returns positive infitity" +// body = DFloat(System.Double.PositiveInfinity) +// deprecated = NotDeprecated } - { name = constant "testNegativeInfinity" 0 - typ = TFloat - description = "Returns negative infinity" - body = DFloat(System.Double.NegativeInfinity) - deprecated = NotDeprecated } ] +// { name = constant "testNegativeInfinity" 0 +// typ = TFloat +// description = "Returns negative infinity" +// body = DFloat(System.Double.NegativeInfinity) +// deprecated = NotDeprecated } ] let fns : List = - [ { name = fn "testDerrorMessage" 0 - typeParams = [] - parameters = [ Param.make "errorMessage" TString "" ] - returnType = - TCustomType( - Ok( - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - ), - [] - ) - description = "Return a value representing a runtime type error" - fn = - (function - | _, _, [ DString error ] -> - let typeName = - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - // CLEANUP consider renaming to `oldError` or something more clear - { name = fn "testRuntimeError" 0 - typeParams = [] - parameters = [ Param.make "errorString" TString "" ] - returnType = TInt64 - description = "Return a value representing a type error" - fn = - (function - | _, _, [ DString errorString ] -> - raiseUntargetedRTE (RuntimeError.oldError errorString) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - { name = fn "testDerrorSqlMessage" 0 - typeParams = [] - parameters = [ Param.make "errorString" TString "" ] - returnType = - TCustomType( - Ok( - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - ), - [] - ) - description = "Return a value that matches errors thrown by the SqlCompiler" - fn = - (function - | _, _, [ DString errorString ] -> - let msg = LibCloud.SqlCompiler.errorTemplate + errorString - let typeName = - FQTypeName.Package - PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - DEnum(typeName, typeName, [], "ErrorString", [ DString msg ]) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - { name = fn "testToChar" 0 - typeParams = [] - parameters = [ Param.make "c" TString "" ] - returnType = TypeReference.option TChar - description = "Turns a string of length 1 into a character" - fn = - (function - | _, _, [ DString s ] -> - let chars = String.toEgcSeq s - - if Seq.length chars = 1 then - chars - |> Seq.toList - |> (fun l -> l[0]) - |> DChar - |> Dval.optionSome KTChar - |> Ply - else - Dval.optionNone KTChar |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testIncrementSideEffectCounter" 0 - typeParams = [] - parameters = - [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] - returnType = TVariable "a" - description = - "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." - fn = - (function - | state, _, [ arg ] -> - state.test.sideEffectCount <- state.test.sideEffectCount + 1 - Ply(arg) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testSideEffectCount" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = TInt64 - description = "Return the value of the side-effect counter" - fn = - (function - | state, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testInspect" 0 - typeParams = [] - parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] - returnType = varA - description = "Prints the value into stdout" - fn = - (function - | _, _, [ v; DString msg ] -> - print $"{msg}: {v}" - Ply v - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testDeleteUser" 0 - typeParams = [] - parameters = [ Param.make "username" TString "" ] - returnType = TypeReference.result TUnit varB - description = "Delete a user (test only)" - fn = - (function - | _, _, [ DString username ] -> - uply { - do! - // This is unsafe. A user has canvases, and canvases have traces. It - // will either break or cascade (haven't checked) - Sql.query "DELETE FROM accounts_v0 WHERE username = @username" - |> Sql.parameters [ "username", Sql.string (string username) ] - |> Sql.executeStatementAsync - return DUnit - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testGetQueue" 0 - typeParams = [] - parameters = [ Param.make "eventName" TString "" ] - returnType = TList TString - description = "Fetch a queue (test only)" - fn = - (function - | state, _, [ DString eventName ] -> - uply { - let canvasID = state.program.canvasID - let! results = - LibCloud.Queue.Test.loadEvents canvasID ("WORKER", eventName, "_") - let results = - results - |> List.map LibExecution.DvalReprDeveloper.toRepr - |> List.map DString - return DList(VT.string, results) - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } - - - { name = fn "testRaiseException" 0 - typeParams = [] - parameters = [ Param.make "message" TString "" ] - returnType = TVariable "a" - description = "A function that raises an F# exception" - fn = - (function - | _, _, [ DString message ] -> raise (System.Exception(message)) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testRegexReplace" 0 - typeParams = [] - parameters = - [ Param.make "subject" TString "" - Param.make "pattern" TString "" - Param.make "replacement" TString "" ] - returnType = TString - description = "Replaces regex patterns in a string" - fn = - (function - | _, _, [ DString str; DString pattern; DString replacement ] -> - FsRegEx.replace pattern replacement str |> DString |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testGetCanvasID" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = TUuid - description = "Get the name of the canvas that's running" - fn = - (function - | state, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "testSetExpectedExceptionCount" 0 - typeParams = [] - parameters = [ Param.make "count" TInt64 "" ] - returnType = TUnit - description = "Set the expected exception count for the current test" - fn = - (function - | state, _, [ DInt64 count ] -> - uply { - state.test.expectedExceptionCount <- int count - return DUnit - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } ] - -let builtins = LibExecution.Builtin.make constants fns + [ + // { name = fn "testDerrorMessage" 0 + // typeParams = [] + // parameters = [ Param.make "errorMessage" TString "" ] + // returnType = + // TCustomType( + // Ok( + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // ), + // [] + // ) + // description = "Return a value representing a runtime type error" + // fn = + // (function + // | _, _, [ DString error ] -> + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // // CLEANUP consider renaming to `oldError` or something more clear + // { name = fn "testRuntimeError" 0 + // typeParams = [] + // parameters = [ Param.make "errorString" TString "" ] + // returnType = TInt64 + // description = "Return a value representing a type error" + // fn = + // (function + // | _, _, [ DString errorString ] -> + // raiseUntargetedRTE (RuntimeError.oldError errorString) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // { name = fn "testDerrorSqlMessage" 0 + // typeParams = [] + // parameters = [ Param.make "errorString" TString "" ] + // returnType = + // TCustomType( + // Ok( + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // ), + // [] + // ) + // description = "Return a value that matches errors thrown by the SqlCompiler" + // fn = + // (function + // | _, _, [ DString errorString ] -> + // let msg = LibCloud.SqlCompiler.errorTemplate + errorString + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // DEnum(typeName, typeName, [], "ErrorString", [ DString msg ]) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // { name = fn "testToChar" 0 + // typeParams = [] + // parameters = [ Param.make "c" TString "" ] + // returnType = TypeReference.option TChar + // description = "Turns a string of length 1 into a character" + // fn = + // (function + // | _, _, [ DString s ] -> + // let chars = String.toEgcSeq s + + // if Seq.length chars = 1 then + // chars + // |> Seq.toList + // |> (fun l -> l[0]) + // |> DChar + // |> Dval.optionSome KTChar + // |> Ply + // else + // Dval.optionNone KTChar |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testIncrementSideEffectCounter" 0 + // typeParams = [] + // parameters = + // [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] + // returnType = TVariable "a" + // description = + // "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." + // fn = + // (function + // | state, _, [ arg ] -> + // state.test.sideEffectCount <- state.test.sideEffectCount + 1 + // Ply(arg) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testSideEffectCount" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TInt64 + // description = "Return the value of the side-effect counter" + // fn = + // (function + // | state, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testInspect" 0 + // typeParams = [] + // parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] + // returnType = varA + // description = "Prints the value into stdout" + // fn = + // (function + // | _, _, [ v; DString msg ] -> + // print $"{msg}: {v}" + // Ply v + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testDeleteUser" 0 + // typeParams = [] + // parameters = [ Param.make "username" TString "" ] + // returnType = TypeReference.result TUnit varB + // description = "Delete a user (test only)" + // fn = + // (function + // | _, _, [ DString username ] -> + // uply { + // do! + // // This is unsafe. A user has canvases, and canvases have traces. It + // // will either break or cascade (haven't checked) + // Sql.query "DELETE FROM accounts_v0 WHERE username = @username" + // |> Sql.parameters [ "username", Sql.string (string username) ] + // |> Sql.executeStatementAsync + // return DUnit + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testGetQueue" 0 + // typeParams = [] + // parameters = [ Param.make "eventName" TString "" ] + // returnType = TList TString + // description = "Fetch a queue (test only)" + // fn = + // (function + // | state, _, [ DString eventName ] -> + // uply { + // let canvasID = state.program.canvasID + // let! results = + // LibCloud.Queue.Test.loadEvents canvasID ("WORKER", eventName, "_") + // let results = + // results + // |> List.map LibExecution.DvalReprDeveloper.toRepr + // |> List.map DString + // return DList(VT.string, results) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + + + // { name = fn "testRaiseException" 0 + // typeParams = [] + // parameters = [ Param.make "message" TString "" ] + // returnType = TVariable "a" + // description = "A function that raises an F# exception" + // fn = + // (function + // | _, _, [ DString message ] -> raise (System.Exception(message)) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testGetCanvasID" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TUuid + // description = "Get the name of the canvas that's running" + // fn = + // (function + // | state, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testSetExpectedExceptionCount" 0 + // typeParams = [] + // parameters = [ Param.make "count" TInt64 "" ] + // returnType = TUnit + // description = "Set the expected exception count for the current test" + // fn = + // (function + // | state, _, [ DInt64 count ] -> + // uply { + // state.test.expectedExceptionCount <- int count + // return DUnit + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + ] + +let builtins = LibExecution.Builtin.make fns diff --git a/backend/tests/TestUtils/RTShortcuts.fs b/backend/tests/TestUtils/RTShortcuts.fs index c38cda3712..121dcfe20f 100644 --- a/backend/tests/TestUtils/RTShortcuts.fs +++ b/backend/tests/TestUtils/RTShortcuts.fs @@ -6,7 +6,49 @@ open LibExecution.RuntimeTypes module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module PTParser = LibExecution.ProgramTypesParser + +let eUnit () : Expr = EUnit(gid ()) + +let eBool (b : bool) : Expr = EBool(gid (), b) + +// let eInt8 (i : int8) : Expr = EInt8(gid (), i) +// let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) +// let eInt16 (i : int16) : Expr = EInt16(gid (), i) +// let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) +// let eInt32 (i : int32) : Expr = EInt32(gid (), i) +// let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) +let eInt64 (i : int64) : Expr = EInt64(gid (), i) +// let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) +// let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) +// let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) + +// let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = +// EFloat(gid (), makeFloat sign whole fraction) + +//let eChar (c : string) : Expr = EChar(gid (), c) +let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) + + + + +// let eList (elems : Expr list) : Expr = EList(gid (), elems) + +// let eVar (name : string) : Expr = EVariable(gid (), name) + +// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = +// EFieldAccess(gid (), expr, fieldName) + +// let eLambda (pats : List) (body : Expr) : Expr = +// let pats = NEList.ofListUnsafe "eLambda" [] pats +// ELambda(gid (), pats, body) + +// let eEnum +// (typeName : FQTypeName.FQTypeName) +// (name : string) +// (args : Expr list) +// : Expr = +// EEnum(gid (), typeName, name, args) + let eBuiltinFnName (name : string) (version : int) : Expr = PT.FQFnName.fqBuiltIn name version @@ -40,66 +82,16 @@ let eApply let args = NEList.ofListUnsafe "eApply" [] args EApply(gid (), target, typeArgs, args) -let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) - -let eChar (c : string) : Expr = EChar(gid (), c) - -let eInt64 (i : int64) : Expr = EInt64(gid (), i) - -let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) - -let eInt8 (i : int8) : Expr = EInt8(gid (), i) - -let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) - -let eInt16 (i : int16) : Expr = EInt16(gid (), i) - -let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) - -let eInt32 (i : int32) : Expr = EInt32(gid (), i) - -let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) - -let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) - -let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) - -let eBool (b : bool) : Expr = EBool(gid (), b) - -let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = - EFloat(gid (), makeFloat sign whole fraction) - -let eUnit () : Expr = EUnit(gid ()) - -let eList (elems : Expr list) : Expr = EList(gid (), elems) - -let eVar (name : string) : Expr = EVariable(gid (), name) - -let eFieldAccess (expr : Expr) (fieldName : string) : Expr = - EFieldAccess(gid (), expr, fieldName) - -let eLambda (pats : List) (body : Expr) : Expr = - let pats = NEList.ofListUnsafe "eLambda" [] pats - ELambda(gid (), pats, body) - -let eEnum - (typeName : FQTypeName.FQTypeName) - (name : string) - (args : Expr list) - : Expr = - EEnum(gid (), typeName, name, args) - - -let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = - ETuple(gid (), first, second, theRest) +// let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = +// ETuple(gid (), first, second, theRest) -let customTypeRecord (fields : List) : TypeDeclaration.T = - let fields = - fields - |> List.map (fun (name, typ) -> - { name = name; typ = typ } : TypeDeclaration.RecordField) - match fields with - | [] -> Exception.raiseInternal "userRecord must have at least one field" [] - | hd :: rest -> - { typeParams = []; definition = TypeDeclaration.Record(NEList.ofList hd rest) } +// let customTypeRecord (fields : List) : TypeDeclaration.T = +// let fields = +// fields +// |> List.map (fun (name, typ) -> +// { name = name; typ = typ } : TypeDeclaration.RecordField) +// match fields with +// | [] -> Exception.raiseInternal "userRecord must have at least one field" [] +// | hd :: rest -> +// { typeParams = []; definition = TypeDeclaration.Record(NEList.ofList hd rest) } diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 2913e7b1c7..213288544d 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -6,9 +6,9 @@ open Expecto open System.Threading.Tasks open FSharp.Control.Tasks -open Npgsql.FSharp -open Npgsql -open LibCloud.Db +// open Npgsql.FSharp +// open Npgsql +// open LibCloud.Db open Prelude @@ -19,22 +19,21 @@ module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module AT = LibExecution.AnalysisTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module PT2RDT = LibExecution.ProgramTypesToDarkTypes module D = LibExecution.DvalDecoder module PackageIDs = LibExecution.PackageIDs module Exe = LibExecution.Execution -module Account = LibCloud.Account -module Canvas = LibCloud.Canvas +// module Account = LibCloud.Account +// module Canvas = LibCloud.Canvas module S = RTShortcuts module PackageIDs = LibExecution.PackageIDs -module PT2DT = LibExecution.ProgramTypesToDarkTypes -module C2DT = LibExecution.CommonToDarkTypes +// module C2DT = LibExecution.CommonToDarkTypes +// module PT2DT = LibExecution.ProgramTypesToDarkTypes -let pmPT = LibCloud.PackageManager.pt +//let pmPT = LibCloud.PackageManager.pt -let testOwner : Lazy> = lazy (Account.createUser ()) +//let testOwner : Lazy> = lazy (Account.createUser ()) let nameToTestDomain (name : string) : string = let name = @@ -49,96 +48,98 @@ let nameToTestDomain (name : string) : string = |> FsRegEx.replace "[-_]+" "-" |> fun s -> $"{s}.dlio.localhost" -let initializeCanvasForOwner - (ownerID : UserID) - (name : string) - : Task = - task { - let domain = nameToTestDomain name - let! canvasID = Canvas.create ownerID domain - return (canvasID, domain) - } - -let initializeTestCanvas' (name : string) : Task = - task { - let! owner = testOwner.Force() - return! initializeCanvasForOwner owner name - } - -let initializeTestCanvas (name : string) : Task = - task { - let! (canvasID, _domain) = initializeTestCanvas' name - return canvasID - } - - -let testHttpRouteHandler - (route : string) - (method : string) - (ast : PT.Expr) - : PT.Handler.T = - { tlid = gid (); ast = ast; spec = PT.Handler.HTTP(route, method) } - -let testCron - (name : string) - (interval : PT.Handler.CronInterval) - (ast : PT.Expr) - : PT.Handler.T = - { tlid = gid (); ast = ast; spec = PT.Handler.Cron(name, interval) } - -let testWorker (name : string) (ast : PT.Expr) : PT.Handler.T = - { tlid = gid (); ast = ast; spec = PT.Handler.Worker name } - -let testPackageFn - (owner : string) - (name : string) - (typeParams : List) - (parameters : NEList) - (returnType : PT.TypeReference) - (body : PT.Expr) - : PT.PackageFn.PackageFn = - { id = System.Guid.NewGuid() - body = body - description = "" - name = PT.PackageFn.name owner [] name - typeParams = typeParams - deprecated = PT.NotDeprecated - parameters = - NEList.map - (fun p -> { name = p; typ = PT.TVariable "b"; description = "test" }) - parameters - returnType = returnType } - - - -let testDB (name : string) (typ : PT.TypeReference) : PT.DB.T = - { tlid = gid (); name = name; typ = typ; version = 0 } +// let initializeCanvasForOwner +// (ownerID : UserID) +// (name : string) +// : Task = +// task { +// let domain = nameToTestDomain name +// let! canvasID = Canvas.create ownerID domain +// return (canvasID, domain) +// } + +// let initializeTestCanvas' (name : string) : Task = +// task { +// let! owner = testOwner.Force() +// return! initializeCanvasForOwner owner name +// } + +// let initializeTestCanvas (name : string) : Task = +// task { +// let! (canvasID, _domain) = initializeTestCanvas' name +// return canvasID +// } + + +// let testHttpRouteHandler +// (route : string) +// (method : string) +// (ast : PT.Expr) +// : PT.Handler.T = +// { tlid = gid (); ast = ast; spec = PT.Handler.HTTP(route, method) } + +// let testCron +// (name : string) +// (interval : PT.Handler.CronInterval) +// (ast : PT.Expr) +// : PT.Handler.T = +// { tlid = gid (); ast = ast; spec = PT.Handler.Cron(name, interval) } + +// let testWorker (name : string) (ast : PT.Expr) : PT.Handler.T = +// { tlid = gid (); ast = ast; spec = PT.Handler.Worker name } + +// let testPackageFn +// (owner : string) +// (name : string) +// (typeParams : List) +// (parameters : NEList) +// (returnType : PT.TypeReference) +// (body : PT.Expr) +// : PT.PackageFn.PackageFn = +// { id = System.Guid.NewGuid() +// body = body +// description = "" +// name = PT.PackageFn.name owner [] name +// typeParams = typeParams +// deprecated = PT.NotDeprecated +// parameters = +// NEList.map +// (fun p -> { name = p; typ = PT.TVariable "b"; description = "test" }) +// parameters +// returnType = returnType } + + + +// let testDB (name : string) (typ : PT.TypeReference) : PT.DB.T = +// { tlid = gid (); name = name; typ = typ; version = 0 } let builtins - (httpConfig : BuiltinExecution.Libs.HttpClient.Configuration) - (pm : PT.PackageManager) + //(httpConfig : BuiltinExecution.Libs.HttpClient.Configuration) + (_pm : PT.PackageManager) : RT.Builtins = LibExecution.Builtin.combine [ LibTest.builtins - BuiltinExecution.Builtin.builtins httpConfig pm - BuiltinCloudExecution.Builtin.builtins - BuiltinDarkInternal.Builtin.builtins - BuiltinCli.Builtin.builtins ] + BuiltinExecution.Builtin.builtins //httpConfig pm + // BuiltinCloudExecution.Builtin.builtins + // BuiltinDarkInternal.Builtin.builtins + // BuiltinCli.Builtin.builtins + ] [] -let cloudBuiltIns (pm : PT.PackageManager) = - let httpConfig = - { LibCloudExecution.HttpClient.configuration with - timeoutInMs = 5000 - allowedIP = (fun _ -> true) } - builtins httpConfig pm +// let cloudBuiltIns (pm : PT.PackageManager) = +// let httpConfig = +// { LibCloudExecution.HttpClient.configuration with +// timeoutInMs = 5000 +// allowedIP = (fun _ -> true) } +// builtins httpConfig pm let localBuiltIns (pm : PT.PackageManager) = - let httpConfig = - { BuiltinExecution.Libs.HttpClient.defaultConfig with timeoutInMs = 5000 } - builtins httpConfig pm + // let httpConfig = + // { BuiltinExecution.Libs.HttpClient.defaultConfig with timeoutInMs = 5000 } + // builtins httpConfig pm + builtins pm @@ -146,17 +147,18 @@ let executionStateFor (pmPT : PT.PackageManager) (canvasID : CanvasID) (internalFnsAllowed : bool) - (allowLocalHttpAccess : bool) - (dbs : Map) + (_allowLocalHttpAccess : bool) + //(dbs : Map) : Task = task { - let! domains = Canvas.domainsForCanvasID canvasID + let domains = []//Canvas.domainsForCanvasID canvasID let program : RT.Program = { canvasID = canvasID internalFnsAllowed = internalFnsAllowed - dbs = dbs - secrets = [] } + // dbs = dbs + // secrets = [] + } let testContext : RT.TestContext = { sideEffectCount = 0 @@ -198,7 +200,8 @@ let executionStateFor let notifier : RT.Notifier = fun _state _msg _tags -> () let builtins = - if allowLocalHttpAccess then localBuiltIns pmPT else cloudBuiltIns pmPT + //if allowLocalHttpAccess then localBuiltIns pmPT else cloudBuiltIns pmPT + localBuiltIns pmPT let state = let pmRT = PT2RT.PackageManager.toRT pmPT let tracing = Exe.noTracing (RT.CallStack.fromEntryPoint RT.Script) @@ -207,13 +210,13 @@ let executionStateFor return state } -/// Saves and reloads the canvas for the Toplevels -let canvasForTLs (canvasID : CanvasID) (tls : List) : Task = - task { - let descs = tls |> List.map (fun tl -> (tl, LibCloud.Serialize.NotDeleted)) - do! Canvas.saveTLIDs canvasID descs - return! Canvas.loadAll canvasID - } +// /// Saves and reloads the canvas for the Toplevels +// let canvasForTLs (canvasID : CanvasID) (tls : List) : Task = +// task { +// let descs = tls |> List.map (fun tl -> (tl, LibCloud.Serialize.NotDeleted)) +// do! Canvas.saveTLIDs canvasID descs +// return! Canvas.loadAll canvasID +// } @@ -317,35 +320,35 @@ let rec debugDval (v : Dval) : string = | DString s -> $"DString '{s}'(len {s.Length}, {System.BitConverter.ToString(UTF8.toBytes s)})" - | DDateTime d -> - $"DDateTime '{DarkDateTime.toIsoString d}': (millies {d.InUtc().Millisecond})" + // | DDateTime d -> + // $"DDateTime '{DarkDateTime.toIsoString d}': (millies {d.InUtc().Millisecond})" - | DRecord(tn, _, typeArgs, o) -> - let typeStr = FQTypeName.toString tn + // | DRecord(tn, _, typeArgs, o) -> + // let typeStr = FQTypeName.toString tn - let typeArgsPart = - match typeArgs with - | [] -> "" - | _ -> - typeArgs - |> List.map ValueType.toString - |> String.concat ", " - |> fun s -> $"<{s}>" + // let typeArgsPart = + // match typeArgs with + // | [] -> "" + // | _ -> + // typeArgs + // |> List.map ValueType.toString + // |> String.concat ", " + // |> fun s -> $"<{s}>" - let fieldsPart = - o - |> Map.toList - |> List.map (fun (k, v) -> $"\"{k}\": {debugDval v}") - |> String.concat ",\n " + // let fieldsPart = + // o + // |> Map.toList + // |> List.map (fun (k, v) -> $"\"{k}\": {debugDval v}") + // |> String.concat ",\n " - $"DRecord {typeStr}{typeArgsPart} {{\n {fieldsPart}}}" + // $"DRecord {typeStr}{typeArgsPart} {{\n {fieldsPart}}}" - | DDict(_vtTODO, obj) -> - obj - |> Map.toList - |> List.map (fun (k, v) -> $"\"{k}\": {debugDval v}") - |> String.concat ",\n " - |> fun contents -> $"DDict {{\n {contents}}}" + // | DDict(_vtTODO, obj) -> + // obj + // |> Map.toList + // |> List.map (fun (k, v) -> $"\"{k}\": {debugDval v}") + // |> String.concat ",\n " + // |> fun contents -> $"DDict {{\n {contents}}}" | _ -> v.ToString() @@ -354,37 +357,39 @@ module Expect = // representation (in the event that there are multiple ways to represent // it). Think of this as a general form of string normalization. let rec isCanonical (dv : Dval) : bool = - let check = isCanonical + //let check = isCanonical match dv with - | DDateTime _ - | DInt64 _ - | DUInt64 _ - | DInt8 _ - | DUInt8 _ - | DInt16 _ - | DUInt16 _ - | DInt32 _ - | DUInt32 _ - | DInt128 _ - | DUInt128 _ - | DDateTime _ - | DBool _ - | DFloat _ | DUnit + | DBool _ + + // | DInt8 _ + // | DUInt8 _ + // | DInt16 _ + // | DUInt16 _ + // | DInt32 _ + // | DUInt32 _ + | DInt64 _ + // | DUInt64 _ + // | DInt128 _ + // | DUInt128 _ + + // | DFloat _ + + // | DDateTime _ + // | DUuid _ | DFnVal _ - | DDB _ - | DUuid _ - | DFloat _ -> true + // | DDB _ + -> true - | DChar str -> str.IsNormalized() && String.lengthInEgcs str = 1 + // | DChar str -> str.IsNormalized() && String.lengthInEgcs str = 1 | DString str -> str.IsNormalized() - | DList(_, items) -> List.all check items - | DTuple(first, second, rest) -> List.all check ([ first; second ] @ rest) - | DDict(_, entries) -> entries |> Map.values |> List.all check - | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all check - | DEnum(_, _, _, _, fields) -> fields |> List.all check + // | DList(_, items) -> List.all check items + // | DTuple(first, second, rest) -> List.all check ([ first; second ] @ rest) + // | DDict(_, entries) -> entries |> Map.values |> List.all check + // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all check + // | DEnum(_, _, _, _, fields) -> fields |> List.all check type Path = string list @@ -395,113 +400,113 @@ module Expect = let path = path @ [ "value" ] |> List.reverse |> String.concat "." $" `{path}` of" - let rec letPatternEqualityBaseFn - (checkIDs : bool) - (path : Path) - (actual : LetPattern) - (expected : LetPattern) - (errorFn : Path -> string -> string -> unit) - : unit = - let check path (a : 'a) (e : 'a) = - if a <> e then errorFn path (string actual) (string expected) - - if checkIDs then check path (LetPattern.toID actual) (LetPattern.toID expected) - - match actual, expected with - | LPVariable(_, name), LPVariable(_, name') -> check path name name' - | LPUnit(_), LPUnit(_) -> () - | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> - let all = first :: second :: theRest - let all' = first' :: second' :: theRest' - let zipped = List.zip all all' - List.iter - (fun (a, e) -> - letPatternEqualityBaseFn checkIDs (path @ [ "tuple" ]) a e errorFn) - zipped - - // exhaustive match - | LPVariable _, _ - | LPUnit _, _ - | LPTuple _, _ -> errorFn path (string actual) (string expected) - - - let rec userTypeNameEqualityBaseFn - (path : Path) - (actual : FQTypeName.FQTypeName) - (expected : FQTypeName.FQTypeName) - (errorFn : Path -> string -> string -> unit) - : unit = - let err () = errorFn path (string actual) (string expected) - - match actual, expected with - | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () - - let rec matchPatternEqualityBaseFn - (checkIDs : bool) - (path : Path) - (actual : MatchPattern) - (expected : MatchPattern) - (errorFn : Path -> string -> string -> unit) - : unit = - let eq path a e = matchPatternEqualityBaseFn checkIDs path a e errorFn - - let check path (a : 'a) (e : 'a) = - if a <> e then errorFn path (string actual) (string expected) - - let eqList path (l1 : List) (l2 : List) = - List.iteri2 (fun i -> eq (string i :: path)) l1 l2 - check path (List.length l1) (List.length l2) - - if checkIDs then - check path (MatchPattern.toID actual) (MatchPattern.toID expected) - - match actual, expected with - | MPVariable(_, name), MPVariable(_, name') -> check path name name' - | (MPEnum(_, caseName, fieldPats), MPEnum(_, caseName', fieldPats')) -> - check path caseName caseName' - eqList (caseName :: path) fieldPats fieldPats' - | MPString(_, str), MPString(_, str') -> check path str str' - | MPInt64(_, l), MPInt64(_, l') -> check path l l' - | MPUInt64(_, l), MPUInt64(_, l') -> check path l l' - | MPInt8(_, l), MPInt8(_, l') -> check path l l' - | MPUInt8(_, l), MPUInt8(_, l') -> check path l l' - | MPInt16(_, l), MPInt16(_, l') -> check path l l' - | MPUInt16(_, l), MPUInt16(_, l') -> check path l l' - | MPInt32(_, l), MPInt32(_, l') -> check path l l' - | MPUInt32(_, l), MPUInt32(_, l') -> check path l l' - | MPInt128(_, l), MPInt128(_, l') -> check path l l' - | MPUInt128(_, l), MPUInt128(_, l') -> check path l l' - | MPFloat(_, d), MPFloat(_, d') -> check path d d' - | MPBool(_, l), MPBool(_, l') -> check path l l' - | MPChar(_, c), MPChar(_, c') -> check path c c' - | MPUnit(_), MPUnit(_) -> () - | MPTuple(_, first, second, theRest), MPTuple(_, first', second', theRest') -> - eqList path (first :: second :: theRest) (first' :: second' :: theRest') - | MPList(_, pats), MPList(_, pats') -> eqList path pats pats' - | MPListCons(_, head, tail), MPListCons(_, head', tail') -> - check path head head' - check path tail tail' - // exhaustiveness check - | MPVariable _, _ - | MPEnum _, _ - | MPString _, _ - | MPInt64 _, _ - | MPUInt64 _, _ - | MPInt8 _, _ - | MPUInt8 _, _ - | MPInt16 _, _ - | MPUInt16 _, _ - | MPInt32 _, _ - | MPUInt32 _, _ - | MPInt128 _, _ - | MPUInt128 _, _ - | MPFloat _, _ - | MPBool _, _ - | MPChar _, _ - | MPUnit _, _ - | MPTuple _, _ - | MPListCons _, _ - | MPList _, _ -> check path actual expected + // let rec letPatternEqualityBaseFn + // (checkIDs : bool) + // (path : Path) + // (actual : LetPattern) + // (expected : LetPattern) + // (errorFn : Path -> string -> string -> unit) + // : unit = + // let check path (a : 'a) (e : 'a) = + // if a <> e then errorFn path (string actual) (string expected) + + // if checkIDs then check path (LetPattern.toID actual) (LetPattern.toID expected) + + // match actual, expected with + // | LPVariable(_, name), LPVariable(_, name') -> check path name name' + // | LPUnit(_), LPUnit(_) -> () + // | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> + // let all = first :: second :: theRest + // let all' = first' :: second' :: theRest' + // let zipped = List.zip all all' + // List.iter + // (fun (a, e) -> + // letPatternEqualityBaseFn checkIDs (path @ [ "tuple" ]) a e errorFn) + // zipped + + // // exhaustive match + // | LPVariable _, _ + // | LPUnit _, _ + // | LPTuple _, _ -> errorFn path (string actual) (string expected) + + + // let rec userTypeNameEqualityBaseFn + // (path : Path) + // (actual : FQTypeName.FQTypeName) + // (expected : FQTypeName.FQTypeName) + // (errorFn : Path -> string -> string -> unit) + // : unit = + // let err () = errorFn path (string actual) (string expected) + + // match actual, expected with + // | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () + + // let rec matchPatternEqualityBaseFn + // (checkIDs : bool) + // (path : Path) + // (actual : MatchPattern) + // (expected : MatchPattern) + // (errorFn : Path -> string -> string -> unit) + // : unit = + // let eq path a e = matchPatternEqualityBaseFn checkIDs path a e errorFn + + // let check path (a : 'a) (e : 'a) = + // if a <> e then errorFn path (string actual) (string expected) + + // let eqList path (l1 : List) (l2 : List) = + // List.iteri2 (fun i -> eq (string i :: path)) l1 l2 + // check path (List.length l1) (List.length l2) + + // if checkIDs then + // check path (MatchPattern.toID actual) (MatchPattern.toID expected) + + // match actual, expected with + // | MPVariable(_, name), MPVariable(_, name') -> check path name name' + // | (MPEnum(_, caseName, fieldPats), MPEnum(_, caseName', fieldPats')) -> + // check path caseName caseName' + // eqList (caseName :: path) fieldPats fieldPats' + // | MPString(_, str), MPString(_, str') -> check path str str' + // | MPInt64(_, l), MPInt64(_, l') -> check path l l' + // | MPUInt64(_, l), MPUInt64(_, l') -> check path l l' + // | MPInt8(_, l), MPInt8(_, l') -> check path l l' + // | MPUInt8(_, l), MPUInt8(_, l') -> check path l l' + // | MPInt16(_, l), MPInt16(_, l') -> check path l l' + // | MPUInt16(_, l), MPUInt16(_, l') -> check path l l' + // | MPInt32(_, l), MPInt32(_, l') -> check path l l' + // | MPUInt32(_, l), MPUInt32(_, l') -> check path l l' + // | MPInt128(_, l), MPInt128(_, l') -> check path l l' + // | MPUInt128(_, l), MPUInt128(_, l') -> check path l l' + // | MPFloat(_, d), MPFloat(_, d') -> check path d d' + // | MPBool(_, l), MPBool(_, l') -> check path l l' + // | MPChar(_, c), MPChar(_, c') -> check path c c' + // | MPUnit(_), MPUnit(_) -> () + // | MPTuple(_, first, second, theRest), MPTuple(_, first', second', theRest') -> + // eqList path (first :: second :: theRest) (first' :: second' :: theRest') + // | MPList(_, pats), MPList(_, pats') -> eqList path pats pats' + // | MPListCons(_, head, tail), MPListCons(_, head', tail') -> + // check path head head' + // check path tail tail' + // // exhaustiveness check + // | MPVariable _, _ + // | MPEnum _, _ + // | MPString _, _ + // | MPInt64 _, _ + // | MPUInt64 _, _ + // | MPInt8 _, _ + // | MPUInt8 _, _ + // | MPInt16 _, _ + // | MPUInt16 _, _ + // | MPInt32 _, _ + // | MPUInt32 _, _ + // | MPInt128 _, _ + // | MPUInt128 _, _ + // | MPFloat _, _ + // | MPBool _, _ + // | MPChar _, _ + // | MPUnit _, _ + // | MPTuple _, _ + // | MPListCons _, _ + // | MPList _, _ -> check path actual expected @@ -512,32 +517,7 @@ module Expect = (errorFn : Path -> string -> string -> unit) : unit = // as long as TypeReferences don't get IDs, depending on structural equality is OK - match actual, expected with - | TInt64, _ - | TUInt64, _ - | TInt8, _ - | TUInt8, _ - | TInt16, _ - | TUInt16, _ - | TInt32, _ - | TUInt32, _ - | TInt128, _ - | TUInt128, _ - | TFloat, _ - | TBool, _ - | TUnit, _ - | TString, _ - | TList(_), _ - | TTuple(_, _, _), _ - | TDict(_), _ - | TDB(_), _ - | TDateTime, _ - | TChar, _ - | TUuid, _ - | TVariable(_), _ - | TFn(_, _), _ - | TCustomType(_, _), _ -> - if actual <> expected then errorFn path (string actual) (string expected) + if actual <> expected then errorFn path (string actual) (string expected) @@ -566,6 +546,24 @@ module Expect = match actual, expected with // expressions with no values | EUnit _, EUnit _ -> () + + + // Simple exprs + | EBool(_, v), EBool(_, v') -> check path v v' + + // | EInt8(_, v), EInt8(_, v') -> check path v v' + // | EUInt8(_, v), EUInt8(_, v') -> check path v v' + // | EInt16(_, v), EInt16(_, v') -> check path v v' + // | EUInt16(_, v), EUInt16(_, v') -> check path v v' + // | EInt32(_, v), EInt32(_, v') -> check path v v' + // | EUInt32(_, v), EUInt32(_, v') -> check path v v' + | EInt64(_, v), EInt64(_, v') -> check path v v' + // | EUInt64(_, v), EUInt64(_, v') -> check path v v' + // | EInt128(_, v), EInt128(_, v') -> check path v v' + // | EUInt128(_, v), EUInt128(_, v') -> check path v v' + + // | EFloat(_, v), EFloat(_, v') -> check path v v' + // expressions with single string values | EString(_, s), EString(_, s') -> let rec checkSegment s s' = @@ -574,40 +572,29 @@ module Expect = | StringInterpolation e, StringInterpolation e' -> eq path e e' | _ -> check path s s' List.iter2 checkSegment s s' - | EChar(_, v), EChar(_, v') - | EVariable(_, v), EVariable(_, v') -> check path v v' - | EConstant(_, name), EConstant(_, name') -> check path name name' - | EInt64(_, v), EInt64(_, v') -> check path v v' - | EUInt64(_, v), EUInt64(_, v') -> check path v v' - | EInt8(_, v), EInt8(_, v') -> check path v v' - | EUInt8(_, v), EUInt8(_, v') -> check path v v' - | EInt16(_, v), EInt16(_, v') -> check path v v' - | EUInt16(_, v), EUInt16(_, v') -> check path v v' - | EInt32(_, v), EInt32(_, v') -> check path v v' - | EUInt32(_, v), EUInt32(_, v') -> check path v v' - | EInt128(_, v), EInt128(_, v') -> check path v v' - | EUInt128(_, v), EUInt128(_, v') -> check path v v' - | EFloat(_, v), EFloat(_, v') -> check path v v' - | EBool(_, v), EBool(_, v') -> check path v v' - | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> - letPatternEqualityBaseFn checkIDs path pat pat' errorFn - eq ("rhs" :: path) rhs rhs' - eq ("body" :: path) body body' - | EIf(_, con, thn, els), EIf(_, con', thn', els') -> - eq ("cond" :: path) con con' - eq ("then" :: path) thn thn' - match els, els' with - | Some el, Some el' -> eq ("else" :: path) el el' - | None, None -> () - | _ -> - errorFn ("else" :: path) (string actual) (string expected) - () - - | EList(_, l), EList(_, l') -> eqList path l l' - | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> - eq ("first" :: path) first first' - eq ("second" :: path) second second' - eqList path theRest theRest' + + // | EChar(_, v), EChar(_, v') + // | EVariable(_, v), EVariable(_, v') -> check path v v' + // | EConstant(_, name), EConstant(_, name') -> check path name name' + // | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> + // letPatternEqualityBaseFn checkIDs path pat pat' errorFn + // eq ("rhs" :: path) rhs rhs' + // eq ("body" :: path) body body' + // | EIf(_, con, thn, els), EIf(_, con', thn', els') -> + // eq ("cond" :: path) con con' + // eq ("then" :: path) thn thn' + // match els, els' with + // | Some el, Some el' -> eq ("else" :: path) el el' + // | None, None -> () + // | _ -> + // errorFn ("else" :: path) (string actual) (string expected) + // () + + // | EList(_, l), EList(_, l') -> eqList path l l' + // | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> + // eq ("first" :: path) first first' + // eq ("second" :: path) second second' + // eqList path theRest theRest' | EApply(_, name, typeArgs, args), EApply(_, name', typeArgs', args') -> let path = (string name :: path) @@ -620,114 +607,115 @@ module Expect = typeArgs' eqNEList path args args' + | EFnName(_, name), EFnName(_, name') -> check path name name' - | ERecord(_, typeName, fields), ERecord(_, typeName', fields') -> - userTypeNameEqualityBaseFn path typeName typeName' errorFn - NEList.iter2 - (fun (k, v) (k', v') -> - check path k k' - eq (k :: path) v v') - fields - fields' - | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> - check path record record' - NEList.iter2 - (fun (k, v) (k', v') -> - check path k k' - eq (k :: path) v v') - updates - updates' - | EDict(_, fields), EDict(_, fields') -> - List.iter2 - (fun (k, v) (k', v') -> - check ("key" :: path) k k' - eq ("value" :: path) v v') - fields - fields' - - | EFieldAccess(_, e, f), EFieldAccess(_, e', f') -> - eq (f :: path) e e' - check path f f' - - | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> - userTypeNameEqualityBaseFn path typeName typeName' errorFn - check path caseName caseName' - eqList path fields fields' - () - - | ELambda(_, pats, e), ELambda(_, pats', e') -> - let path = ("lambda" :: path) - eq path e e' - NEList.iter2 - (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) - pats - pats' - | EMatch(_, e, branches), EMatch(_, e', branches') -> - eq ("matchCond" :: path) e e' - - check path (NEList.length branches) (NEList.length branches') - NEList.iteri2 - (fun i branch branch' -> - let path = $"Case {i} - {branch.pat}" :: path - matchPatternEqualityBaseFn - checkIDs - ("pat" :: path) - branch.pat - branch'.pat - errorFn - match branch.whenCondition, branch'.whenCondition with - | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' - | None, None -> () - | _ -> - errorFn ("whenCondition" :: path) (string actual) (string expected) - () - eq ("rhs" :: path) branch.rhs branch'.rhs) - branches - branches' - | EAnd(_, l, r), EAnd(_, l', r') -> - eq ("left" :: path) l l' - eq ("right" :: path) r r' - | EOr(_, l, r), EOr(_, l', r') -> - eq ("left" :: path) l l' - eq ("right" :: path) r r' + // | ERecord(_, typeName, fields), ERecord(_, typeName', fields') -> + // userTypeNameEqualityBaseFn path typeName typeName' errorFn + // NEList.iter2 + // (fun (k, v) (k', v') -> + // check path k k' + // eq (k :: path) v v') + // fields + // fields' + // | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> + // check path record record' + // NEList.iter2 + // (fun (k, v) (k', v') -> + // check path k k' + // eq (k :: path) v v') + // updates + // updates' + // | EDict(_, fields), EDict(_, fields') -> + // List.iter2 + // (fun (k, v) (k', v') -> + // check ("key" :: path) k k' + // eq ("value" :: path) v v') + // fields + // fields' + + // | EFieldAccess(_, e, f), EFieldAccess(_, e', f') -> + // eq (f :: path) e e' + // check path f f' + + // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> + // userTypeNameEqualityBaseFn path typeName typeName' errorFn + // check path caseName caseName' + // eqList path fields fields' + // () + + // | ELambda(_, pats, e), ELambda(_, pats', e') -> + // let path = ("lambda" :: path) + // eq path e e' + // NEList.iter2 + // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) + // pats + // pats' + // | EMatch(_, e, branches), EMatch(_, e', branches') -> + // eq ("matchCond" :: path) e e' + + // check path (NEList.length branches) (NEList.length branches') + // NEList.iteri2 + // (fun i branch branch' -> + // let path = $"Case {i} - {branch.pat}" :: path + // matchPatternEqualityBaseFn + // checkIDs + // ("pat" :: path) + // branch.pat + // branch'.pat + // errorFn + // match branch.whenCondition, branch'.whenCondition with + // | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' + // | None, None -> () + // | _ -> + // errorFn ("whenCondition" :: path) (string actual) (string expected) + // () + // eq ("rhs" :: path) branch.rhs branch'.rhs) + // branches + // branches' + // | EAnd(_, l, r), EAnd(_, l', r') -> + // eq ("left" :: path) l l' + // eq ("right" :: path) r r' + // | EOr(_, l, r), EOr(_, l', r') -> + // eq ("left" :: path) l l' + // eq ("right" :: path) r r' | EError(_, msg, exprs), EError(_, msg', exprs') -> check path msg msg' eqList path exprs exprs' // exhaustiveness check | EUnit _, _ + // | EInt8 _, _ + // | EUInt8 _, _ + // | EInt16 _, _ + // | EUInt16 _, _ + // | EInt32 _, _ + // | EUInt32 _, _ | EInt64 _, _ - | EUInt64 _, _ - | EInt8 _, _ - | EUInt8 _, _ - | EInt16 _, _ - | EUInt16 _, _ - | EInt32 _, _ - | EUInt32 _, _ - | EInt128 _, _ - | EUInt128 _, _ + // | EUInt64 _, _ + // | EInt128 _, _ + // | EUInt128 _, _ | EString _, _ - | EChar _, _ - | EVariable _, _ - | EConstant _, _ + // | EChar _, _ + // | EVariable _, _ + // | EConstant _, _ | EBool _, _ - | EFloat _, _ - | ELet _, _ - | EIf _, _ - | EList _, _ - | ETuple _, _ + // | EFloat _, _ + // | ELet _, _ + // | EIf _, _ + // | EList _, _ + // | ETuple _, _ | EApply _, _ | EFnName _, _ - | ERecord _, _ - | ERecordUpdate _, _ - | EDict _, _ - | EFieldAccess _, _ - | EEnum _, _ - | ELambda _, _ - | EMatch _, _ - | EAnd _, _ - | EOr _, _ + // | ERecord _, _ + // | ERecordUpdate _, _ + // | EDict _, _ + // | EFieldAccess _, _ + // | EEnum _, _ + // | ELambda _, _ + // | EMatch _, _ + // | EAnd _, _ + // | EOr _, _ | EError _, _ -> check path actual expected @@ -740,161 +728,162 @@ module Expect = (expected : Dval) (errorFn : Path -> string -> string -> unit) : unit = - let de p a e = dvalEqualityBaseFn p a e errorFn - let error path = errorFn path (string actual) (string expected) + //let de p a e = dvalEqualityBaseFn p a e errorFn + //let error path = errorFn path (string actual) (string expected) let check (path : Path) (a : 'a) (e : 'a) : unit = if a <> e then errorFn path (debugDval actual) (debugDval expected) - let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = - match VT.merge a e with - | Ok _merged -> () - | Error() -> errorFn path (debugDval actual) (debugDval expected) + // let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = + // match VT.merge a e with + // | Ok _merged -> () + // | Error() -> errorFn path (debugDval actual) (debugDval expected) match actual, expected with - | DFloat l, DFloat r -> - if System.Double.IsNaN l && System.Double.IsNaN r then - // This isn't "true" equality, it's just for tests - () - else if - System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r - then - () - else if - System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r - then - () - else if - System.Double.IsNaN l - || System.Double.IsNaN r - || System.Double.IsPositiveInfinity l - || System.Double.IsPositiveInfinity r - || System.Double.IsNegativeInfinity l - || System.Double.IsNegativeInfinity r - then - error path - else if not (Accuracy.areClose Accuracy.veryHigh l r) then - error path - | DDateTime l, DDateTime r -> - // Two dates can be the same millisecond and not be equal if they don't - // have the same number of ticks. For testing, we shall consider them - // equal if they print the same string. - check path (string l) (string r) - - | DList(lType, ls), DList(rType, rs) -> - checkValueType ("Type" :: path) lType rType - - check ("Length" :: path) (List.length ls) (List.length rs) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs - - | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> - de path firstL firstR - - de path secondL secondR - - check ("Length" :: path) (List.length theRestL) (List.length theRestR) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR - - | DDict(lType, ls), DDict(rType, rs) -> - check ("Length" :: path) (Map.count ls) (Map.count rs) - - checkValueType ("Type" :: path) lType rType - - // check keys from ls are in both, check matching values - Map.iterWithIndex - (fun key v1 -> - match Map.find key rs with - | Some v2 -> de (key :: path) v1 v2 - | None -> check (key :: path) ls rs) - ls - - // check keys from rs are in both - Map.iterWithIndex - (fun key _ -> - match Map.find key rs with - | Some _ -> () // already checked - | None -> check (key :: path) ls rs) - rs - - - | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> - // check type name - userTypeNameEqualityBaseFn path ltn rtn errorFn - - // check type args - check - ("TypeArgsLength" :: path) - (List.length ltypeArgs) - (List.length rtypeArgs) - List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs - - check ("Length" :: path) (Map.count ls) (Map.count rs) - - // check keys - // -- keys from ls are in both, check matching values - Map.iterWithIndex - (fun key v1 -> - match Map.find key rs with - | Some v2 -> de (key :: path) v1 v2 - | None -> check (key :: path) ls rs) - ls - - // -- keys from rs are in both - Map.iterWithIndex - (fun key _ -> - match Map.find key rs with - | Some _ -> () // already checked - | None -> check (key :: path) ls rs) - rs - - - | DEnum(typeName, _, typeArgs, caseName, fields), - DEnum(typeName', _, typeArgs', caseName', fields') -> - userTypeNameEqualityBaseFn path typeName typeName' errorFn - check ("caseName" :: path) caseName caseName' - - check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') - List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' - - check ("fields.Length" :: path) (List.length fields) (List.length fields) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' - () - - | DFnVal(Lambda l1), DFnVal(Lambda l2) -> - NEList.iter2 - (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) - l1.parameters - l2.parameters - check ("symbtable" :: path) l1.symtable l2.symtable // TODO: use dvalEquality - exprEqualityBaseFn false path l1.body l2.body errorFn + // | DFloat l, DFloat r -> + // if System.Double.IsNaN l && System.Double.IsNaN r then + // // This isn't "true" equality, it's just for tests + // () + // else if + // System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r + // then + // () + // else if + // System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r + // then + // () + // else if + // System.Double.IsNaN l + // || System.Double.IsNaN r + // || System.Double.IsPositiveInfinity l + // || System.Double.IsPositiveInfinity r + // || System.Double.IsNegativeInfinity l + // || System.Double.IsNegativeInfinity r + // then + // error path + // else if not (Accuracy.areClose Accuracy.veryHigh l r) then + // error path + // | DDateTime l, DDateTime r -> + // // Two dates can be the same millisecond and not be equal if they don't + // // have the same number of ticks. For testing, we shall consider them + // // equal if they print the same string. + // check path (string l) (string r) + + // | DList(lType, ls), DList(rType, rs) -> + // checkValueType ("Type" :: path) lType rType + + // check ("Length" :: path) (List.length ls) (List.length rs) + // List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs + + // | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> + // de path firstL firstR + + // de path secondL secondR + + // check ("Length" :: path) (List.length theRestL) (List.length theRestR) + // List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR + + // | DDict(lType, ls), DDict(rType, rs) -> + // check ("Length" :: path) (Map.count ls) (Map.count rs) + + // checkValueType ("Type" :: path) lType rType + + // // check keys from ls are in both, check matching values + // Map.iterWithIndex + // (fun key v1 -> + // match Map.find key rs with + // | Some v2 -> de (key :: path) v1 v2 + // | None -> check (key :: path) ls rs) + // ls + + // // check keys from rs are in both + // Map.iterWithIndex + // (fun key _ -> + // match Map.find key rs with + // | Some _ -> () // already checked + // | None -> check (key :: path) ls rs) + // rs + + + // | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> + // // check type name + // userTypeNameEqualityBaseFn path ltn rtn errorFn + + // // check type args + // check + // ("TypeArgsLength" :: path) + // (List.length ltypeArgs) + // (List.length rtypeArgs) + // List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs + + // check ("Length" :: path) (Map.count ls) (Map.count rs) + + // // check keys + // // -- keys from ls are in both, check matching values + // Map.iterWithIndex + // (fun key v1 -> + // match Map.find key rs with + // | Some v2 -> de (key :: path) v1 v2 + // | None -> check (key :: path) ls rs) + // ls + + // // -- keys from rs are in both + // Map.iterWithIndex + // (fun key _ -> + // match Map.find key rs with + // | Some _ -> () // already checked + // | None -> check (key :: path) ls rs) + // rs + + + // | DEnum(typeName, _, typeArgs, caseName, fields), + // DEnum(typeName', _, typeArgs', caseName', fields') -> + // userTypeNameEqualityBaseFn path typeName typeName' errorFn + // check ("caseName" :: path) caseName caseName' + + // check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') + // List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' + + // check ("fields.Length" :: path) (List.length fields) (List.length fields) + // List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' + // () + + // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> + // NEList.iter2 + // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) + // l1.parameters + // l2.parameters + // check ("symbtable" :: path) l1.symtable l2.symtable // TODO: use dvalEquality + // exprEqualityBaseFn false path l1.body l2.body errorFn | DString _, DString _ -> check path (debugDval actual) (debugDval expected) // Keep for exhaustiveness checking - | DDict _, _ - | DRecord _, _ - | DEnum _, _ - | DList _, _ - | DTuple _, _ - | DString _, _ - | DInt64 _, _ - | DUInt64 _, _ - | DInt8 _, _ - | DUInt8 _, _ - | DInt16 _, _ - | DUInt16 _, _ - | DInt32 _, _ - | DUInt32 _, _ - | DInt128 _, _ - | DUInt128 _, _ - | DDateTime _, _ - | DBool _, _ - | DFloat _, _ | DUnit, _ - | DChar _, _ + | DBool _, _ + // | DInt8 _, _ + // | DUInt8 _, _ + // | DInt16 _, _ + // | DUInt16 _, _ + // | DInt32 _, _ + // | DUInt32 _, _ + | DInt64 _, _ + // | DUInt64 _, _ + // | DInt128 _, _ + // | DUInt128 _, _ + // | DFloat _, _ + // | DChar _, _ + | DString _, _ + // | DDateTime _, _ + // | DUuid _, _ + // | DList _, _ + // | DTuple _, _ + // | DDict _, _ + // | DRecord _, _ + // | DEnum _, _ | DFnVal _, _ - | DDB _, _ - | DUuid _, _ -> check path actual expected + // | DDB _, _ + -> check path actual expected let formatMsg (initialMsg : string) (path : Path) (actual : 'a) : string = let initial = if initialMsg = "" then "" else $"{initialMsg}\n\n" @@ -904,20 +893,20 @@ module Expect = dvalEqualityBaseFn [] actual expected (fun path a e -> Expect.equal a e (formatMsg msg path actual)) - let rec equalMatchPattern - (actual : MatchPattern) - (expected : MatchPattern) - (msg : string) - : unit = - matchPatternEqualityBaseFn true [] actual expected (fun path a e -> - Expect.equal a e (formatMsg msg path actual)) - - let rec equalMatchPatternIgnoringIDs - (actual : MatchPattern) - (expected : MatchPattern) - : unit = - matchPatternEqualityBaseFn false [] actual expected (fun path a e -> - Expect.equal a e (formatMsg "" path actual)) + // let rec equalMatchPattern + // (actual : MatchPattern) + // (expected : MatchPattern) + // (msg : string) + // : unit = + // matchPatternEqualityBaseFn true [] actual expected (fun path a e -> + // Expect.equal a e (formatMsg msg path actual)) + + // let rec equalMatchPatternIgnoringIDs + // (actual : MatchPattern) + // (expected : MatchPattern) + // : unit = + // matchPatternEqualityBaseFn false [] actual expected (fun path a e -> + // Expect.equal a e (formatMsg "" path actual)) let rec equalExpr (actual : Expr) (expected : Expr) (msg : string) : unit = exprEqualityBaseFn true [] actual expected (fun path a e -> @@ -937,34 +926,35 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = let f dv = state <- f dv :: state let rec visit dv : unit = match dv with - // Keep for exhaustiveness checking - | DDict(_, entries) -> Map.values entries |> List.map visit |> ignore> - | DRecord(_, _, _, fields) -> - Map.values fields |> List.map visit |> ignore> - | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> - | DList(_, items) -> List.map visit items |> ignore> - | DTuple(first, second, theRest) -> - List.map visit ([ first; second ] @ theRest) |> ignore> + // | DDict(_, entries) -> Map.values entries |> List.map visit |> ignore> + // | DRecord(_, _, _, fields) -> + // Map.values fields |> List.map visit |> ignore> + // | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> + // | DList(_, items) -> List.map visit items |> ignore> + // | DTuple(first, second, theRest) -> + // List.map visit ([ first; second ] @ theRest) |> ignore> + // Keep for exhaustiveness checking | DUnit | DBool _ + // | DInt8 _ + // | DUInt8 _ + // | DInt16 _ + // | DUInt16 _ + // | DInt32 _ + // | DUInt32 _ | DInt64 _ - | DUInt64 _ - | DInt8 _ - | DUInt8 _ - | DInt16 _ - | DUInt16 _ - | DInt32 _ - | DUInt32 _ - | DInt128 _ - | DUInt128 _ - | DFloat _ + // | DUInt64 _ + // | DInt128 _ + // | DUInt128 _ + // | DFloat _ + // | DChar _ + | DString _ // TODO: should actually traverse in interpolations + // | DUuid _ + // | DDateTime _ | DFnVal _ - | DUuid _ - | DDateTime _ - | DDB _ - | DChar _ - | DString _ -> f dv + // | DDB _ + -> f dv f dv visit dv state @@ -986,38 +976,38 @@ let interestingStrings : List = -let interestingFloats : List = - let initial = - // interesting cause we used to use 31 bit ints - [ "min 31 bit", System.Math.Pow(2.0, 30.0) - 1.0 - "max 31 bit", - System.Math.Pow(2.0, 30.0) - // interesting cause boundary of 32 bit ints - "min 32 bit", System.Math.Pow(2.0, 31.0) - 1.0 - "max 32 bit", - System.Math.Pow(2.0, 31.0) - // interesting cause doubles support up to 53-bit ints - "min 53 bit", System.Math.Pow(2.0, 52.0) - 1.0 - "max 53 bit", - System.Math.Pow(2.0, 52.0) - // interesting cause we used to have 63 bit ints - "min 63 bit", System.Math.Pow(2.0, 62.0) - 1.0 - "max 63 bit", - System.Math.Pow(2.0, 62.0) - // interesting cause boundary of 64 bit ints - "min 64 bit", System.Math.Pow(2.0, 63.0) - 1.0 - "max 64 bit", - System.Math.Pow(2.0, 63.0) - // Interesting anyway - "zero", 0.0 - "negative zero", -0.0 - "NaN", nan - "infinity", infinity - "-infinity", -infinity - // Mathy values - "e", System.Math.E - "pi", System.Math.PI - "tau", System.Math.Tau ] - - initial - |> List.map (fun (doc, v) -> - [ ($"float {doc} - 1", v - 1.0); ($"{doc} + 0", v); ($"{doc} + 1", v + 1.0) ]) - |> List.flatten +// let interestingFloats : List = +// let initial = +// // interesting cause we used to use 31 bit ints +// [ "min 31 bit", System.Math.Pow(2.0, 30.0) - 1.0 +// "max 31 bit", - System.Math.Pow(2.0, 30.0) +// // interesting cause boundary of 32 bit ints +// "min 32 bit", System.Math.Pow(2.0, 31.0) - 1.0 +// "max 32 bit", - System.Math.Pow(2.0, 31.0) +// // interesting cause doubles support up to 53-bit ints +// "min 53 bit", System.Math.Pow(2.0, 52.0) - 1.0 +// "max 53 bit", - System.Math.Pow(2.0, 52.0) +// // interesting cause we used to have 63 bit ints +// "min 63 bit", System.Math.Pow(2.0, 62.0) - 1.0 +// "max 63 bit", - System.Math.Pow(2.0, 62.0) +// // interesting cause boundary of 64 bit ints +// "min 64 bit", System.Math.Pow(2.0, 63.0) - 1.0 +// "max 64 bit", - System.Math.Pow(2.0, 63.0) +// // Interesting anyway +// "zero", 0.0 +// "negative zero", -0.0 +// "NaN", nan +// "infinity", infinity +// "-infinity", -infinity +// // Mathy values +// "e", System.Math.E +// "pi", System.Math.PI +// "tau", System.Math.Tau ] + +// initial +// |> List.map (fun (doc, v) -> +// [ ($"float {doc} - 1", v - 1.0); ($"{doc} + 0", v); ($"{doc} + 1", v + 1.0) ]) +// |> List.flatten let interestingInts : List = [ ("int0", 0L) @@ -1038,481 +1028,481 @@ let interestingInts : List = |> List.flatten -// https://github.com/minimaxir/big-list-of-naughty-strings -let naughtyStrings : List = - LibCloud.File.readfile LibCloud.Config.Testdata "naughty-strings.txt" - |> String.splitOnNewline - |> List.mapWithIndex (fun i s -> $"naughty string line {i + 1}", s) - // 139 is the Unicode BOM on line 140, which is tough to get .NET to put in a string - |> List.filterWithIndex (fun i (_, str) -> - i <> 139 && not (String.startsWith "#" str)) - - -let interestingDvals : List = - let uuid = System.Guid.Parse "dca045b1-e2af-41d8-ad1b-35261b25a426" - - [ ("float", DFloat 7.2, TFloat) - ("float2", DFloat -7.2, TFloat) - ("float3", DFloat 15.0, TFloat) - ("float4", DFloat -15.0, TFloat) - ("int5", DInt64 5L, TInt64) - ("int_8_bits", DInt8 127y, TInt8) - ("int_16_bits", DInt16 32767s, TInt16) - ("int_32_bits", DInt32 2147483647l, TInt32) - ("int_128_bits", DInt128 170141183460469231731687303715884105727Q, TInt128) - ("uint_8_bits", DUInt8 255uy, TUInt8) - ("uint_16_bits", DUInt16 65535us, TUInt16) - ("uint_32_bits", DUInt32 4294967295ul, TUInt32) - ("uint_64_bits", DUInt64 18446744073709551615UL, TUInt64) - ("uint_128_bits", DUInt128 340282366920938463463374607431768211455Z, TUInt128) - ("true", DBool true, TBool) - ("false", DBool false, TBool) - ("unit", DUnit, TUnit) - ("datastore", DDB "Visitors", TDB TInt64) - ("string", DString "incredibly this was broken", TString) - // Json.NET has a habit of converting things automatically based on the type in the string - ("date string", DString "2018-09-14T00:31:41Z", TString) - ("int string", DString "1039485", TString) - ("int string2", DString "-1039485", TString) - ("int string3", DString "0", TString) - ("uuid string", DString "7d9e5495-b068-4364-a2cc-3633ab4d13e6", TString) - ("list", DList(ValueType.Known KTInt64, [ Dval.int64 4 ]), TList TInt64) - - ("record", - DRecord( - FQTypeName.Package uuid, - FQTypeName.Package uuid, - [], - Map.ofList - [ "url", DString "https://darklang.com" - "headers", Dval.list (KTTuple(VT.string, VT.string, [])) [] - "body", Dval.list KTUInt8 [] ] - ), - TCustomType(Ok(FQTypeName.Package uuid), [])) - - ("enum", - DEnum( - FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json, - FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json, - [], - "String", - [ DString "test" ] - ), - TCustomType(Ok(FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json), [])) - - // TODO: extract what's useful in here, and create smaller tests for each - ("record2", - DRecord( - FQTypeName.Package uuid, - FQTypeName.Package uuid, - [ VT.unknown; VT.bool ], - Map.ofList [ ("type", DString "weird"); ("value", DUnit) ] - ), - TCustomType(Ok(FQTypeName.Package uuid), [])) - ("record3", - DRecord( - FQTypeName.Package uuid, - FQTypeName.Package uuid, - [], - Map.ofList [ ("type", DString "weird"); ("value", DString "x") ] - ), - TCustomType(Ok(FQTypeName.Package uuid), [])) - // More Json.NET tests - ("record4", - DRecord( - FQTypeName.Package uuid, - FQTypeName.Package uuid, - [ VT.bool; VT.char; (VT.customType (FQTypeName.Package uuid)) [] ], - Map.ofList [ "foo\\\\bar", Dval.int64 5 ] - ), - TCustomType(Ok(FQTypeName.Package uuid), [])) - ("record5", - DRecord( - FQTypeName.Package uuid, - FQTypeName.Package uuid, - [], - Map.ofList [ "$type", Dval.int64 5 ] - ), - TCustomType(Ok(FQTypeName.Package uuid), [])) - ("dict", DDict(VT.unknown, Map [ "foo", Dval.int64 5 ]), TDict TInt64) - ("dict3", - DDict(VT.unknown, Map [ ("type", DString "weird"); ("value", DString "x") ]), - TDict TString) - // More Json.NET tests - ("dict4", DDict(VT.unknown, Map [ "foo\\\\bar", Dval.int64 5 ]), TDict TInt64) - ("dict5", DDict(VT.unknown, Map [ "$type", Dval.int64 5 ]), TDict TInt64) - ("lambda", - DFnVal( - Lambda - { body = RT.EUnit(id 1234) - typeSymbolTable = Map.empty - symtable = Map.empty - parameters = NEList.singleton (RT.LPVariable(id 5678, "a")) } - ), - TFn(NEList.singleton TInt64, TUnit)) - ("lambda with pipe", - DFnVal( - Lambda - { body = - EApply( - 92356985UL, - (EFnName( - 957274UL, - FQFnName.Builtin { name = "listPush"; version = 0 } - )), - [], - NEList.singleton ( - EApply( - 93459985UL, - (EFnName(123123UL, FQFnName.Builtin { name = "+"; version = 0 })), - [], - (NEList.doubleton - (EApply( - 394567785UL, - (EFnName( - 95723UL, - FQFnName.Builtin { name = "+"; version = 0 } - )), - [], - (NEList.doubleton - (EApply( - 44444485UL, - (EFnName( - 9473UL, - FQFnName.Builtin { name = "+"; version = 0 } - )), - [], - (NEList.doubleton - (EInt64(234213618UL, 5)) - (EInt64(923423468UL, 6))) - )) - (EInt64(648327618UL, 7))) - )) - (EInt64(325843618UL, 8))) - ) - ) - ) - symtable = Map.empty - typeSymbolTable = Map.empty - parameters = NEList.singleton (RT.LPVariable(id 5678, "a")) } - ), - TFn(NEList.singleton TInt64, TInt64)) - ("db", DDB "Visitors", TDB TInt64) - ("date", - DDateTime( - DarkDateTime.fromInstant (NodaTime.Instant.ofIsoString "2018-09-14T00:31:41Z") - ), - TDateTime) - ("uuid", DUuid(System.Guid.Parse "7d9e5495-b068-4364-a2cc-3633ab4d13e6"), TUuid) - ("uuid0", DUuid(System.Guid.Parse "00000000-0000-0000-0000-000000000000"), TUuid) - ("option", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int64 ], - "None", - [] - ), - TypeReference.option TInt64) - ("option2", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int64 ], - "Some", - [ Dval.int64 15 ] - ), - TypeReference.option TInt64) - ("option3", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.string ], - "Some", - [ DString "a string" ] - ), - TypeReference.option TString) - ("option4", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int8 ], - "Some", - [ Dval.int8 15y ] - ), - TypeReference.option TInt8) - ("option5", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.uint8 ], - "Some", - [ Dval.uint8 15uy ] - ), - TypeReference.option TUInt8) - ("option6", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int16 ], - "Some", - [ Dval.int16 16s ] - ), - TypeReference.option TInt16) - ("option7", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.uint16 ], - "Some", - [ Dval.uint16 16us ] - ), - TypeReference.option TUInt16) - ("option8", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int32 ], - "Some", - [ Dval.int32 32l ] - ), - TypeReference.option TInt32) - ("option9", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.uint32 ], - "Some", - [ Dval.uint32 32ul ] - ), - TypeReference.option TUInt32) - ("option10", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.int128 ], - "Some", - [ Dval.int128 128Q ] - ), - TypeReference.option TInt128) - ("option11", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.uint128 ], - "Some", - [ Dval.uint128 128Z ] - ), - TypeReference.option TUInt128) - ("option12", - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ VT.uint64 ], - "Some", - [ Dval.uint64 64UL ] - ), - TypeReference.option TUInt64) - ("character", DChar "s", TChar) - ("bytes", - ((System.Convert.FromBase64String "JyIoXCg=") |> Dval.byteArrayToDvalList), - (TList TUInt8)) - // use image bytes here to test for any weird bytes forms - ("bytes2", - // TODO: deeply nested data - (LibCloud.File.readfileBytes LibCloud.Config.Testdata "sample_image_bytes.png") - |> Dval.byteArrayToDvalList, - (TList TUInt8)) - ("simple2Tuple", - DTuple(Dval.int64 1, Dval.int64 2, []), - TTuple(TInt64, TInt64, [])) - ("simple3Tuple", - DTuple(Dval.int64 1, Dval.int64 2, [ Dval.int64 3 ]), - TTuple(TInt64, TInt64, [ TInt64 ])) - ("tupleWithUnit", - DTuple(Dval.int64 1, Dval.int64 2, [ DUnit ]), - TTuple(TInt64, TInt64, [ TUnit ])) - ("tupleWithError", - DTuple( - Dval.int64 1, - DEnum( - Dval.resultType, - Dval.resultType, - Dval.ignoreAndUseEmpty [ VT.unknown; VT.string ], - "Error", - [ DString "error" ] - ), - [] - ), - TTuple(TInt64, TypeReference.result TInt64 TString, [])) ] - -let sampleDvals : List = - List.concat - [ List.map (fun (k, v) -> k, DInt64 v, TInt64) interestingInts - List.map (fun (k, v) -> k, DFloat v, TFloat) interestingFloats - List.map (fun (k, v) -> k, DString v, TString) interestingStrings - List.map (fun (k, v) -> k, DString v, TString) naughtyStrings - interestingDvals ] - |> List.map (fun (k, v, t) -> k, (v, t)) - -// Utilties shared among tests -module Http = - type T = { status : string; headers : (string * string) list; body : byte array } - - let setHeadersToCRLF (text : byte array) : byte array = - // We keep our test files with an LF line ending, but the HTTP spec - // requires headers (but not the body, nor the first line) to have CRLF - // line endings - let mutable justSawNewline = false - let mutable inBody = false - - text - |> Array.toList - |> List.collect (fun b -> - if not inBody && b = byte '\n' then - if justSawNewline then inBody <- true - justSawNewline <- true - [ byte '\r'; b ] - else - justSawNewline <- false - [ b ]) - |> List.toArray - - let split (response : byte array) : T = - // read a single line of bytes (a line ends with \r\n) - let rec consume (existing : byte list) (l : byte list) : byte list * byte list = - match l with - | [] -> [], [] - | 13uy :: 10uy :: tail -> existing, tail - | head :: tail -> consume (existing @ [ head ]) tail - - // read all headers (ends when we get two \r\n in a row), return headers - // and remaining byte string (the body). Assumes the status line is not - // present. Headers are returned reversed - let rec consumeHeaders - (headers : string list) - (l : byte list) - : string list * byte list = - let (line, remaining) = consume [] l - - if line = [] then - (headers, remaining) - else - let str = line |> Array.ofList |> UTF8.ofBytesUnsafe - consumeHeaders (str :: headers) remaining - - let bytes = Array.toList response - - // read the status like (eg HTTP 200 OK) - let status, bytes = consume [] bytes - - let headers, body = consumeHeaders [] bytes - - let headers = - headers - |> List.reverse - |> List.map (fun s -> - match String.split ":" s with - | k :: vs -> (k, vs |> String.concat ":" |> String.trimLeft) - | _ -> Exception.raiseInternal $"not a valid header" [ "header", s ]) - - - { status = status |> List.toArray |> UTF8.ofBytesUnsafe - headers = headers - body = List.toArray body } - -// For an ASP.NET http server, remove the default loggers and add a file logger that -// saves the output in rundir/logs -open Microsoft.Extensions.Logging -open Microsoft.Extensions.DependencyInjection -open NReco.Logging.File - -let configureLogging - (name : string) - (builder : Microsoft.Extensions.Logging.ILoggingBuilder) - : unit = - // This removes the default ConsoleLogger. Having two console loggers (this one and - // also the one in Main), caused a deadlock (possibly from having two different - // console logging threads). - builder - .ClearProviders() - .Services.AddLogging(fun loggingBuilder -> - loggingBuilder.AddFile($"{LibCloud.Config.logDir}{name}.log", append = false) - |> ignore) - |> ignore - - -let unwrapExecutionResult - (exeResult : RT.ExecutionResult) - (state : RT.ExecutionState) - : Ply.Ply = - uply { - match exeResult with - | Ok dval -> return dval - | Error(_callStack, rte) -> - let errorMessageFn = - RT.FQFnName.fqPackage - PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage - - let rte = RT.RuntimeError.toDT rte - - let! rteMessage = - LibExecution.Execution.executeFunction - state - errorMessageFn - [] - (NEList.ofList rte []) - - match rteMessage with - | Ok(RT.DString msg) -> return RT.DString msg - | _ -> return RT.DString(string rte) - } - -let parsePTExpr (code : string) : Task = - uply { - let! (state : RT.ExecutionState) = - let canvasID = System.Guid.NewGuid() - executionStateFor pmPT canvasID false false Map.empty - - let name = - RT.FQFnName.FQFnName.Package PackageIDs.Fn.LanguageTools.Parser.parsePTExpr - - let args = NEList.singleton (RT.DString code) - let! execResult = LibExecution.Execution.executeFunction state name [] args - - match execResult with - | Ok dval -> - match C2DT.Result.fromDT PT2DT.Expr.fromDT dval identity with - | Ok expr -> return expr - | Error _ -> - return Exception.raiseInternal "Error converting Dval to PT.Expr" [] - | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] - } - |> Ply.toTask - -module Internal = - module Test = - type PTTest = - { name : string; lineNumber : int; actual : PT.Expr; expected : PT.Expr } - - type RTTest = - { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } - - let typeName = FQTypeName.fqPackage PackageIDs.Type.Internal.Test.ptTest - - let toDt (t : PTTest) : Dval = - let fields = - [ "name", DString t.name - "lineNumber", DInt64 t.lineNumber - "actual", PT2DT.Expr.toDT t.actual - "expected", PT2DT.Expr.toDT t.expected ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PTTest = - match d with - | DRecord(_, _, _, fields) -> - { name = fields |> D.stringField "name" - lineNumber = fields |> D.intField "lineNumber" - actual = fields |> D.field "actual" |> PT2DT.Expr.fromDT - expected = fields |> D.field "expected" |> PT2DT.Expr.fromDT } - | _ -> Exception.raiseInternal "Invalid Test" [] +// // https://github.com/minimaxir/big-list-of-naughty-strings +// let naughtyStrings : List = +// LibCloud.File.readfile LibCloud.Config.Testdata "naughty-strings.txt" +// |> String.splitOnNewline +// |> List.mapWithIndex (fun i s -> $"naughty string line {i + 1}", s) +// // 139 is the Unicode BOM on line 140, which is tough to get .NET to put in a string +// |> List.filterWithIndex (fun i (_, str) -> +// i <> 139 && not (String.startsWith "#" str)) + + +// let interestingDvals : List = +// let uuid = System.Guid.Parse "dca045b1-e2af-41d8-ad1b-35261b25a426" + +// [ ("float", DFloat 7.2, TFloat) +// ("float2", DFloat -7.2, TFloat) +// ("float3", DFloat 15.0, TFloat) +// ("float4", DFloat -15.0, TFloat) +// ("int5", DInt64 5L, TInt64) +// ("int_8_bits", DInt8 127y, TInt8) +// ("int_16_bits", DInt16 32767s, TInt16) +// ("int_32_bits", DInt32 2147483647l, TInt32) +// ("int_128_bits", DInt128 170141183460469231731687303715884105727Q, TInt128) +// ("uint_8_bits", DUInt8 255uy, TUInt8) +// ("uint_16_bits", DUInt16 65535us, TUInt16) +// ("uint_32_bits", DUInt32 4294967295ul, TUInt32) +// ("uint_64_bits", DUInt64 18446744073709551615UL, TUInt64) +// ("uint_128_bits", DUInt128 340282366920938463463374607431768211455Z, TUInt128) +// ("true", DBool true, TBool) +// ("false", DBool false, TBool) +// ("unit", DUnit, TUnit) +// ("datastore", DDB "Visitors", TDB TInt64) +// ("string", DString "incredibly this was broken", TString) +// // Json.NET has a habit of converting things automatically based on the type in the string +// ("date string", DString "2018-09-14T00:31:41Z", TString) +// ("int string", DString "1039485", TString) +// ("int string2", DString "-1039485", TString) +// ("int string3", DString "0", TString) +// ("uuid string", DString "7d9e5495-b068-4364-a2cc-3633ab4d13e6", TString) +// ("list", DList(ValueType.Known KTInt64, [ Dval.int64 4 ]), TList TInt64) + +// ("record", +// DRecord( +// FQTypeName.Package uuid, +// FQTypeName.Package uuid, +// [], +// Map.ofList +// [ "url", DString "https://darklang.com" +// "headers", Dval.list (KTTuple(VT.string, VT.string, [])) [] +// "body", Dval.list KTUInt8 [] ] +// ), +// TCustomType(Ok(FQTypeName.Package uuid), [])) + +// ("enum", +// DEnum( +// FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json, +// FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json, +// [], +// "String", +// [ DString "test" ] +// ), +// TCustomType(Ok(FQTypeName.Package PackageIDs.Type.Stdlib.AltJson.json), [])) + +// // TODO: extract what's useful in here, and create smaller tests for each +// ("record2", +// DRecord( +// FQTypeName.Package uuid, +// FQTypeName.Package uuid, +// [ VT.unknown; VT.bool ], +// Map.ofList [ ("type", DString "weird"); ("value", DUnit) ] +// ), +// TCustomType(Ok(FQTypeName.Package uuid), [])) +// ("record3", +// DRecord( +// FQTypeName.Package uuid, +// FQTypeName.Package uuid, +// [], +// Map.ofList [ ("type", DString "weird"); ("value", DString "x") ] +// ), +// TCustomType(Ok(FQTypeName.Package uuid), [])) +// // More Json.NET tests +// ("record4", +// DRecord( +// FQTypeName.Package uuid, +// FQTypeName.Package uuid, +// [ VT.bool; VT.char; (VT.customType (FQTypeName.Package uuid)) [] ], +// Map.ofList [ "foo\\\\bar", Dval.int64 5 ] +// ), +// TCustomType(Ok(FQTypeName.Package uuid), [])) +// ("record5", +// DRecord( +// FQTypeName.Package uuid, +// FQTypeName.Package uuid, +// [], +// Map.ofList [ "$type", Dval.int64 5 ] +// ), +// TCustomType(Ok(FQTypeName.Package uuid), [])) +// ("dict", DDict(VT.unknown, Map [ "foo", Dval.int64 5 ]), TDict TInt64) +// ("dict3", +// DDict(VT.unknown, Map [ ("type", DString "weird"); ("value", DString "x") ]), +// TDict TString) +// // More Json.NET tests +// ("dict4", DDict(VT.unknown, Map [ "foo\\\\bar", Dval.int64 5 ]), TDict TInt64) +// ("dict5", DDict(VT.unknown, Map [ "$type", Dval.int64 5 ]), TDict TInt64) +// ("lambda", +// DFnVal( +// Lambda +// { body = RT.EUnit(id 1234) +// typeSymbolTable = Map.empty +// symtable = Map.empty +// parameters = NEList.singleton (RT.LPVariable(id 5678, "a")) } +// ), +// TFn(NEList.singleton TInt64, TUnit)) +// ("lambda with pipe", +// DFnVal( +// Lambda +// { body = +// EApply( +// 92356985UL, +// (EFnName( +// 957274UL, +// FQFnName.Builtin { name = "listPush"; version = 0 } +// )), +// [], +// NEList.singleton ( +// EApply( +// 93459985UL, +// (EFnName(123123UL, FQFnName.Builtin { name = "+"; version = 0 })), +// [], +// (NEList.doubleton +// (EApply( +// 394567785UL, +// (EFnName( +// 95723UL, +// FQFnName.Builtin { name = "+"; version = 0 } +// )), +// [], +// (NEList.doubleton +// (EApply( +// 44444485UL, +// (EFnName( +// 9473UL, +// FQFnName.Builtin { name = "+"; version = 0 } +// )), +// [], +// (NEList.doubleton +// (EInt64(234213618UL, 5)) +// (EInt64(923423468UL, 6))) +// )) +// (EInt64(648327618UL, 7))) +// )) +// (EInt64(325843618UL, 8))) +// ) +// ) +// ) +// symtable = Map.empty +// typeSymbolTable = Map.empty +// parameters = NEList.singleton (RT.LPVariable(id 5678, "a")) } +// ), +// TFn(NEList.singleton TInt64, TInt64)) +// ("db", DDB "Visitors", TDB TInt64) +// ("date", +// DDateTime( +// DarkDateTime.fromInstant (NodaTime.Instant.ofIsoString "2018-09-14T00:31:41Z") +// ), +// TDateTime) +// ("uuid", DUuid(System.Guid.Parse "7d9e5495-b068-4364-a2cc-3633ab4d13e6"), TUuid) +// ("uuid0", DUuid(System.Guid.Parse "00000000-0000-0000-0000-000000000000"), TUuid) +// ("option", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int64 ], +// "None", +// [] +// ), +// TypeReference.option TInt64) +// ("option2", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int64 ], +// "Some", +// [ Dval.int64 15 ] +// ), +// TypeReference.option TInt64) +// ("option3", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.string ], +// "Some", +// [ DString "a string" ] +// ), +// TypeReference.option TString) +// ("option4", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int8 ], +// "Some", +// [ Dval.int8 15y ] +// ), +// TypeReference.option TInt8) +// ("option5", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.uint8 ], +// "Some", +// [ Dval.uint8 15uy ] +// ), +// TypeReference.option TUInt8) +// ("option6", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int16 ], +// "Some", +// [ Dval.int16 16s ] +// ), +// TypeReference.option TInt16) +// ("option7", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.uint16 ], +// "Some", +// [ Dval.uint16 16us ] +// ), +// TypeReference.option TUInt16) +// ("option8", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int32 ], +// "Some", +// [ Dval.int32 32l ] +// ), +// TypeReference.option TInt32) +// ("option9", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.uint32 ], +// "Some", +// [ Dval.uint32 32ul ] +// ), +// TypeReference.option TUInt32) +// ("option10", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.int128 ], +// "Some", +// [ Dval.int128 128Q ] +// ), +// TypeReference.option TInt128) +// ("option11", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.uint128 ], +// "Some", +// [ Dval.uint128 128Z ] +// ), +// TypeReference.option TUInt128) +// ("option12", +// DEnum( +// Dval.optionType, +// Dval.optionType, +// Dval.ignoreAndUseEmpty [ VT.uint64 ], +// "Some", +// [ Dval.uint64 64UL ] +// ), +// TypeReference.option TUInt64) +// ("character", DChar "s", TChar) +// ("bytes", +// ((System.Convert.FromBase64String "JyIoXCg=") |> Dval.byteArrayToDvalList), +// (TList TUInt8)) +// // use image bytes here to test for any weird bytes forms +// ("bytes2", +// // TODO: deeply nested data +// (LibCloud.File.readfileBytes LibCloud.Config.Testdata "sample_image_bytes.png") +// |> Dval.byteArrayToDvalList, +// (TList TUInt8)) +// ("simple2Tuple", +// DTuple(Dval.int64 1, Dval.int64 2, []), +// TTuple(TInt64, TInt64, [])) +// ("simple3Tuple", +// DTuple(Dval.int64 1, Dval.int64 2, [ Dval.int64 3 ]), +// TTuple(TInt64, TInt64, [ TInt64 ])) +// ("tupleWithUnit", +// DTuple(Dval.int64 1, Dval.int64 2, [ DUnit ]), +// TTuple(TInt64, TInt64, [ TUnit ])) +// ("tupleWithError", +// DTuple( +// Dval.int64 1, +// DEnum( +// Dval.resultType, +// Dval.resultType, +// Dval.ignoreAndUseEmpty [ VT.unknown; VT.string ], +// "Error", +// [ DString "error" ] +// ), +// [] +// ), +// TTuple(TInt64, TypeReference.result TInt64 TString, [])) ] + +// let sampleDvals : List = +// List.concat +// [ List.map (fun (k, v) -> k, DInt64 v, TInt64) interestingInts +// List.map (fun (k, v) -> k, DFloat v, TFloat) interestingFloats +// List.map (fun (k, v) -> k, DString v, TString) interestingStrings +// List.map (fun (k, v) -> k, DString v, TString) naughtyStrings +// interestingDvals ] +// |> List.map (fun (k, v, t) -> k, (v, t)) + +// // Utilties shared among tests +// module Http = +// type T = { status : string; headers : (string * string) list; body : byte array } + +// let setHeadersToCRLF (text : byte array) : byte array = +// // We keep our test files with an LF line ending, but the HTTP spec +// // requires headers (but not the body, nor the first line) to have CRLF +// // line endings +// let mutable justSawNewline = false +// let mutable inBody = false + +// text +// |> Array.toList +// |> List.collect (fun b -> +// if not inBody && b = byte '\n' then +// if justSawNewline then inBody <- true +// justSawNewline <- true +// [ byte '\r'; b ] +// else +// justSawNewline <- false +// [ b ]) +// |> List.toArray + +// let split (response : byte array) : T = +// // read a single line of bytes (a line ends with \r\n) +// let rec consume (existing : byte list) (l : byte list) : byte list * byte list = +// match l with +// | [] -> [], [] +// | 13uy :: 10uy :: tail -> existing, tail +// | head :: tail -> consume (existing @ [ head ]) tail + +// // read all headers (ends when we get two \r\n in a row), return headers +// // and remaining byte string (the body). Assumes the status line is not +// // present. Headers are returned reversed +// let rec consumeHeaders +// (headers : string list) +// (l : byte list) +// : string list * byte list = +// let (line, remaining) = consume [] l + +// if line = [] then +// (headers, remaining) +// else +// let str = line |> Array.ofList |> UTF8.ofBytesUnsafe +// consumeHeaders (str :: headers) remaining + +// let bytes = Array.toList response + +// // read the status like (eg HTTP 200 OK) +// let status, bytes = consume [] bytes + +// let headers, body = consumeHeaders [] bytes + +// let headers = +// headers +// |> List.reverse +// |> List.map (fun s -> +// match String.split ":" s with +// | k :: vs -> (k, vs |> String.concat ":" |> String.trimLeft) +// | _ -> Exception.raiseInternal $"not a valid header" [ "header", s ]) + + +// { status = status |> List.toArray |> UTF8.ofBytesUnsafe +// headers = headers +// body = List.toArray body } + +// // For an ASP.NET http server, remove the default loggers and add a file logger that +// // saves the output in rundir/logs +// open Microsoft.Extensions.Logging +// open Microsoft.Extensions.DependencyInjection +// open NReco.Logging.File + +// let configureLogging +// (name : string) +// (builder : Microsoft.Extensions.Logging.ILoggingBuilder) +// : unit = +// // This removes the default ConsoleLogger. Having two console loggers (this one and +// // also the one in Main), caused a deadlock (possibly from having two different +// // console logging threads). +// builder +// .ClearProviders() +// .Services.AddLogging(fun loggingBuilder -> +// loggingBuilder.AddFile($"{LibCloud.Config.logDir}{name}.log", append = false) +// |> ignore) +// |> ignore + + +// let unwrapExecutionResult +// (exeResult : RT.ExecutionResult) +// (state : RT.ExecutionState) +// : Ply.Ply = +// uply { +// match exeResult with +// | Ok dval -> return dval +// | Error(_callStack, rte) -> +// let errorMessageFn = +// RT.FQFnName.fqPackage +// PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage + +// let rte = RT.RuntimeError.toDT rte + +// let! rteMessage = +// LibExecution.Execution.executeFunction +// state +// errorMessageFn +// [] +// (NEList.ofList rte []) + +// match rteMessage with +// | Ok(RT.DString msg) -> return RT.DString msg +// | _ -> return RT.DString(string rte) +// } + +// let parsePTExpr (code : string) : Task = +// uply { +// let! (state : RT.ExecutionState) = +// let canvasID = System.Guid.NewGuid() +// executionStateFor pmPT canvasID false false Map.empty + +// let name = +// RT.FQFnName.FQFnName.Package PackageIDs.Fn.LanguageTools.Parser.parsePTExpr + +// let args = NEList.singleton (RT.DString code) +// let! execResult = LibExecution.Execution.executeFunction state name [] args + +// match execResult with +// | Ok dval -> +// match C2DT.Result.fromDT PT2DT.Expr.fromDT dval identity with +// | Ok expr -> return expr +// | Error _ -> +// return Exception.raiseInternal "Error converting Dval to PT.Expr" [] +// | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] +// } +// |> Ply.toTask + +// module Internal = +// module Test = +// type PTTest = +// { name : string; lineNumber : int; actual : PT.Expr; expected : PT.Expr } + +// type RTTest = +// { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } + +// let typeName = FQTypeName.fqPackage PackageIDs.Type.Internal.Test.ptTest + +// let toDt (t : PTTest) : Dval = +// let fields = +// [ "name", DString t.name +// "lineNumber", DInt64 t.lineNumber +// "actual", PT2DT.Expr.toDT t.actual +// "expected", PT2DT.Expr.toDT t.expected ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PTTest = +// match d with +// | DRecord(_, _, _, fields) -> +// { name = fields |> D.stringField "name" +// lineNumber = fields |> D.intField "lineNumber" +// actual = fields |> D.field "actual" |> PT2DT.Expr.fromDT +// expected = fields |> D.field "expected" |> PT2DT.Expr.fromDT } +// | _ -> Exception.raiseInternal "Invalid Test" [] diff --git a/backend/tests/TestUtils/TestUtils.fsproj b/backend/tests/TestUtils/TestUtils.fsproj index 52a9b9e8d0..eec3a2c940 100644 --- a/backend/tests/TestUtils/TestUtils.fsproj +++ b/backend/tests/TestUtils/TestUtils.fsproj @@ -9,9 +9,9 @@ - - - + + + diff --git a/backend/tests/TestUtils/paket.references b/backend/tests/TestUtils/paket.references index f1fd67956c..f00337a6cd 100644 --- a/backend/tests/TestUtils/paket.references +++ b/backend/tests/TestUtils/paket.references @@ -1,3 +1,4 @@ Expecto FSharp.Compiler.Service NReco.Logging.File +FsRegEx \ No newline at end of file diff --git a/backend/tests/Tests/ProgramTypes.Tests.fs b/backend/tests/Tests/ProgramTypes.Tests.fs index 71335ca9c3..af34fa6ea6 100644 --- a/backend/tests/Tests/ProgramTypes.Tests.fs +++ b/backend/tests/Tests/ProgramTypes.Tests.fs @@ -4,38 +4,37 @@ open Expecto open Prelude open TestUtils.TestUtils -module ST = LibBinarySerialization.SerializedTypes +//module ST = LibBinarySerialization.SerializedTypes module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes -module PT2ST = LibBinarySerialization.ProgramTypesToSerializedTypes +//module PT2ST = LibBinarySerialization.ProgramTypesToSerializedTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module PTParser = LibExecution.ProgramTypesParser module S = TestUtils.RTShortcuts module PackageIDs = LibExecution.PackageIDs -module PT2DT = LibExecution.ProgramTypesToDarkTypes -module C2DT = LibExecution.CommonToDarkTypes -let pm = LibCloud.PackageManager.pt - -let p (code : string) : Ply = - uply { - let! (state : RT.ExecutionState) = - let canvasID = System.Guid.NewGuid() - executionStateFor pm canvasID false false Map.empty - - let name = - RT.FQFnName.FQFnName.Package PackageIDs.Fn.LanguageTools.Parser.parsePTExpr - - let args = NEList.singleton (RT.DString code) - let! execResult = LibExecution.Execution.executeFunction state name [] args - - match execResult with - | Ok dval -> - match C2DT.Result.fromDT PT2DT.Expr.fromDT dval identity with - | Ok expr -> return expr - | Error _ -> - return Exception.raiseInternal "Error converting Dval to PT.Expr" [] - | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] - } +// module PT2DT = LibExecution.ProgramTypesToDarkTypes +// module C2DT = LibExecution.CommonToDarkTypes +// let pm = LibCloud.PackageManager.pt + +// let p (code : string) : Ply = +// uply { +// let! (state : RT.ExecutionState) = +// let canvasID = System.Guid.NewGuid() +// executionStateFor pm canvasID false false Map.empty + +// let name = +// RT.FQFnName.FQFnName.Package PackageIDs.Fn.LanguageTools.Parser.parsePTExpr + +// let args = NEList.singleton (RT.DString code) +// let! execResult = LibExecution.Execution.executeFunction state name [] args + +// match execResult with +// | Ok dval -> +// match C2DT.Result.fromDT PT2DT.Expr.fromDT dval identity with +// | Ok expr -> return expr +// | Error _ -> +// return Exception.raiseInternal "Error converting Dval to PT.Expr" [] +// | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] +// } let ptFQFnName = testMany @@ -45,110 +44,111 @@ let ptFQFnName = let pmPT = PT.PackageManager.empty -let testPipesToRuntimeTypes = - testTask "pipes to runtime types" { - let parsed = p "value.age |> (-) 2L |> (+) value.age |> (<) 3L" - let! actual = Ply.map PT2RT.Expr.toRT parsed |> Ply.toTask - - let expected = - S.eFn - "int64LessThan" - 0 - [] - [ S.eFn - "int64Add" - 0 - [] - [ S.eFn - "int64Subtract" - 0 - [] - [ S.eFieldAccess (S.eVar "value") "age"; S.eInt64 2 ] - S.eFieldAccess (S.eVar "value") "age" ] - S.eInt64 3 ] - - return Expect.equalExprIgnoringIDs actual expected - } - -let testProgramTypesToRuntimeTypes = - let u = PT.EUnit 8UL - let ru = RT.EUnit 8UL - - testMany - "program types to runtime types" - PT2RT.Expr.toRT - [ PT.EFloat(7UL, Positive, "", "0"), RT.EFloat(7UL, 0.0) - PT.EFloat(7UL, Positive, "0", ""), RT.EFloat(7UL, 0.0) - PT.EFloat(7UL, Positive, "", ""), RT.EFloat(7UL, 0.0) - (PT.EMatch( - 9UL, - u, - [ { pat = PT.MPFloat(5UL, Positive, "", ""); whenCondition = None; rhs = u } ] - ), - RT.EMatch( - 9UL, - ru, - NEList.singleton - { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } - )) - (PT.EMatch( - 9UL, - u, - [ { pat = PT.MPFloat(5UL, Positive, "0", ""); whenCondition = None; rhs = u } ] - ), - RT.EMatch( - 9UL, - ru, - NEList.singleton - { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } - )) - (PT.EMatch( - 9UL, - u, - [ { pat = PT.MPFloat(5UL, Positive, "", "0"); whenCondition = None; rhs = u } ] - ), - RT.EMatch( - 9UL, - ru, - NEList.singleton - { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } - )) - (PT.EMatch( - 9UL, - u, - [ { pat = PT.MPFloat(5UL, Positive, "0", "0") - whenCondition = Some u - rhs = u } ] - ), - RT.EMatch( - 9UL, - ru, - NEList.singleton - { pat = RT.MPFloat(5UL, 0.0); whenCondition = Some ru; rhs = ru } - )) ] - -let testInfixProgramTypesToSerializedTypes = - testMany - "infix program types to serialized types" - PT2ST.Expr.toST - [ (PT.EInfix( - 8UL, - PT.InfixFnCall(PT.ArithmeticPlus), - PT.EInt64(9UL, 6L), - PT.EInt64(10UL, 6L) - ), - ST.EInfix( - 8UL, - ST.InfixFnCall(ST.ArithmeticPlus), - ST.EInt64(9UL, 6L), - ST.EInt64(10UL, 6L) - )) ] +// let testPipesToRuntimeTypes = +// testTask "pipes to runtime types" { +// let parsed = p "value.age |> (-) 2L |> (+) value.age |> (<) 3L" +// let! actual = Ply.map PT2RT.Expr.toRT parsed |> Ply.toTask + +// let expected = +// S.eFn +// "int64LessThan" +// 0 +// [] +// [ S.eFn +// "int64Add" +// 0 +// [] +// [ S.eFn +// "int64Subtract" +// 0 +// [] +// [ S.eFieldAccess (S.eVar "value") "age"; S.eInt64 2 ] +// S.eFieldAccess (S.eVar "value") "age" ] +// S.eInt64 3 ] + +// return Expect.equalExprIgnoringIDs actual expected +// } + +// let testProgramTypesToRuntimeTypes = +// let u = PT.EUnit 8UL +// let ru = RT.EUnit 8UL + +// testMany +// "program types to runtime types" +// PT2RT.Expr.toRT +// [ PT.EFloat(7UL, Positive, "", "0"), RT.EFloat(7UL, 0.0) +// PT.EFloat(7UL, Positive, "0", ""), RT.EFloat(7UL, 0.0) +// PT.EFloat(7UL, Positive, "", ""), RT.EFloat(7UL, 0.0) +// (PT.EMatch( +// 9UL, +// u, +// [ { pat = PT.MPFloat(5UL, Positive, "", ""); whenCondition = None; rhs = u } ] +// ), +// RT.EMatch( +// 9UL, +// ru, +// NEList.singleton +// { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } +// )) +// (PT.EMatch( +// 9UL, +// u, +// [ { pat = PT.MPFloat(5UL, Positive, "0", ""); whenCondition = None; rhs = u } ] +// ), +// RT.EMatch( +// 9UL, +// ru, +// NEList.singleton +// { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } +// )) +// (PT.EMatch( +// 9UL, +// u, +// [ { pat = PT.MPFloat(5UL, Positive, "", "0"); whenCondition = None; rhs = u } ] +// ), +// RT.EMatch( +// 9UL, +// ru, +// NEList.singleton +// { pat = RT.MPFloat(5UL, 0.0); whenCondition = None; rhs = ru } +// )) +// (PT.EMatch( +// 9UL, +// u, +// [ { pat = PT.MPFloat(5UL, Positive, "0", "0") +// whenCondition = Some u +// rhs = u } ] +// ), +// RT.EMatch( +// 9UL, +// ru, +// NEList.singleton +// { pat = RT.MPFloat(5UL, 0.0); whenCondition = Some ru; rhs = ru } +// )) ] + +// let testInfixProgramTypesToSerializedTypes = +// testMany +// "infix program types to serialized types" +// PT2ST.Expr.toST +// [ (PT.EInfix( +// 8UL, +// PT.InfixFnCall(PT.ArithmeticPlus), +// PT.EInt64(9UL, 6L), +// PT.EInt64(10UL, 6L) +// ), +// ST.EInfix( +// 8UL, +// ST.InfixFnCall(ST.ArithmeticPlus), +// ST.EInt64(9UL, 6L), +// ST.EInt64(10UL, 6L) +// )) ] let tests = testList "ProgramTypes" - [ testPipesToRuntimeTypes - testProgramTypesToRuntimeTypes + [ //testPipesToRuntimeTypes + //testProgramTypesToRuntimeTypes ptFQFnName - testInfixProgramTypesToSerializedTypes ] + //testInfixProgramTypesToSerializedTypes + ] diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 07b7be65e6..7230634f1f 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -8,66 +8,72 @@ open System.Threading.Tasks open Prelude module PT = LibExecution.ProgramTypes -module Telemetry = LibService.Telemetry - -module CTPusher = LibClientTypes.Pusher +//module Telemetry = LibService.Telemetry let initSerializers () = - BwdServer.Server.initSerializers () + //BwdServer.Server.initSerializers () // These are serializers used in the tests that are not used in the main program Json.Vanilla.allow> "tests" Json.Vanilla.allow "testTraceData" - Json.Vanilla.allow "Canvas.loadJsonFromDisk" - Json.Vanilla.allow "Canvas.loadJsonFromDisk" + // Json.Vanilla.allow "Canvas.loadJsonFromDisk" + // Json.Vanilla.allow "Canvas.loadJsonFromDisk" Json.Vanilla.allow "Canvas.loadJsonFromDisk" [] let main (args : string array) : int = try - let name = "Tests" - LibService.Init.init name - (LibCloud.Init.init LibCloud.Init.WaitForDB name).Result - (LibCloudExecution.Init.init name).Result + //let name = "Tests" + // LibService.Init.init name + // (LibCloud.Init.init LibCloud.Init.WaitForDB name).Result + //(LibCloudExecution.Init.init name).Result initSerializers () let tests = - [ Tests.AnalysisTypes.tests - Tests.BwdServer.tests - Tests.Canvas.tests - Tests.Cron.tests - Tests.DvalRepr.tests - Tests.QueueSchedulingRules.tests - // TODO: bring back Tests.Queue.tests - // TRACINGTODO - // Tests.Execution.tests - Tests.LibParser.tests - Tests.NewParser.tests - Tests.HttpClient.tests - Tests.LibExecution.tests.Force() + [ // core Tests.Prelude.tests Tests.ProgramTypes.tests - Tests.Routing.tests - Tests.RuntimeTypes.tests - Tests.BinarySerialization.tests - Tests.VanillaSerialization.tests - Tests.DarkTypesSerialization.tests - Tests.SqlCompiler.tests + //Tests.AnalysisTypes.tests Tests.TreeSitter.tests - Tests.Builtin.tests - Tests.PackageManager.tests - Tests.StorageTraces.tests ] + + // Tests.DvalRepr.tests + // Tests.PackageManager.tests + + // cloud + + // Tests.BwdServer.tests + // Tests.Canvas.tests + // Tests.Cron.tests + // Tests.QueueSchedulingRules.tests + // TODO: bring back Tests.Queue.tests + // TRACINGTODO + // Tests.Execution.tests + // Tests.LibParser.tests + // Tests.NewParser.tests + // Tests.HttpClient.tests + // Tests.Routing.tests + // Tests.RuntimeTypes.tests + // Tests.BinarySerialization.tests + // Tests.VanillaSerialization.tests + // Tests.DarkTypesSerialization.tests + // Tests.SqlCompiler.tests + // Tests.Builtin.tests + // Tests.StorageTraces.tests + + // cross-cutting + // Tests.LibExecution.tests.Force() + ] let cancelationTokenSource = new System.Threading.CancellationTokenSource() - let bwdServerTestsTask = Tests.BwdServer.init cancelationTokenSource.Token - let httpClientTestsTask = Tests.HttpClient.init cancelationTokenSource.Token - Telemetry.Console.loadTelemetry "tests" Telemetry.TraceDBQueries + // let bwdServerTestsTask = Tests.BwdServer.init cancelationTokenSource.Token + // let httpClientTestsTask = Tests.HttpClient.init cancelationTokenSource.Token + //Telemetry.Console.loadTelemetry "tests" Telemetry.TraceDBQueries - // Generate this so that we can see if the format has changed in a git diff - BinarySerialization.generateTestFiles () - VanillaSerialization.PersistedSerializations.generateTestFiles () + // // Generate this so that we can see if the format has changed in a git diff + // BinarySerialization.generateTestFiles () + // VanillaSerialization.PersistedSerializations.generateTestFiles () // this does async stuff within it, so do not run it from a task/async // context or it may hang @@ -76,9 +82,9 @@ let main (args : string array) : int = NonBlockingConsole.wait () // flush stdout cancelationTokenSource.Cancel() - bwdServerTestsTask.Wait() - httpClientTestsTask.Wait() - QueueWorker.shouldShutdown <- true + // bwdServerTestsTask.Wait() + // httpClientTestsTask.Wait() + // QueueWorker.shouldShutdown <- true exitCode with e -> printException "Outer exception" [] e diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index b75d5b7e34..04beb48348 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -10,49 +10,57 @@ false + - + - - - - - - - - - + + + + + + + + + + + + + - - - - - - - - - - - - - - + + + - - - - - - - - - + - + + + + + + + + + + + + + + + + + + + + + + + diff --git a/scripts/build/compile b/scripts/build/compile index 2e85b43eb7..7b176e471f 100755 --- a/scripts/build/compile +++ b/scripts/build/compile @@ -14,7 +14,7 @@ optimize = in_ci fsharp_thing_to_build = "fsdark.sln" # sometimes it's handy to only build a specific project -#fsharp_thing_to_build = "src/LibExecution" +fsharp_thing_to_build = "tests/Tests" # Make io unbuffered def flush(fn): @@ -74,19 +74,19 @@ def is_script(f): return "Bourne-Again" in filetype -def copy_dark_wasm(): - start = time.time() - if optimize: - dark_wasm = run_backend( - start, - "rsync -a backend/Build/out/Wasm/Release/net8.0/publish/wwwroot/_framework/ backend/static/dark_wasm/" - ) - else: - dark_wasm = run_backend( - start, - "rsync -a backend/Build/out/Wasm/Debug/net8.0/wwwroot/_framework/ backend/static/dark_wasm/" - ) - return dark_wasm +# def copy_dark_wasm(): +# start = time.time() +# if optimize: +# dark_wasm = run_backend( +# start, +# "rsync -a backend/Build/out/Wasm/Release/net8.0/publish/wwwroot/_framework/ backend/static/dark_wasm/" +# ) +# else: +# dark_wasm = run_backend( +# start, +# "rsync -a backend/Build/out/Wasm/Debug/net8.0/wwwroot/_framework/ backend/static/dark_wasm/" +# ) +# return dark_wasm def shellcheck(f): @@ -254,12 +254,11 @@ def reload_all_packages(): class Should: - def __init__(self): self.fsharp_tool_restore = False self.fsharp_paket_restore = False self.fsharp_paket_install = False - self.copy_dark_wasm = False + #self.copy_dark_wasm = False TODO self.backend_quick_build = False self.backend_full_build = False self.backend_test = False @@ -277,10 +276,12 @@ class Should: def execute(should): success = True + # parser if should.build_parser: if not build_parser(): success = False - # Fast path: get the important stuff built first + + # backend dependencies if should.fsharp_tool_restore: if not fsharp_tool_restore(): success = False should.fsharp_paket_restore |= success @@ -294,55 +295,60 @@ def execute(should): if not fsharp_paket_install(): success = False should.backend_full_build |= success + # backend if should.backend_full_build: should.backend_quick_build = False # no need to do both if not backend_full_build(): success = False - should.copy_dark_wasm |= success + #should.copy_dark_wasm |= success should.backend_test |= success should.clear_local_db |= success should.reload_backend_server |= success should.reload_all_packages |= success - if should.circleci_validate: - if not circleci_validate(): success = False - if should.backend_quick_build: if not backend_quick_build(): success = False - should.copy_dark_wasm |= success + #should.copy_dark_wasm |= success should.backend_test |= success should.reload_backend_server |= success should.reload_all_packages |= success - if should.copy_dark_wasm: - if not copy_dark_wasm(): success = False + # if should.copy_dark_wasm: + # if not copy_dark_wasm(): success = False - if should.reload_backend_server: - if not reload_backend_server(): success = False + # if should.reload_backend_server: + # if not reload_backend_server(): success = False + + # if should.clear_local_db: + # if not clear_local_db(): success = False + # should.run_migrations |= success + # should.reload_all_packages |= success + + # if should.run_migrations: + # if not run_migrations(): success = False + + # if should.reload_all_packages: + # if not reload_all_packages(): success = False + + # if should.backend_test: + # if not backend_test(): success = False - if should.clear_local_db: - if not clear_local_db(): success = False - should.run_migrations |= success - should.reload_all_packages |= success - if should.run_migrations: - if not run_migrations(): success = False - if should.reload_all_packages: - if not reload_all_packages(): success = False + # # misc validations and formatting checkers + # if should.circleci_validate: + # if not circleci_validate(): success = False - if should.backend_test: - if not backend_test(): success = False + # if should.shellcheck != []: + # all_files = " ".join(should.shellcheck) + # if not shellcheck(all_files): success = False - if should.shellcheck != []: - all_files = " ".join(should.shellcheck) - if not shellcheck(all_files): success = False + # if should.yamllint: + # if not all([yamllint(f) for f in should.yamllint]): + # success = False - if should.yamllint: - if not all([yamllint(f) for f in should.yamllint]): - success = False + # if should.terraform_validate: + # if not terraform_validate(): success = False - if should.terraform_validate: - if not terraform_validate(): success = False return success diff --git a/scripts/run-backend-tests b/scripts/run-backend-tests index 48ec0c457d..79d49dbb17 100755 --- a/scripts/run-backend-tests +++ b/scripts/run-backend-tests @@ -34,10 +34,10 @@ killall -9 Tests || true if [[ "$PUBLISHED" == "true" ]]; then EXE=Build/out/Tests/Release/net8.0/linux-x64/Tests - PRODEXEC=Build/out/ProdExec/Release/net8.0/linux-x64/ProdExec + # PRODEXEC=Build/out/ProdExec/Release/net8.0/linux-x64/ProdExec else EXE=Build/out/Tests/Debug/net8.0/Tests - PRODEXEC=Build/out/ProdExec/Debug/net8.0/ProdExec + # PRODEXEC=Build/out/ProdExec/Debug/net8.0/ProdExec fi case "$DB" in @@ -68,8 +68,8 @@ esac LOGS="${DARK_CONFIG_RUNDIR}/logs" -./scripts/run-pubsub-emulator -./scripts/run-cloud-storage-emulator +# ./scripts/run-pubsub-emulator +# ./scripts/run-cloud-storage-emulator # Use random to avoid old items being in the pubsub queue. Use this instead of # $RANDOM as RANDOM is only 5 digits @@ -78,27 +78,27 @@ RANDOM_VALUE=$(cat /proc/sys/kernel/random/uuid) grey="\033[1;30m" reset="\033[0m" -# Run the migrations before the other servers start -echo -e "Running migrations ${grey}($LOGS/test-migrations.log)${reset}" -cd backend && \ - DARK_CONFIG_TELEMETRY_EXPORTER=none \ - DARK_CONFIG_ROLLBAR_ENABLED=n \ - DARK_CONFIG_QUEUE_PUBSUB_PROJECT_ID=pubsub-test-${RANDOM_VALUE} \ - DARK_CONFIG_TRACE_STORAGE_BUCKET_NAME=trace-test-${RANDOM_VALUE} \ - "${PRODEXEC}" migrations run > "$LOGS/test-migrations.log" 2>&1 -cd .. +# # Run the migrations before the other servers start +# echo -e "Running migrations ${grey}($LOGS/test-migrations.log)${reset}" +# cd backend && \ +# DARK_CONFIG_TELEMETRY_EXPORTER=none \ +# DARK_CONFIG_ROLLBAR_ENABLED=n \ +# DARK_CONFIG_QUEUE_PUBSUB_PROJECT_ID=pubsub-test-${RANDOM_VALUE} \ +# DARK_CONFIG_TRACE_STORAGE_BUCKET_NAME=trace-test-${RANDOM_VALUE} \ +# "${PRODEXEC}" migrations run > "$LOGS/test-migrations.log" 2>&1 +# cd .. # Reload packages -if [[ -v CI ]]; then - echo "Running backend server" - ./scripts/run-backend-server $PUBLISHED_FLAG - echo "Reloading packages" - ./scripts/build/reload-packages $PUBLISHED_FLAG -else - echo "Reloading packages" - ./scripts/build/reload-packages --test $PUBLISHED_FLAG -fi +# if [[ -v CI ]]; then +# echo "Running backend server" +# ./scripts/run-backend-server $PUBLISHED_FLAG +# echo "Reloading packages" +# ./scripts/build/reload-packages $PUBLISHED_FLAG +# else +# echo "Reloading packages" +# ./scripts/build/reload-packages --test $PUBLISHED_FLAG +# fi JUNIT_FILE="${DARK_CONFIG_RUNDIR}/test_results/backend.xml" From ac475b3bf083cb97553988bda222d9cfc43e384e Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 19 Jul 2024 21:28:05 -0400 Subject: [PATCH 02/60] Delete (unused) ProgramTypesAst.fs --- backend/src/LibExecution/LibExecution.fsproj | 1 - backend/src/LibExecution/ProgramTypesAst.fs | 311 ------------------- 2 files changed, 312 deletions(-) delete mode 100644 backend/src/LibExecution/ProgramTypesAst.fs diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index 24e14b865e..1ba0c1813b 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -30,7 +30,6 @@ - diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs deleted file mode 100644 index 9f6c25953f..0000000000 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ /dev/null @@ -1,311 +0,0 @@ -module LibExecution.ProgramTypesAst - -open System.Threading.Tasks -open FSharp.Control.Tasks - -open Prelude -open ProgramTypes - -// Traverse is really only meant to be used by preTraversal and postTraversal -let traverse (f : Expr -> Expr) (expr : Expr) : Expr = - - let traversePipeExpr (expr : PipeExpr) : PipeExpr = - match expr with - | EPipeFnCall(id, name, typeArgs, args) -> - EPipeFnCall(id, name, typeArgs, List.map f args) - | EPipeInfix(id, name, first) -> EPipeInfix(id, name, f first) - | EPipeLambda(id, vars, body) -> EPipeLambda(id, vars, f body) - | EPipeEnum(id, typeName, caseName, fields) -> - EPipeEnum(id, typeName, caseName, List.map f fields) - | EPipeVariable(id, name, exprs) -> EPipeVariable(id, name, List.map f exprs) - - match expr with - | EInt64 _ - | EUInt64 _ - | EInt8 _ - | EUInt8 _ - | EInt16 _ - | EUInt16 _ - | EInt32 _ - | EUInt32 _ - | EInt128 _ - | EUInt128 _ - | EBool _ - | EChar _ - | EUnit _ - | EVariable _ - | EConstant _ - | EFloat _ -> expr - | ELet(id, pat, rhs, next) -> ELet(id, pat, f rhs, f next) - | EString(id, strs) -> - EString( - id, - strs - |> List.map (fun s -> - match s with - | StringText t -> StringText t - | StringInterpolation e -> StringInterpolation(f e)) - ) - | EIf(id, cond, ifexpr, elseexpr) -> - EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | EFieldAccess(id, expr, fieldname) -> EFieldAccess(id, f expr, fieldname) - | EInfix(id, op, left, right) -> EInfix(id, op, f left, f right) - | EPipe(id, expr1, exprs) -> EPipe(id, f expr1, List.map traversePipeExpr exprs) - | EApply(id, fn, typeArgs, exprs) -> EApply(id, f fn, typeArgs, NEList.map f exprs) - | ELambda(id, names, expr) -> ELambda(id, names, f expr) - | EList(id, exprs) -> EList(id, List.map f exprs) - | EDict(id, pairs) -> EDict(id, List.map (fun (k, v) -> (k, f v)) pairs) - | ETuple(id, first, second, theRest) -> - ETuple(id, f first, f second, List.map f theRest) - | EMatch(id, mexpr, cases) -> - EMatch( - id, - f mexpr, - List.map - (fun case -> - { pat = case.pat - whenCondition = Option.map f case.whenCondition - rhs = f case.rhs }) - cases - ) - | ERecord(id, typeName, fields) -> - ERecord(id, typeName, List.map (fun (name, expr) -> (name, f expr)) fields) - | ERecordUpdate(id, record, updates) -> - ERecordUpdate( - id, - f record, - NEList.map (fun (name, expr) -> (name, f expr)) updates - ) - | EEnum(id, typeName, caseName, fields) -> - EEnum(id, typeName, caseName, List.map f fields) - | EFnName(id, name) -> EFnName(id, name) - -let rec preTraversal - (exprFn : Expr -> Expr) - (exprPipeFn : PipeExpr -> PipeExpr) - (typeRefFn : TypeReference -> TypeReference) - (fqtnFn : FQTypeName.FQTypeName -> FQTypeName.FQTypeName) - (fqfnFn : FQFnName.FQFnName -> FQFnName.FQFnName) - (fqctFn : FQConstantName.FQConstantName -> FQConstantName.FQConstantName) - (letPatternFn : LetPattern -> LetPattern) - (matchPatternFn : MatchPattern -> MatchPattern) - (expr : Expr) - : Expr = - - let rec preTraversalLetPattern (pat : LetPattern) : LetPattern = - let f = preTraversalLetPattern - match letPatternFn pat with - | LPVariable _ - | LPUnit _ -> letPatternFn pat - | LPTuple(id, p1, p2, pats) -> LPTuple(id, f p1, f p2, List.map f pats) - - let rec preTraverseMatchPattern (pat : MatchPattern) : MatchPattern = - let f = preTraverseMatchPattern - match matchPatternFn pat with - | MPVariable _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPChar _ - | MPFloat _ - | MPUnit _ -> pat - | MPList(id, pats) -> MPList(id, List.map f pats) - | MPTuple(id, p1, p2, pats) -> MPTuple(id, f p1, f p2, List.map f pats) - | MPEnum(id, name, pats) -> MPEnum(id, name, List.map f pats) - | MPListCons(id, head, tail) -> MPListCons(id, f head, f tail) - - let rec preTraversalTypeRef (typeRef : TypeReference) : TypeReference = - let f = preTraversalTypeRef - match typeRefFn typeRef with - | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TBool - | TUnit - | TFloat - | TChar - | TUuid - | TDateTime - | TVariable _ - | TString -> typeRef - | TList tr -> TList(f tr) - | TTuple(tr1, tr2, trs) -> TTuple(f tr1, f tr2, List.map f trs) - | TDB tr -> TDB(f tr) - | TCustomType(name, trs) -> TCustomType(Result.map fqtnFn name, List.map f trs) - | TDict(tr) -> TDict(f tr) - | TFn(trs, tr) -> TFn(NEList.map f trs, f tr) - - let f = - preTraversal - exprFn - exprPipeFn - typeRefFn - fqtnFn - fqfnFn - fqctFn - letPatternFn - matchPatternFn - - let rec preTraversalPipeExpr (expr : PipeExpr) : PipeExpr = - match exprPipeFn expr with - | EPipeFnCall(id, name, typeArgs, args) -> - EPipeFnCall( - id, - Result.map fqfnFn name, - List.map preTraversalTypeRef typeArgs, - List.map f args - ) - | EPipeInfix(id, name, first) -> EPipeInfix(id, name, f first) - | EPipeLambda(id, vars, body) -> EPipeLambda(id, vars, f body) - | EPipeEnum(id, typeName, caseName, fields) -> - EPipeEnum(id, typeName, caseName, List.map f fields) - | EPipeVariable(id, name, exprs) -> EPipeVariable(id, name, List.map f exprs) - - match exprFn expr with - | EInt64 _ - | EUInt64 _ - | EInt8 _ - | EUInt8 _ - | EInt16 _ - | EUInt16 _ - | EInt32 _ - | EUInt32 _ - | EInt128 _ - | EUInt128 _ - | EBool _ - | EChar _ - | EUnit _ - | EConstant _ - | EVariable _ - | EFloat _ -> expr - | EString(id, strs) -> - EString( - id, - strs - |> List.map (fun s -> - match s with - | StringText t -> StringText t - | StringInterpolation e -> StringInterpolation(f e)) - ) - | ELet(id, pat, rhs, next) -> ELet(id, preTraversalLetPattern pat, f rhs, f next) - | EIf(id, cond, ifexpr, elseexpr) -> - EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | EFieldAccess(id, expr, fieldname) -> EFieldAccess(id, f expr, fieldname) - | EInfix(id, op, left, right) -> EInfix(id, op, f left, f right) - | EPipe(id, expr1, exprs) -> - EPipe(id, f expr1, List.map preTraversalPipeExpr exprs) - | EApply(id, fn, typeArgs, args) -> - EApply(id, f fn, List.map preTraversalTypeRef typeArgs, NEList.map f args) - | ELambda(id, names, expr) -> ELambda(id, names, f expr) - | EList(id, exprs) -> EList(id, List.map f exprs) - | EDict(id, pairs) -> EDict(id, List.map (fun (k, v) -> (k, f v)) pairs) - | ETuple(id, first, second, theRest) -> - ETuple(id, f first, f second, List.map f theRest) - | EEnum(id, typeName, caseName, fields) -> - EEnum(id, Result.map fqtnFn typeName, caseName, List.map f fields) - | EMatch(id, mexpr, cases) -> - EMatch( - id, - f mexpr, - List.map - (fun case -> - { pat = preTraverseMatchPattern case.pat - whenCondition = Option.map f case.whenCondition - rhs = f case.rhs }) - cases - ) - | ERecord(id, typeName, fields) -> - ERecord( - id, - Result.map fqtnFn typeName, - List.map (fun (name, expr) -> (name, f expr)) fields - ) - | ERecordUpdate(id, record, updates) -> - ERecordUpdate( - id, - f record, - NEList.map (fun (name, expr) -> (name, f expr)) updates - ) - | EFnName(id, name) -> EFnName(id, Result.map fqfnFn name) - -let rec postTraversal (f : Expr -> Expr) (expr : Expr) : Expr = - let r = postTraversal f in - let result = traverse r expr - f result - -let rec matchPatternPreTraversal - (f : MatchPattern -> MatchPattern) - (pattern : MatchPattern) - : MatchPattern = - let r = matchPatternPreTraversal f in - let pattern = f pattern in - match pattern with - | MPVariable _ - | MPChar _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPUnit _ - | MPFloat _ -> pattern - | MPEnum(patternID, caseName, fieldPats) -> - MPEnum(patternID, caseName, List.map (fun p -> r p) fieldPats) - | MPTuple(patternID, first, second, theRest) -> - MPTuple(patternID, r first, r second, List.map r theRest) - | MPList(patternID, pats) -> MPList(patternID, List.map r pats) - | MPListCons(patternID, head, tail) -> MPListCons(patternID, r head, r tail) - -let rec matchPatternPostTraversal - (f : MatchPattern -> MatchPattern) - (pattern : MatchPattern) - : MatchPattern = - let r = matchPatternPostTraversal f in - let result = - match pattern with - | MPVariable _ - | MPChar _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPUnit _ - | MPFloat _ -> pattern - | MPEnum(patternID, caseName, fieldPats) -> - MPEnum(patternID, caseName, List.map r fieldPats) - | MPTuple(patternID, first, second, theRest) -> - MPTuple(patternID, r first, r second, List.map r theRest) - | MPList(patternID, pats) -> MPList(patternID, List.map r pats) - | MPListCons(patternID, head, tail) -> MPListCons(patternID, r head, r tail) - f result From 1295b47395adae0b73d0f22466e6f0463fd03655 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 24 Jul 2024 23:36:46 -0400 Subject: [PATCH 03/60] Rewrite basics of new (bytecode) interpreter --- Dockerfile | 16 +- backend/fsdark.sln | 15 +- backend/src/BuiltinExecution/Builtin.fs | 7 +- .../BuiltinExecution/BuiltinExecution.fsproj | 4 +- backend/src/BuiltinExecution/Libs/Int64.fs | 850 ++++++------ backend/src/LibExecution/Builtin.fs | 3 +- backend/src/LibExecution/DvalReprDeveloper.fs | 84 +- backend/src/LibExecution/Execution.fs | 14 +- backend/src/LibExecution/Interpreter copy.fs | 1101 ++++++++++++++++ backend/src/LibExecution/Interpreter.fs | 1171 +++-------------- .../src/LibExecution/NameResolutionError.fs | 8 +- backend/src/LibExecution/ProgramTypes.fs | 209 +-- .../ProgramTypesToRuntimeTypes.fs | 562 ++++---- backend/src/LibExecution/RuntimeTypes.fs | 394 +++--- backend/src/LibExecution/TypeChecker.fs | 140 +- backend/tests/TestUtils/LibTest.fs | 458 +++---- backend/tests/TestUtils/RTShortcuts.fs | 70 +- backend/tests/TestUtils/TestUtils.fs | 442 +++---- backend/tests/Tests/Interpreter.Tests.fs | 58 + backend/tests/Tests/PT2RT.Tests.fs | 150 +++ backend/tests/Tests/Tests.fs | 4 +- backend/tests/Tests/Tests.fsproj | 8 +- scripts/build/build-parser | 8 +- scripts/build/build-tree-sitter.sh | 1 + .../devcontainer/_vscode-post-start-command | 4 +- 25 files changed, 3219 insertions(+), 2562 deletions(-) create mode 100644 backend/src/LibExecution/Interpreter copy.fs create mode 100644 backend/tests/Tests/Interpreter.Tests.fs create mode 100644 backend/tests/Tests/PT2RT.Tests.fs diff --git a/Dockerfile b/Dockerfile index b8da9d8a71..38baee18bb 100644 --- a/Dockerfile +++ b/Dockerfile @@ -335,14 +335,14 @@ ENV NUGET_SCRATCH=/tmp/NuGetScratch # Emscripten, # for compiling the tree-sitter parser to wasm ############# -RUN git clone https://github.com/emscripten-core/emsdk.git --depth 1 \ - && cd emsdk \ - # TODO pin to a recent stable version (i.e. 3.1.37) - # we are using the latest version because Linux arm64 binaries aren't available in all releases. - # see: https://github.com/emscripten-core/emscripten/issues/19275 - && ./emsdk install latest \ - && ./emsdk activate latest -ENV PATH="$PATH:/home/dark/emsdk/upstream/emscripten" +# RUN git clone https://github.com/emscripten-core/emsdk.git --depth 1 \ +# && cd emsdk \ +# # TODO pin to a recent stable version (i.e. 3.1.37) +# # we are using the latest version because Linux arm64 binaries aren't available in all releases. +# # see: https://github.com/emscripten-core/emscripten/issues/19275 +# && ./emsdk install latest \ +# && ./emsdk activate latest +# ENV PATH="$PATH:/home/dark/emsdk/upstream/emscripten" ############# diff --git a/backend/fsdark.sln b/backend/fsdark.sln index d42876e12b..f89105d8df 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -27,8 +27,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExec EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" #EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" -EndProject +#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" +#EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinExecution", "src\BuiltinExecution\BuiltinExecution.fsproj", "{BBFC824F-A0DE-4A28-B82F-49C04EBA7475}" EndProject @@ -185,20 +185,18 @@ Global #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.Build.0 = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU - {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.Build.0 = Release|Any CPU + #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU + #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU + #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection - # Notes of what projects being in which folders GlobalSection(NestedProjects) = preSolution {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} {625B113A-D5DC-40A5-B833-4BA342AB4936} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{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} @@ -216,7 +214,6 @@ Global #{B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - {DB61305F-4CA9-4D92-82A5-503495F515E8} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} {839A1EF7-18F5-491E-B40B-2BAA57378B40} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} EndGlobalSection diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 878e22dffc..60393bd116 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -10,10 +10,7 @@ let fnRenames = // eg: fn "Http" "respond" 0, fn "Http" "response" 0 [] -let builtins - //(httpConfig : Libs.HttpClient.Configuration) - //(pm : LibExecution.ProgramTypes.PackageManager) - : Builtins = +let builtins : Builtins = Builtin.combine [ // Libs.NoModule.builtins @@ -26,7 +23,7 @@ let builtins // Libs.UInt16.builtins // Libs.Int32.builtins // Libs.UInt32.builtins - // Libs.Int64.builtins + Libs.Int64.builtins // Libs.UInt64.builtins // Libs.Int128.builtins // Libs.UInt128.builtins diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index d1dbc83327..030889865d 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -21,7 +21,7 @@ - + @@ -61,7 +61,7 @@ - + diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 01e43f46c9..454ac21325 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -12,68 +12,69 @@ open LibExecution.Builtin.Shortcuts module VT = ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +//module IntRuntimeError = BuiltinExecution.IntRuntimeError -/// Used for values which are outside the range of expected values for some -/// reason. Really, any function using this should have a Result type instead. -let argumentWasntPositive (paramName : string) (dv : Dval) : string = - let actual = LibExecution.DvalReprDeveloper.toRepr dv - $"Expected `{paramName}` to be positive, but it was `{actual}`" +// /// Used for values which are outside the range of expected values for some +// /// reason. Really, any function using this should have a Result type instead. +// let argumentWasntPositive (paramName : string) (dv : Dval) : string = +// let actual = LibExecution.DvalReprDeveloper.toRepr dv +// $"Expected `{paramName}` to be positive, but it was `{actual}`" -module ParseError = - type ParseError = - | BadFormat - | OutOfRange +// module ParseError = +// type ParseError = +// | BadFormat +// | OutOfRange - let toDT (e : ParseError) : Dval = - let (caseName, fields) = - match e with - | BadFormat -> "BadFormat", [] - | OutOfRange -> "OutOfRange", [] +// let toDT (e : ParseError) : Dval = +// let (caseName, fields) = +// match e with +// | BadFormat -> "BadFormat", [] +// | OutOfRange -> "OutOfRange", [] - let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError - DEnum(typeName, typeName, [], caseName, fields) +// let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError +// DEnum(typeName, typeName, [], caseName, fields) let fns : List = - [ { name = fn "int64Mod" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TInt64 - description = - "Returns the result of wrapping around so that {{0 <= res < b}}. + [ + // { name = fn "int64Mod" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TInt64 + // description = + // "Returns the result of wrapping around so that {{0 <= res < b}}. - The modulus must be greater than 0. + // The modulus must be greater than 0. - Use if you want the remainder after division, which has - a different behavior for negative numbers." - fn = - (function - | state, _, [ DInt64 v; DInt64 m ] -> - if m = 0L then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - else if m < 0L then - IntRuntimeError.Error.NegativeModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - else - let result = v % m - let result = if result < 0L then m + result else result - Ply(DInt64(result)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "%" - previewable = Pure - // TODO: Deprecate this when we can version infix operators - // and when infix operators support Result return types - // (https://github.com/darklang/dark/issues/4267) - // The current function returns an RTE (it used to rollbar) on negative `b`. - deprecated = NotDeprecated } + // Use if you want the remainder after division, which has + // a different behavior for negative numbers." + // fn = + // (function + // | state, _, [ DInt64 v; DInt64 m ] -> + // if m = 0L then + // IntRuntimeError.Error.ZeroModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else if m < 0L then + // IntRuntimeError.Error.NegativeModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + // let result = v % m + // let result = if result < 0L then m + result else result + // Ply(DInt64(result)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "%" + // previewable = Pure + // // TODO: Deprecate this when we can version infix operators + // // and when infix operators support Result return types + // // (https://github.com/darklang/dark/issues/4267) + // // The current function returns an RTE (it used to rollbar) on negative `b`. + // deprecated = NotDeprecated } // See above for when to uncomment this @@ -111,41 +112,41 @@ let fns : List = // deprecated = NotDeprecated } - { name = fn "int64Remainder" 0 - typeParams = [] - parameters = [ Param.make "value" TInt64 ""; Param.make "divisor" TInt64 "" ] - returnType = TypeReference.result TInt64 TString - description = - "Returns the integer remainder left over after dividing by - , as a . + // { name = fn "int64Remainder" 0 + // typeParams = [] + // parameters = [ Param.make "value" TInt64 ""; Param.make "divisor" TInt64 "" ] + // returnType = TypeReference.result TInt64 TString + // description = + // "Returns the integer remainder left over after dividing by + // , as a . - For example, {{Int64.remainder 15 6 == Ok 3}}. The remainder will be - negative only if {{ < 0}}. + // For example, {{Int64.remainder 15 6 == Ok 3}}. The remainder will be + // negative only if {{ < 0}}. - The sign of doesn't influence the outcome. + // The sign of doesn't influence the outcome. - Returns an {{Error}} if is {{0}}." - fn = - let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply - (function - | state, _, [ DInt64 v; DInt64 d ] -> - (try - v % d |> DInt64 |> resultOk - with e -> - if d = 0L then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - else - Exception.raiseInternal - "unexpected failure case in Int64.remainder" - [ "v", v; "d", d ] - e) - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // Returns an {{Error}} if is {{0}}." + // fn = + // let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply + // (function + // | state, _, [ DInt64 v; DInt64 d ] -> + // (try + // v % d |> DInt64 |> resultOk + // with e -> + // if d = 0L then + // IntRuntimeError.Error.DivideByZeroError + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + // Exception.raiseInternal + // "unexpected failure case in Int64.remainder" + // [ "v", v; "d", d ] + // e) + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "int64Add" 0 @@ -157,396 +158,397 @@ let fns : List = (function | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a + b)) | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "+" + //sqlSpec = SqlBinOp "+" previewable = Pure deprecated = NotDeprecated } - { name = fn "int64Subtract" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TInt64 - description = "Subtracts two integers" - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a - b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "-" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Subtract" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TInt64 + // description = "Subtracts two integers" + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a - b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "-" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Multiply" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TInt64 - description = "Multiplies two integers" - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a * b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "*" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Multiply" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TInt64 + // description = "Multiplies two integers" + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a * b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "*" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Power" 0 - typeParams = [] - parameters = [ Param.make "base" TInt64 ""; Param.make "exponent" TInt64 "" ] - returnType = TInt64 - description = - "Raise to the power of . - must to be positive. - Return value wrapped in a {{Result}} " - fn = - (function - | state, _, [ DInt64 number; DInt64 exp ] -> - (try - if exp < 0L then - IntRuntimeError.Error.NegativeExponent - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - else - (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply - with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "^" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Power" 0 + // typeParams = [] + // parameters = [ Param.make "base" TInt64 ""; Param.make "exponent" TInt64 "" ] + // returnType = TInt64 + // description = + // "Raise to the power of . + // must to be positive. + // Return value wrapped in a {{Result}} " + // fn = + // (function + // | state, _, [ DInt64 number; DInt64 exp ] -> + // (try + // if exp < 0L then + // IntRuntimeError.Error.NegativeExponent + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + // (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply + // with :? System.OverflowException -> + // IntRuntimeError.Error.OutOfRange + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "^" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Divide" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TInt64 - description = "Divides two integers" - fn = - (function - | state, _, [ DInt64 a; DInt64 b ] -> - if b = 0L then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - else - Ply(DInt64(a / b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "/" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Divide" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TInt64 + // description = "Divides two integers" + // fn = + // (function + // | state, _, [ DInt64 a; DInt64 b ] -> + // if b = 0L then + // IntRuntimeError.Error.DivideByZeroError + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + // Ply(DInt64(a / b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "/" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Negate" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 "" ] - returnType = TInt64 - description = "Returns the negation of , {{-a}}" - fn = - (function - | _, _, [ DInt64 a ] -> Ply(DInt64(-a)) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Negate" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 "" ] + // returnType = TInt64 + // description = "Returns the negation of , {{-a}}" + // fn = + // (function + // | _, _, [ DInt64 a ] -> Ply(DInt64(-a)) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64GreaterThan" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TBool - description = "Returns {{true}} if is greater than " - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a > b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp ">" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64GreaterThan" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TBool + // description = "Returns {{true}} if is greater than " + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a > b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp ">" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64GreaterThanOrEqualTo" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TBool - description = - "Returns {{true}} if is greater than or equal to " - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a >= b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp ">=" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64GreaterThanOrEqualTo" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TBool + // description = + // "Returns {{true}} if is greater than or equal to " + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a >= b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp ">=" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64LessThan" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TBool - description = "Returns {{true}} if is less than " - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a < b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "<" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64LessThan" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TBool + // description = "Returns {{true}} if is less than " + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a < b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "<" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64LessThanOrEqualTo" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - returnType = TBool - description = - "Returns {{true}} if is less than or equal to " - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a <= b)) - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "<=" - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64LessThanOrEqualTo" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + // returnType = TBool + // description = + // "Returns {{true}} if is less than or equal to " + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a <= b)) + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "<=" + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Random" 0 - typeParams = [] - parameters = [ Param.make "start" TInt64 ""; Param.make "end" TInt64 "" ] - returnType = TInt64 - description = - "Returns a random integer between and (inclusive)" - fn = - (function - | _, _, [ DInt64 a; DInt64 b ] -> - let lower, upper = if a > b then (b, a) else (a, b) + // { name = fn "int64Random" 0 + // typeParams = [] + // parameters = [ Param.make "start" TInt64 ""; Param.make "end" TInt64 "" ] + // returnType = TInt64 + // description = + // "Returns a random integer between and (inclusive)" + // fn = + // (function + // | _, _, [ DInt64 a; DInt64 b ] -> + // let lower, upper = if a > b then (b, a) else (a, b) - // .NET's "nextInt64" is exclusive, - // but we'd rather an inclusive version of this function - let correction : int64 = 1 + // // .NET's "nextInt64" is exclusive, + // // but we'd rather an inclusive version of this function + // let correction : int64 = 1 - lower + randomSeeded().NextInt64(upper - lower + correction) - |> DInt64 - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } + // lower + randomSeeded().NextInt64(upper - lower + correction) + // |> DInt64 + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } - { name = fn "int64Sqrt" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 "" ] - returnType = TFloat - description = "Get the square root of an " - fn = - (function - | _, _, [ DInt64 a ] -> Ply(DFloat(sqrt (float a))) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Sqrt" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 "" ] + // returnType = TFloat + // description = "Get the square root of an " + // fn = + // (function + // | _, _, [ DInt64 a ] -> Ply(DFloat(sqrt (float a))) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64ToFloat" 0 - typeParams = [] - parameters = [ Param.make "a" TInt64 "" ] - returnType = TFloat - description = "Converts an to a " - fn = - (function - | _, _, [ DInt64 a ] -> Ply(DFloat(float a)) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64ToFloat" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt64 "" ] + // returnType = TFloat + // description = "Converts an to a " + // fn = + // (function + // | _, _, [ DInt64 a ] -> Ply(DFloat(float a)) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64Parse" 0 - typeParams = [] - parameters = [ Param.make "s" TString "" ] - returnType = - let errorType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError - TypeReference.result TInt64 (TCustomType(Ok errorType, [])) - description = "Returns the value of a " - fn = - let resultOk = Dval.resultOk KTInt64 KTString - let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError - let resultError = Dval.resultError KTInt64 (KTCustomType(typeName, [])) - (function - | _, _, [ DString s ] -> - try - s |> System.Convert.ToInt64 |> DInt64 |> resultOk |> Ply - with - | :? System.FormatException -> - ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply - | :? System.OverflowException -> - ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64Parse" 0 + // typeParams = [] + // parameters = [ Param.make "s" TString "" ] + // returnType = + // let errorType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError + // TypeReference.result TInt64 (TCustomType(Ok errorType, [])) + // description = "Returns the value of a " + // fn = + // let resultOk = Dval.resultOk KTInt64 KTString + // let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError + // let resultError = Dval.resultError KTInt64 (KTCustomType(typeName, [])) + // (function + // | _, _, [ DString s ] -> + // try + // s |> System.Convert.ToInt64 |> DInt64 |> resultOk |> Ply + // with + // | :? System.FormatException -> + // ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply + // | :? System.OverflowException -> + // ParseError.OutOfRange |> ParseError.toDT |> resultError |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64ToString" 0 - typeParams = [] - parameters = [ Param.make "int" TInt64 "" ] - returnType = TString - description = "Stringify " - fn = - (function - | _, _, [ DInt64 int ] -> Ply(DString(string int)) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64ToString" 0 + // typeParams = [] + // parameters = [ Param.make "int" TInt64 "" ] + // returnType = TString + // description = "Stringify " + // fn = + // (function + // | _, _, [ DInt64 int ] -> Ply(DString(string int)) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromInt8" 0 - typeParams = [] - parameters = [ Param.make "a" TInt8 "" ] - returnType = TInt64 - description = "Converts an Int8 to a 64-bit signed integer." - fn = - (function - | _, _, [ DInt8 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromInt8" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt8 "" ] + // returnType = TInt64 + // description = "Converts an Int8 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DInt8 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromUInt8" 0 - typeParams = [] - parameters = [ Param.make "a" TUInt8 "" ] - returnType = TInt64 - description = "Converts a UInt8 to a 64-bit signed integer." - fn = - (function - | _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromUInt8" 0 + // typeParams = [] + // parameters = [ Param.make "a" TUInt8 "" ] + // returnType = TInt64 + // description = "Converts a UInt8 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromInt16" 0 - typeParams = [] - parameters = [ Param.make "a" TInt16 "" ] - returnType = TInt64 - description = "Converts an Int16 to a 64-bit signed integer." - fn = - (function - | _, _, [ DInt16 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromInt16" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt16 "" ] + // returnType = TInt64 + // description = "Converts an Int16 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DInt16 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromUInt16" 0 - typeParams = [] - parameters = [ Param.make "a" TUInt16 "" ] - returnType = TInt64 - description = "Converts a UInt16 to a 64-bit signed integer." - fn = - (function - | _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromUInt16" 0 + // typeParams = [] + // parameters = [ Param.make "a" TUInt16 "" ] + // returnType = TInt64 + // description = "Converts a UInt16 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromInt32" 0 - typeParams = [] - parameters = [ Param.make "a" TInt32 "" ] - returnType = TInt64 - description = "Converts an Int32 to a 64-bit signed integer." - fn = - (function - | _, _, [ DInt32 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromInt32" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt32 "" ] + // returnType = TInt64 + // description = "Converts an Int32 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DInt32 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromUInt32" 0 - typeParams = [] - parameters = [ Param.make "a" TUInt32 "" ] - returnType = TInt64 - description = "Converts a UInt32 to a 64-bit signed integer." - fn = - (function - | _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromUInt32" 0 + // typeParams = [] + // parameters = [ Param.make "a" TUInt32 "" ] + // returnType = TInt64 + // description = "Converts a UInt32 to a 64-bit signed integer." + // fn = + // (function + // | _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromUInt64" 0 - typeParams = [] - parameters = [ Param.make "a" TUInt64 "" ] - returnType = TypeReference.option TInt64 - description = - "Converts a UInt64 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." - fn = - (function - | _, _, [ DUInt64 a ] -> - if (a > uint64 System.Int64.MaxValue) then - Dval.optionNone KTInt64 |> Ply - else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromUInt64" 0 + // typeParams = [] + // parameters = [ Param.make "a" TUInt64 "" ] + // returnType = TypeReference.option TInt64 + // description = + // "Converts a UInt64 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." + // fn = + // (function + // | _, _, [ DUInt64 a ] -> + // if (a > uint64 System.Int64.MaxValue) then + // Dval.optionNone KTInt64 |> Ply + // else + // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromInt128" 0 - typeParams = [] - parameters = [ Param.make "a" TInt128 "" ] - returnType = TypeReference.option TInt64 - description = - "Converts an Int128 to a 64-bit signed integer. Returns {{None}} if the value is less than -9223372036854775808 or greater than 9223372036854775807." - fn = - (function - | _, _, [ DInt128 a ] -> - if - (a < System.Int128.op_Implicit System.Int64.MinValue) - || (a > System.Int128.op_Implicit System.Int64.MaxValue) - then - Dval.optionNone KTInt64 |> Ply - else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "int64FromInt128" 0 + // typeParams = [] + // parameters = [ Param.make "a" TInt128 "" ] + // returnType = TypeReference.option TInt64 + // description = + // "Converts an Int128 to a 64-bit signed integer. Returns {{None}} if the value is less than -9223372036854775808 or greater than 9223372036854775807." + // fn = + // (function + // | _, _, [ DInt128 a ] -> + // if + // (a < System.Int128.op_Implicit System.Int64.MinValue) + // || (a > System.Int128.op_Implicit System.Int64.MaxValue) + // then + // Dval.optionNone KTInt64 |> Ply + // else + // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } - { name = fn "int64FromUInt128" 0 - typeParams = [] - parameters = [ Param.make "a" TUInt128 "" ] - returnType = TypeReference.option TInt64 - description = - "Converts a UInt128 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." - fn = - (function - | _, _, [ DUInt128 a ] -> - if (a > 9223372036854775807Z) then - Dval.optionNone KTInt64 |> Ply - else - Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } ] + // { name = fn "int64FromUInt128" 0 + // typeParams = [] + // parameters = [ Param.make "a" TUInt128 "" ] + // returnType = TypeReference.option TInt64 + // description = + // "Converts a UInt128 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." + // fn = + // (function + // | _, _, [ DUInt128 a ] -> + // if (a > 9223372036854775807Z) then + // Dval.optionNone KTInt64 |> Ply + // else + // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + ] -let builtins = LibExecution.Builtin.make [] fns +let builtins = LibExecution.Builtin.make fns diff --git a/backend/src/LibExecution/Builtin.fs b/backend/src/LibExecution/Builtin.fs index b788ce7535..8f1ee37549 100644 --- a/backend/src/LibExecution/Builtin.fs +++ b/backend/src/LibExecution/Builtin.fs @@ -62,7 +62,8 @@ let combine (libs : List) (fnRenames : FnRenames) : Builtins = let make //(constants : List) - (fns : List) : Builtins = + (fns : List) + : Builtins = { //constants = constants |> Map.fromListBy _.name fns = fns |> Map.fromListBy _.name } diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index 5ed539b837..3e45bde3c6 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -28,7 +28,7 @@ let rec typeName (t : TypeReference) : string = // | TDateTime -> "DateTime" // | TUuid -> "Uuid" - // | TList nested -> $"List<{typeName nested}>" + | TList nested -> $"List<{typeName nested}>" // | TTuple(n1, n2, rest) -> // let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " // $"({nested})" @@ -36,20 +36,20 @@ let rec typeName (t : TypeReference) : string = | TFn _ -> "Function" - // | TCustomType(Error _nre, _) -> "(Error during function resolution)" - // | TCustomType(Ok t, typeArgs) -> - // let typeArgsPortion = - // match typeArgs with - // | [] -> "" - // | args -> - // args - // |> List.map (fun t -> typeName t) - // |> String.concat ", " - // |> fun betweenBrackets -> "<" + betweenBrackets + ">" - // FQTypeName.toString t + typeArgsPortion +// | TCustomType(Error _nre, _) -> "(Error during function resolution)" +// | TCustomType(Ok t, typeArgs) -> +// let typeArgsPortion = +// match typeArgs with +// | [] -> "" +// | args -> +// args +// |> List.map (fun t -> typeName t) +// |> String.concat ", " +// |> fun betweenBrackets -> "<" + betweenBrackets + ">" +// FQTypeName.toString t + typeArgsPortion - // | TDB _ -> "Datastore" - // | TVariable varname -> $"'{varname}" +// | TDB _ -> "Datastore" +// | TVariable varname -> $"'{varname}" let rec private knownTypeName (vt : KnownType) : string = @@ -77,7 +77,7 @@ let rec private knownTypeName (vt : KnownType) : string = // | KTDateTime -> "DateTime" // | KTUuid -> "Uuid" - // | KTList typ -> $"List<{valueTypeName typ}>" + | KTList typ -> $"List<{valueTypeName typ}>" // | KTDict typ -> $"Dict<{valueTypeName typ}>" // | KTDB typ -> $"Datastore<{valueTypeName typ}>" @@ -86,23 +86,23 @@ let rec private knownTypeName (vt : KnownType) : string = |> List.map valueTypeName |> String.concat " -> " - // | KTTuple(t1, t2, trest) -> - // t1 :: t2 :: trest - // |> List.map valueTypeName - // |> String.concat ", " - // |> fun s -> $"({s})" +// | KTTuple(t1, t2, trest) -> +// t1 :: t2 :: trest +// |> List.map valueTypeName +// |> String.concat ", " +// |> fun s -> $"({s})" - // | KTCustomType(name, typeArgs) -> - // let typeArgsPortion = - // match typeArgs with - // | [] -> "" - // | args -> - // args - // |> List.map (fun t -> valueTypeName t) - // |> String.concat ", " - // |> fun betweenBrackets -> "<" + betweenBrackets + ">" +// | KTCustomType(name, typeArgs) -> +// let typeArgsPortion = +// match typeArgs with +// | [] -> "" +// | args -> +// args +// |> List.map (fun t -> valueTypeName t) +// |> String.concat ", " +// |> fun betweenBrackets -> "<" + betweenBrackets + ">" - // FQTypeName.toString name + typeArgsPortion +// FQTypeName.toString name + typeArgsPortion and private valueTypeName (typ : ValueType) : string = match typ with @@ -121,13 +121,13 @@ let toTypeName (dv : Dval) : string = dv |> Dval.toValueType |> valueTypeName /// or other places a developer could rely on it (i.e. telemetry and error /// messages are OK) let toRepr (dv : Dval) : string = - let rec toRepr_ (_indent : int) (dv : Dval) : string = - // let makeSpaces len = "".PadRight(len, ' ') - // let nl = "\n" + makeSpaces indent - // let inl = "\n" + makeSpaces (indent + 2) + let rec toRepr_ (indent : int) (dv : Dval) : string = + let makeSpaces len = "".PadRight(len, ' ') + let nl = "\n" + makeSpaces indent + let inl = "\n" + makeSpaces (indent + 2) // let indent = indent + 2 - //let typename = toTypeName dv - // let wrap str = $"<{typename}: {str}>" + let typename = toTypeName dv + let wrap str = $"<{typename}: {str}>" match dv with | DUnit -> "()" @@ -164,12 +164,12 @@ let toRepr (dv : Dval) : string = // | DDB name -> wrap name // | DUuid uuid -> wrap (string uuid) - // | DList(_, l) -> - // if List.isEmpty l then - // wrap "[]" - // else - // let elems = String.concat ", " (List.map (toRepr_ indent) l) - // $"[{inl}{elems}{nl}]" + | DList(_, l) -> + if List.isEmpty l then + wrap "[]" + else + let elems = String.concat ", " (List.map (toRepr_ indent) l) + $"[{inl}{elems}{nl}]" // | DTuple(first, second, theRest) -> // let l = [ first; second ] @ theRest diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 9f3c4fff4a..81efb70d55 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -39,20 +39,21 @@ let createState packageManager = packageManager symbolTable = Map.empty - typeSymbolTable = Map.empty - } + typeSymbolTable = Map.empty } let executeExpr (state : RT.ExecutionState) (inputVars : RT.Symtable) - (expr : RT.Expr) + (instructions : RT.Instructions) + (resultReg : RT.Register) : Task = task { try try let state = - { state with symbolTable = Interpreter.withGlobals state inputVars } - let! result = Interpreter.eval state expr + //{ state with symbolTable = Interpreter.withGlobals state inputVars } + { state with symbolTable = inputVars } + let! result = Interpreter.eval state instructions resultReg return Ok result with RT.RuntimeErrorException(source, rte) -> return Error(source, rte) @@ -74,7 +75,8 @@ let executeFunction let state = { state with tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } - let! result = Interpreter.callFn state name typeArgs args + let! result = + Interpreter.call state (RT.DFnVal(RT.NamedFn name)) typeArgs args return Ok result with RT.RuntimeErrorException(source, rte) -> return Error(source, rte) diff --git a/backend/src/LibExecution/Interpreter copy.fs b/backend/src/LibExecution/Interpreter copy.fs new file mode 100644 index 0000000000..e0068e425d --- /dev/null +++ b/backend/src/LibExecution/Interpreter copy.fs @@ -0,0 +1,1101 @@ +/// Interprets Dark expressions resulting in (tasks of) Dvals +module LibExecution.Interpreter + +open System.Threading.Tasks +open FSharp.Control.Tasks +open FSharp.Control.Tasks.Affine.Unsafe + +open Prelude +open RuntimeTypes +module VT = ValueType + +/// Gathers any global data (Secrets, DBs, etc.) +/// that may be needed to evaluate an expression +let globalsFor (_state : ExecutionState) : Symtable = + let secrets = + // state.program.secrets + // |> List.map (fun (s : Secret.T) -> (s.name, DString s.value)) + // |> Map.ofList + Map.empty + + let dbs = + //Map.map (fun (db : DB.T) -> DDB db.name) state.program.dbs + Map.empty + + Map.mergeFavoringLeft secrets dbs + + +let withGlobals (state : ExecutionState) (symtable : Symtable) : Symtable = + let globals = globalsFor state + Map.mergeFavoringRight globals symtable + + +module ExecutionError = + //module RT2DT = RuntimeTypesToDarkTypes + + type Error = + // | MatchExprEnumPatternWrongCount of string * int * int + // | MatchExprPatternWrongType of string * Dval + // | MatchExprUnmatched of Dval + | NonStringInStringInterpolation of Dval + //| ConstDoesntExist of FQConstantName.FQConstantName + // | FieldAccessFieldDoesntExist of + // typeName : FQTypeName.FQTypeName * + // invalidFieldName : string + // | RecordConstructionFieldDoesntExist of + // FQTypeName.FQTypeName * + // invalidFieldName : string + // | RecordConstructionMissingField of + // FQTypeName.FQTypeName * + // missingFieldName : string + // | RecordConstructionDuplicateField of + // FQTypeName.FQTypeName * + // duplicateFieldName : string + // | FieldAccessNotRecord of ValueType * string + // | EnumConstructionCaseNotFound of FQTypeName.FQTypeName * string + | WrongNumberOfFnArgs of + fn : FQFnName.FQFnName * + expectedTypeArgs : int * + expectedArgs : int * + actualTypeArgs : int * + actualArgs : int + + let toDT (_e : Error) : RuntimeError = + // let typeName = + // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.Execution.error + + // let case (caseName : string) (fields : List) : RuntimeError = + // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.executionError + + // let (caseName, fields) = + // match e with + // | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> + // "MatchExprEnumPatternWrongCount", + // [ DString caseName; DInt64 expected; DInt64 actual ] + + // | MatchExprPatternWrongType(expected, actual) -> + // "MatchExprPatternWrongType", [ DString expected; RT2DT.Dval.toDT actual ] + + // | MatchExprUnmatched dv -> "MatchExprUnmatched", [ RT2DT.Dval.toDT dv ] + + // | NonStringInStringInterpolation dv -> + // "NonStringInStringInterpolation", [ RT2DT.Dval.toDT dv ] + + // | ConstDoesntExist name -> + // "ConstDoesntExist", [ RT2DT.FQConstantName.toDT name ] + + // | FieldAccessFieldDoesntExist(typeName, invalidFieldName) -> + // "FieldAccessFieldDoesntExist", + // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] + + // | FieldAccessNotRecord(vt, fieldName) -> + // "FieldAccessNotRecord", [ RT2DT.ValueType.toDT vt; DString fieldName ] + + // | EnumConstructionCaseNotFound(typeName, caseName) -> + // "EnumConstructionCaseNotFound", + // [ RT2DT.FQTypeName.toDT typeName; DString caseName ] + + // | WrongNumberOfFnArgs(fn, + // expectedTypeArgs, + // expectedArgs, + // actualTypeArgs, + // actualArgs) -> + // "WrongNumberOfFnArgs", + // [ RT2DT.FQFnName.toDT fn + // DInt64 expectedTypeArgs + // DInt64 expectedArgs + // DInt64 actualTypeArgs + // DInt64 actualArgs ] + + // | RecordConstructionFieldDoesntExist(typeName, invalidFieldName) -> + // "RecordConstructionFieldDoesntExist", + // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] + + // | RecordConstructionMissingField(typeName, missingFieldName) -> + // "RecordConstructionMissingField", + // [ RT2DT.FQTypeName.toDT typeName; DString missingFieldName ] + + // | RecordConstructionDuplicateField(typeName, duplicateFieldName) -> + // "RecordConstructionDuplicateField", + // [ RT2DT.FQTypeName.toDT typeName; DString duplicateFieldName ] + + // case caseName fields + RuntimeError.oldError "TODO" + + let raise (callStack : CallStack) (e : Error) : 'a = toDT e |> raiseRTE callStack + + +// let rec evalConst (callStack : CallStack) (c : Const) : Dval = +// let r = evalConst callStack + +// match c with +// | CUnit -> DUnit +// | CBool b -> DBool b + +// | CInt8 i -> DInt8 i +// | CUInt8 i -> DUInt8 i +// | CInt16 i -> DInt16 i +// | CUInt16 i -> DUInt16 i +// | CInt32 i -> DInt32 i +// | CUInt32 i -> DUInt32 i +// | CInt64 i -> DInt64 i +// | CUInt64 i -> DUInt64 i +// | CInt128 i -> DInt128 i +// | CUInt128 i -> DUInt128 i + +// | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) + +// | CChar c -> DChar c +// | CString s -> DString s + +// | CList items -> DList(ValueType.Unknown, (List.map r items)) +// | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) +// | CDict items -> +// DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) + +// | CEnum(Ok typeName, caseName, fields) -> +// // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the +// DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) + +// | CEnum(Error msg, _caseName, _fields) -> +// raiseRTE callStack (RuntimeError.oldError $"Invalid const name: {msg}") + + + +// /// Used in the ELet and ELambda evals +// /// Answers: does the `dval` "match" the given pattern? +// /// +// /// Returns: +// /// - whether or not the expr 'matches' the pattern +// /// - new vars (name * value) +// let rec checkPattern +// (callStack : CallStack) +// (dv : Dval) +// (pattern : LetPattern) +// : List = + +// let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) +// let chPat = checkPattern callStack + +// match pattern with + +// | LPVariable(_, varName) -> [ (varName, dv) ] + +// | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] + +// | LPTuple(_, firstPat, secondPat, theRestPat) -> +// let allPatterns = firstPat :: secondPat :: theRestPat + +// match dv with +// | DTuple(first, second, theRest) -> +// let allVals = first :: second :: theRest + +// if List.length allVals = List.length allPatterns then +// List.zip allVals allPatterns +// |> List.map (fun (dv, pat) -> chPat dv pat) +// |> List.concat +// else +// errStr "Tuple pattern has wrong number of elements" +// | _ -> errStr "Tuple pattern does not match" + +// fsharplint:disable FL0039 + + +let typeResolutionError + (callStack : CallStack) + (errorType : NameResolutionError.ErrorType) + : Ply<'a> = + let error : NameResolutionError.Error = + { errorType = errorType; nameType = NameResolutionError.Type } + error |> NameResolutionError.RTE.toRuntimeError |> raiseRTE callStack + + +// let recordMaybe +// (callStack : CallStack) +// (types : Types) +// (typeName : FQTypeName.FQTypeName) +// // TypeName, typeParam list, fully-resolved (except for typeParam) field list +// : Ply * List> = +// let rec inner (typeName : FQTypeName.FQTypeName) = +// uply { +// match! Types.find typeName types with +// | Some({ typeParams = outerTypeParams +// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), +// outerTypeArgs)) }) -> +// // Here we have found an alias, so we need to combine the type's +// // typeArgs with the aliased type's typeParams. +// // e.g. in +// // `type Var = Result` +// // we need to combine Var's typeArgs () with Result's +// // typeParams (<`Ok, `Error>) +// // +// // To do this, we use typeArgs from the alias definition +// // (outerTypeArgs) and apply them to the aliased type +// // (innerTypeName)'s params (which are returned from the lookup and +// // used as innerTypeParams below). +// // Example: suppose we have +// // type Outer<'a> = Inner<'a, Int> +// // type Inner<'x, 'y> = { x : 'x; y : 'y } +// // The recursive search for Inner will get: +// // innerTypeName = "Inner" +// // innerTypeParams = ["x"; "y"] +// // fields = [("x", TVar "x"); ("y", TVar "y")] +// // The Outer definition provides: +// // outerTypeArgs = [TVar "a"; TInt64] +// // We combine this with innerTypeParams to get: +// // fields = [("x", TVar "a"); ("y", TInt64)] +// // outerTypeParams = ["a"] +// // So the effective result of this is: +// // type Outer<'a> = { x : 'a; y : Int } +// let! (innerTypeName, innerTypeParams, fields) = inner innerTypeName +// return +// (innerTypeName, +// outerTypeParams, +// fields +// |> List.map (fun (k, v) -> +// (k, Types.substitute innerTypeParams outerTypeArgs v))) + +// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> +// return raiseRTE callStack e + +// | Some({ typeParams = typeParams; definition = TypeDeclaration.Record fields }) -> +// return +// (typeName, +// typeParams, +// fields |> NEList.toList |> List.map (fun f -> f.name, f.typ)) + +// | Some({ definition = TypeDeclaration.Alias(_) }) +// | Some({ definition = TypeDeclaration.Enum _ }) -> +// let packageTypeID = +// match typeName with +// | FQTypeName.FQTypeName.Package id -> id +// return! +// typeResolutionError +// callStack +// (NameResolutionError.ExpectedRecordButNot packageTypeID) + +// | None -> +// return! typeResolutionError callStack (NameResolutionError.NotFound []) +// } +// inner typeName + + +// let enumMaybe +// (callStack : CallStack) +// (types : Types) +// (typeName : FQTypeName.FQTypeName) +// : Ply * NEList> = +// let rec inner (typeName : FQTypeName.FQTypeName) = +// uply { +// match! Types.find typeName types with +// | Some({ typeParams = outerTypeParams +// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), +// outerTypeArgs)) }) -> +// let! (innerTypeName, innerTypeParams, cases) = inner innerTypeName +// return +// (innerTypeName, +// outerTypeParams, +// cases +// |> NEList.map (fun (c : TypeDeclaration.EnumCase) -> +// { c with +// fields = +// List.map +// (Types.substitute innerTypeParams outerTypeArgs) +// c.fields })) + +// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> +// return raiseRTE callStack e + +// | Some({ typeParams = typeParams; definition = TypeDeclaration.Enum cases }) -> +// return (typeName, typeParams, cases) + +// | Some({ definition = TypeDeclaration.Alias _ }) +// | Some({ definition = TypeDeclaration.Record _ }) -> +// let packageTypeID = +// match typeName with +// | FQTypeName.FQTypeName.Package id -> id +// return! +// typeResolutionError +// callStack +// (NameResolutionError.ExpectedEnumButNot packageTypeID) +// | None -> +// return! typeResolutionError callStack (NameResolutionError.NotFound []) // typeName +// } +// inner typeName + + +/// Interprets an expression and reduces it to a Dark value +/// (or a task that should result in such) +let rec eval (state : ExecutionState) (e : Instructions) : DvalTask = + // Some helper fns to make it easier to update the state's callstack + // for a given expr, match pattern, etc. + let callStackID (id : id) = + { state.tracing.callStack with + lastCalled = (fst state.tracing.callStack.lastCalled, Some id) } + let stateWithUpdatedCallStack id = + { state with tracing.callStack = callStackID id } + + // Update the state's callStack with the id of the expr we're evaluating + let state = stateWithUpdatedCallStack (Expr.toID e) + let callStack = state.tracing.callStack + + // Some helper fns to make it easier to raise RTEs + let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) + //let err callStack rte : 'a = raiseRTE callStack rte + let raiseExeRTE callStack (e : ExecutionError.Error) : Ply<'a> = + ExecutionError.raise callStack e + + uply { + match e with + | EUnit _ -> return DUnit + + | EBool(_, b) -> return DBool b + + // | EInt8(_, i) -> return DInt8 i + // | EUInt8(_, i) -> return DUInt8 i + // | EInt16(_, i) -> return DInt16 i + // | EUInt16(_, i) -> return DUInt16 i + // | EInt32(_, i) -> return DInt32 i + // | EUInt32(_, i) -> return DUInt32 i + | EInt64(_, i) -> return DInt64 i + // | EUInt64(_, i) -> return DUInt64 i + // | EInt128(_, i) -> return DInt128 i + // | EUInt128(_, i) -> return DUInt128 i + + // | EFloat(_, value) -> return DFloat value + + // | EChar(_, s) -> return DChar s + + | EString(_, [ StringText s ]) -> + // We expect strings to be normalized during parsing + return DString(s) + | EString(_, segments) -> + let! segments = + segments + |> Ply.List.mapSequentially (fun seg -> + uply { + match seg with + | StringText text -> return text + | StringInterpolation expr -> + match! eval state expr with + | DString s -> return s + | dv -> + // TODO: maybe better with a type error here + return! + raiseExeRTE + callStack + (ExecutionError.NonStringInStringInterpolation dv) + }) + return segments |> String.concat "" |> String.normalize |> DString + + + // | EConstant(_, name) -> + // match name with + // | FQConstantName.Builtin c -> + // match Map.find c state.builtins.constants with + // | None -> + // return! + // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) + // | Some constant -> return constant.body + + // | FQConstantName.Package c -> + // match! state.packageManager.getConstant c with + // | None -> + // return! + // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) + // | Some constant -> return evalConst callStack constant.body + + + // | ELet(_, pattern, rhs, body) -> + // let! rhs = eval state rhs + // let newDefs = checkPattern callStack rhs pattern + // let newSymtable = Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) + + // return! eval { state with symbolTable = newSymtable } body + + // | EList(_, exprs) -> + // let! results = Ply.List.mapSequentially (eval state) exprs + // return TypeChecker.DvalCreator.list callStack VT.unknown results + + // | ETuple(_, first, second, theRest) -> + // let! firstResult = eval state first + // let! secondResult = eval state second + // let! otherResults = Ply.List.mapSequentially (eval state) theRest + // return DTuple(firstResult, secondResult, otherResults) + + // | EVariable(_, name) -> + // match Map.find name state.symbolTable with + // | None -> return errStr callStack $"There is no variable named: {name}" + // | Some other -> return other + + + // | ERecord(_, typeName, fields) -> + // let types = ExecutionState.availableTypes state + + // let! (aliasTypeName, _typeParams, expectedFields) = + // recordMaybe callStack types typeName + // let expectedFields = Map expectedFields + + // let! fields = + // fields + // |> NEList.toList + // |> Ply.List.foldSequentially + // (fun fields (fieldName, expr) -> + // uply { + // match Map.find fieldName expectedFields with + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionFieldDoesntExist( + // typeName, + // fieldName + // )) + // | Some fieldType -> + // let! v = eval state expr + // if Map.containsKey fieldName fields then + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionDuplicateField( + // typeName, + // fieldName + // )) + + // else + // let context = + // TypeChecker.RecordField(typeName, fieldName, fieldType) + // let check = TypeChecker.unify context types Map.empty fieldType v + // match! check with + // | Ok() -> return Map.add fieldName v fields + // | Error e -> return err callStack e + // }) + // Map.empty + + // if Map.count fields = Map.count expectedFields then + // return DRecord(aliasTypeName, typeName, VT.typeArgsTODO, fields) + // else + // let expectedFields = Map.keys expectedFields + // let fieldName = + // Seq.find (fun k -> not (Map.containsKey k fields)) expectedFields + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionMissingField(typeName, fieldName)) + + + // | ERecordUpdate(_, baseRecord, updates) -> + // // CLEANUP refactor this impl + // // namely, focus more on the `fields` and don't pass around DRecord so much + + // let! baseRecord = eval state baseRecord + // match baseRecord with + // | DRecord(typeName, _, typ, _) -> + // let typeStr = FQTypeName.toString typeName + // let types = ExecutionState.availableTypes state + + // let! (_, _, expected) = recordMaybe callStack types typeName + // let expectedFields = Map expected + // return! + // updates + // |> NEList.toList + // |> Ply.List.foldSequentially + // (fun record (fieldName, expr) -> + // uply { + // let! dv = eval state expr + + // match record, fieldName, dv with + // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" + // | _, _, _ when not (Map.containsKey fieldName expectedFields) -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.RecordConstructionFieldDoesntExist( + // typeName, + // fieldName + // )) + + // | DRecord(typeName, original, _, m), fieldName, dv -> + // let fieldType = Map.findUnsafe fieldName expectedFields + + // let context = + // TypeChecker.RecordField(typeName, fieldName, fieldType) + + // match! TypeChecker.unify context types Map.empty fieldType dv with + // | Ok() -> + // return DRecord(typeName, original, typ, Map.add fieldName dv m) + // | Error rte -> return raiseRTE callStack rte + + // | _ -> + // return + // errStr + // callStack + // $"Expected a record but {typeStr} is something else" + // }) + // baseRecord + // | _ -> return errStr callStack "Expected a record in record update" + + // | EDict(_, fields) -> + // let! fields = + // fields + // |> Ply.List.mapSequentially (fun (k, v) -> + // uply { + // let! v = eval state v + // return (k, v) + // }) + // return TypeChecker.DvalCreator.dict ValueType.Unknown fields + + | EFnName(_, name) -> return DFnVal(NamedFn name) + + | EApply(_, fnTarget, typeArgs, exprs) -> + match! eval state fnTarget with + | DFnVal fnVal -> + let! args = Ply.NEList.mapSequentially (eval state) exprs + return! applyFnVal state fnVal typeArgs args + | other -> + return + errStr + callStack + $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" + + + // | EFieldAccess(_, e, fieldName) -> + // let! obj = eval state e + + // if fieldName = "" then + // return errStr callStack "Field name is empty" + // else + // match obj with + // | DRecord(_, typeName, _, fields) -> + // match Map.find fieldName fields with + // | Some v -> return v + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.FieldAccessFieldDoesntExist(typeName, fieldName)) + // | DDB _ -> + // let msg = + // $"Attempting to access field '{fieldName}' of a Datastore " + // + "(use `DB.*` standard library functions to interact with Datastores. " + // + "Field access only work with records)" + // return errStr callStack msg + // | _ -> + + // return + // ExecutionError.raise + // callStack + // (ExecutionError.FieldAccessNotRecord(Dval.toValueType obj, fieldName)) + + + // | ELambda(_, parameters, body) -> + // // It is the responsibility of wherever executes the DBlock to pass in + // // args and execute the body. + // return + // DFnVal( + // Lambda + // { typeSymbolTable = state.typeSymbolTable + // symtable = state.symbolTable + // parameters = parameters + // body = body } + // ) + + + // | EMatch(_, matchExpr, cases) -> + // /// Does the dval 'match' the given pattern? + // /// + // /// Returns: + // /// - whether or not the expr 'matches' the pattern + // /// - new vars (name * value) + // let rec checkPattern + // (dv : Dval) + // (pattern : MatchPattern) + // : Ply> = + // uply { + // // CLEANUP things down the line assume that the `id` in the callStack is an _Expression_ ID. + // // It might be nice to also allow for MP IDs. This would require a change in the callStack here. + // // let state = stateWithUpdatedCallStack (MatchPattern.toID pattern) + // // let callStack = state.tracing.callStack + + // let errWrongType expected = + // raiseExeRTE + // callStack + // (ExecutionError.MatchExprPatternWrongType(expected, dv)) + + // match pattern with + // | MPUnit(_) -> + // match dv with + // | DUnit -> return true, [] + // | _ -> return! errWrongType "Unit" + + // | MPBool(_, pb) -> + // match dv with + // | DBool db -> return (db = pb), [] + // | _ -> return! errWrongType "Bool" + + // | MPInt8(_, pi) -> + // match dv with + // | DInt8 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int8" + // | MPUInt8(_, pi) -> + // match dv with + // | DUInt8 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt8" + // | MPInt16(_, pi) -> + // match dv with + // | DInt16 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int16" + // | MPUInt16(_, pi) -> + // match dv with + // | DUInt16 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt16" + // | MPInt32(_, pi) -> + // match dv with + // | DInt32 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int32" + // | MPUInt32(_, pi) -> + // match dv with + // | DUInt32 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt32" + // | MPInt64(_, pi) -> + // match dv with + // | DInt64 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int64" + // | MPUInt64(_, pi) -> + // match dv with + // | DUInt64 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt64" + // | MPInt128(_, pi) -> + // match dv with + // | DInt128 di -> return (di = pi), [] + // | _ -> return! errWrongType "Int128" + // | MPUInt128(_, pi) -> + // match dv with + // | DUInt128 di -> return (di = pi), [] + // | _ -> return! errWrongType "UInt128" + + // | MPFloat(_, pf) -> + // match dv with + // | DFloat df -> return (df = pf), [] + // | _ -> return! errWrongType "Float" + + // | MPChar(_, pc) -> + // match dv with + // | DChar dc -> return (dc = pc), [] + // | _ -> return! errWrongType "Char" + // | MPString(_, ps) -> + // match dv with + // | DString ds -> return (ds = ps), [] + // | _ -> return! errWrongType "String" + + // | MPEnum(_, caseName, fieldPats) -> + // match dv with + // | DEnum(_dTypeName, _oTypeName, _typeArgsDEnumTODO, dCaseName, dFields) -> + // if caseName <> dCaseName then + // return false, [] + // else + // let dvFieldLength = List.length dFields + // match fieldPats with + // // wildcard + // | [ MPVariable(_, "_") ] when dvFieldLength > 0 -> return true, [] + // | _ -> + // let patFieldLength = List.length fieldPats + // if dvFieldLength <> patFieldLength then + // return! + // raiseExeRTE + // callStack + // (ExecutionError.MatchExprEnumPatternWrongCount( + // dCaseName, + // patFieldLength, + // dvFieldLength + // )) + // else + // let! (passResults, newVarResults) = + // List.zip dFields fieldPats + // |> Ply.List.mapSequentially (fun (dv, pat) -> + // checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + + // | _dv -> return! errWrongType caseName + + + // | MPTuple(_, firstPat, secondPat, theRestPat) -> + // let allPatterns = firstPat :: secondPat :: theRestPat + + // match dv with + // | DTuple(first, second, theRest) -> + // let allVals = first :: second :: theRest + + // if List.length allVals = List.length allPatterns then + // let! (passResults, newVarResults) = + // List.zip allVals allPatterns + // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + // else + // return false, [] + // | _ -> + // // TODO: specify length? + // return! errWrongType "Tuple" + + + // | MPListCons(_, headPat, tailPat) -> + // match dv with + // | DList(_, []) -> return false, [] + // | DList(vt, headVal :: tailVals) -> + // let! (headPass, headVars) = checkPattern headVal headPat + // let! (tailPass, tailVars) = + // checkPattern + // (TypeChecker.DvalCreator.list callStack vt tailVals) + // tailPat + + // let allSubVars = headVars @ tailVars + // let pass = headPass && tailPass + // return pass, allSubVars + // | _ -> return! errWrongType "List" + + // | MPList(_, pats) -> + // match dv with + // | DList(_, vals) -> + // if List.length vals = List.length pats then + // let! (passResults, newVarResults) = + // List.zip vals pats + // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) + // |> Ply.map List.unzip + + // let allPass = List.forall identity passResults + // let allVars = newVarResults |> List.collect identity + // return allPass, allVars + // else + // return false, [] + // | _ -> return! errWrongType "List" + + // | MPVariable(_, varName) -> return true, [ (varName, dv) ] + // } + + + // // The value we're matching against + // let! matchVal = eval state matchExpr + + // let mutable matchResult = None + + // for case in NEList.toList cases do + // if Option.isSome matchResult then + // () + // else + // let! passesPattern, newDefs = checkPattern matchVal case.pat + // let newSymtable = + // Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) + // let state = { state with symbolTable = newSymtable } + // let! passesWhenCondition = + // uply { + // match case.whenCondition with + // | Some whenCondition when passesPattern -> + // match! eval state whenCondition with + // | DBool b -> return b + // | _ -> return errStr callStack "When condition should be a boolean" + // | _ -> return true + // } + // if passesPattern && passesWhenCondition then + // let! r = eval state case.rhs + // matchResult <- Some r + + // match matchResult with + // | Some r -> return r + // | None -> + // return! raiseExeRTE callStack (ExecutionError.MatchExprUnmatched matchVal) + + + // | EIf(_, cond, thenBody, elseBody) -> + // match! eval state cond with + // | DBool false -> + // match elseBody with + // | None -> return DUnit + // | Some eb -> return! eval state eb + // | DBool true -> return! eval state thenBody + // | _ -> return errStr callStack "If only supports Booleans" + + + // | EOr(_, left, right) -> + // match! eval state left with + // | DBool true -> return DBool true + // | DBool false -> + // match! eval state right with + // | DBool _ as b -> return b + // | _ -> return errStr callStack "|| only supports Booleans" + // | _ -> return errStr callStack "|| only supports Booleans" + + + // | EAnd(_, left, right) -> + // match! eval state left with + // | DBool false -> return DBool false + // | DBool true -> + // match! eval state right with + // | DBool _ as b -> return b + // | _ -> return errStr callStack "&& only supports Booleans" + // | _ -> return errStr callStack "&& only supports Booleans" + + + // | EEnum(_, sourceTypeName, caseName, fields) -> + // let types = ExecutionState.availableTypes state + + // let! (resolvedTypeName, _, cases) = enumMaybe callStack types sourceTypeName + // let case = cases |> NEList.find (fun c -> c.name = caseName) + + // match case with + // | None -> + // return + // ExecutionError.raise + // callStack + // (ExecutionError.EnumConstructionCaseNotFound(sourceTypeName, caseName)) + + // | Some case -> + // if case.fields.Length <> fields.Length then + // let msg = + // $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" + // return errStr callStack msg + // else + // let! (fields : List) = + // Ply.List.foldSequentiallyWithIndex + // (fun + // fieldIndex + // fieldsSoFar + // ((enumFieldType : TypeReference), fieldExpr) -> + // uply { + // let! v = eval state fieldExpr + + // let context = + // TypeChecker.EnumField( + // sourceTypeName, + // case.name, + // fieldIndex, + // List.length fields, + // enumFieldType + // ) + + // // VTTODO: we should be passing in a proper tst, not Map.empty - right? + // match! + // TypeChecker.unify context types Map.empty enumFieldType v + // with + // | Ok() -> return (List.append fieldsSoFar [ v ]) + // | Error rte -> return raiseRTE callStack rte + // }) + // [] + // (List.zip case.fields fields) + + // return! + // TypeChecker.DvalCreator.enum + // resolvedTypeName + // sourceTypeName + // caseName + // fields + + | EError(_, rte, exprs) -> + let! (_ : List) = Ply.List.mapSequentially (eval state) exprs + return raiseRTE callStack rte + } + + +and applyFnVal + (state : ExecutionState) + (fnVal : FnValImpl) + (typeArgs : List) + (args : NEList) + : DvalTask = + match fnVal with + //| Lambda l -> executeLambda state l args + | NamedFn fn -> callFn state fn typeArgs args + +// and executeLambda +// (state : ExecutionState) +// (l : LambdaImpl) +// (args : NEList) +// : DvalTask = + +// // One of the reasons to take a separate list of params and args is to +// // provide this error message here. We don't have this information in +// // other places, and the alternative is just to provide incompletes +// // with no context +// let expectedLength = NEList.length l.parameters +// let actualLength = NEList.length args +// if expectedLength <> actualLength then +// raiseRTE +// state.tracing.callStack +// (RuntimeError.oldError +// $"Expected {expectedLength} arguments, got {actualLength}") + +// else +// let checkPattern' = checkPattern state.tracing.callStack + +// let paramSyms = +// NEList.map2 checkPattern' args l.parameters +// |> NEList.toList +// |> List.flatten +// |> Map + +// let state = +// { state with symbolTable = Map.mergeFavoringRight l.symtable paramSyms } + +// eval state l.body + +and callFn + (state : ExecutionState) + (fnToCall : FQFnName.FQFnName) + (typeArgs : List) + (args : NEList) + : DvalTask = + uply { + let! fn = + match fnToCall with + | FQFnName.Builtin std -> + Map.find std state.builtins.fns |> Option.map builtInFnToFn |> Ply + + | FQFnName.Package pkg -> + uply { + let! fn = state.packageManager.getFn pkg + return Option.map packageFnToFn fn + } + + match fn with + | Some fn -> + let expectedTypeParams = List.length fn.typeParams + let expectedArgs = NEList.length fn.parameters + + let actualTypeArgs = List.length typeArgs + let actualArgs = NEList.length args + + if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then + ExecutionError.raise + state.tracing.callStack + (ExecutionError.WrongNumberOfFnArgs( + fnToCall, + expectedTypeParams, + expectedArgs, + actualTypeArgs, + actualArgs + )) + + let state = + let boundArgs = + NEList.map2 (fun (p : Param) actual -> (p.name, actual)) fn.parameters args + |> NEList.toList + |> Map + { state with + symbolTable = Map.mergeFavoringRight state.symbolTable boundArgs } + + let state = + let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map + { state with + typeSymbolTable = + Map.mergeFavoringRight state.typeSymbolTable newlyBoundTypeArgs } + + return! execFn state fnToCall fn typeArgs args + + | None -> + // Functions which aren't available in the runtime (for whatever reason) + // may have results available in traces. (use case: inspecting a cloud-run trace locally) + let fnResult = + state.tracing.loadFnResult + (state.tracing.callStack.lastCalled, fnToCall) + args + + match fnResult with + | Some(result, _ts) -> return result + | None -> + return + raiseRTE + state.tracing.callStack + (RuntimeError.oldError + $"Function {FQFnName.toString fnToCall} is not found") + } + + +and execFn + (state : ExecutionState) + (fnDesc : FQFnName.FQFnName) + (fn : Fn) + (typeArgs : List) + (args : NEList) + : DvalTask = + uply { + let types = ExecutionState.availableTypes state + + let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map + let typeSymbolTable = + Map.mergeFavoringRight state.typeSymbolTable typeArgsResolvedInFn + + match! TypeChecker.checkFunctionCall types typeSymbolTable fn args with + | Error rte -> return raiseRTE state.tracing.callStack rte + | Ok() -> + let! result = + match fn.fn with + | BuiltInFunction f -> + let executionPoint = ExecutionPoint.Function fn.name + + state.tracing.traceExecutionPoint executionPoint + + let state = + { state with tracing.callStack.lastCalled = (executionPoint, None) } + + uply { + let! result = + uply { + try + return! f (state, typeArgs, NEList.toList args) + with e -> + match e with + | RuntimeErrorException(None, rte) -> + // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack + // So we catch the exception here and add the callStack to it so it's handy in error-reporting + return raiseRTE state.tracing.callStack rte + + | RuntimeErrorException _ -> return Exception.reraise e + + | e -> + let context : Metadata = + [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] + state.reportException state context e + // These are arbitrary errors, and could include sensitive + // information, so best not to show it to the user. If we'd + // like to show it to the user, we should catch it where it happens + // and give them a known safe error via a RuntimeError + return + raiseRTE + state.tracing.callStack + (RuntimeError.oldError "Unknown error") + } + + if fn.previewable <> Pure then + // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath + state.tracing.storeFnResult + (state.tracing.callStack.lastCalled, fnDesc) + args + result + + return result + } + + | PackageFunction(id, body) -> + // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? + // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) + let executionPoint = ExecutionPoint.Function(FQFnName.Package id) + + state.tracing.traceExecutionPoint executionPoint + + let state = + { state with + tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } + + eval state body + + match! TypeChecker.checkFunctionReturnType types typeSymbolTable fn result with + | Error rte -> return raiseRTE state.tracing.callStack rte + | Ok() -> return result + } diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 14d1ca630a..c99cd38ac8 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -1,4 +1,4 @@ -/// Interprets Dark expressions resulting in (tasks of) Dvals +/// Interprets Dark instructions resulting in (tasks of) Dvals module LibExecution.Interpreter open System.Threading.Tasks @@ -7,1016 +7,158 @@ open FSharp.Control.Tasks.Affine.Unsafe open Prelude open RuntimeTypes -module VT = ValueType - -/// Gathers any global data (Secrets, DBs, etc.) -/// that may be needed to evaluate an expression -let globalsFor (_state : ExecutionState) : Symtable = - let secrets = - // state.program.secrets - // |> List.map (fun (s : Secret.T) -> (s.name, DString s.value)) - // |> Map.ofList - Map.empty - - let dbs = - //Map.map (fun (db : DB.T) -> DDB db.name) state.program.dbs - Map.empty - - Map.mergeFavoringLeft secrets dbs - - -let withGlobals (state : ExecutionState) (symtable : Symtable) : Symtable = - let globals = globalsFor state - Map.mergeFavoringRight globals symtable - - -module ExecutionError = - //module RT2DT = RuntimeTypesToDarkTypes - - type Error = - // | MatchExprEnumPatternWrongCount of string * int * int - // | MatchExprPatternWrongType of string * Dval - // | MatchExprUnmatched of Dval - | NonStringInStringInterpolation of Dval - //| ConstDoesntExist of FQConstantName.FQConstantName - // | FieldAccessFieldDoesntExist of - // typeName : FQTypeName.FQTypeName * - // invalidFieldName : string - // | RecordConstructionFieldDoesntExist of - // FQTypeName.FQTypeName * - // invalidFieldName : string - // | RecordConstructionMissingField of - // FQTypeName.FQTypeName * - // missingFieldName : string - // | RecordConstructionDuplicateField of - // FQTypeName.FQTypeName * - // duplicateFieldName : string - // | FieldAccessNotRecord of ValueType * string - // | EnumConstructionCaseNotFound of FQTypeName.FQTypeName * string - | WrongNumberOfFnArgs of - fn : FQFnName.FQFnName * - expectedTypeArgs : int * - expectedArgs : int * - actualTypeArgs : int * - actualArgs : int - - let toDT (_e : Error) : RuntimeError = - // let typeName = - // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.Execution.error - - // let case (caseName : string) (fields : List) : RuntimeError = - // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.executionError - - // let (caseName, fields) = - // match e with - // | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> - // "MatchExprEnumPatternWrongCount", - // [ DString caseName; DInt64 expected; DInt64 actual ] - - // | MatchExprPatternWrongType(expected, actual) -> - // "MatchExprPatternWrongType", [ DString expected; RT2DT.Dval.toDT actual ] - - // | MatchExprUnmatched dv -> "MatchExprUnmatched", [ RT2DT.Dval.toDT dv ] - - // | NonStringInStringInterpolation dv -> - // "NonStringInStringInterpolation", [ RT2DT.Dval.toDT dv ] - - // | ConstDoesntExist name -> - // "ConstDoesntExist", [ RT2DT.FQConstantName.toDT name ] - - // | FieldAccessFieldDoesntExist(typeName, invalidFieldName) -> - // "FieldAccessFieldDoesntExist", - // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - - // | FieldAccessNotRecord(vt, fieldName) -> - // "FieldAccessNotRecord", [ RT2DT.ValueType.toDT vt; DString fieldName ] - - // | EnumConstructionCaseNotFound(typeName, caseName) -> - // "EnumConstructionCaseNotFound", - // [ RT2DT.FQTypeName.toDT typeName; DString caseName ] - - // | WrongNumberOfFnArgs(fn, - // expectedTypeArgs, - // expectedArgs, - // actualTypeArgs, - // actualArgs) -> - // "WrongNumberOfFnArgs", - // [ RT2DT.FQFnName.toDT fn - // DInt64 expectedTypeArgs - // DInt64 expectedArgs - // DInt64 actualTypeArgs - // DInt64 actualArgs ] - - // | RecordConstructionFieldDoesntExist(typeName, invalidFieldName) -> - // "RecordConstructionFieldDoesntExist", - // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - - // | RecordConstructionMissingField(typeName, missingFieldName) -> - // "RecordConstructionMissingField", - // [ RT2DT.FQTypeName.toDT typeName; DString missingFieldName ] - - // | RecordConstructionDuplicateField(typeName, duplicateFieldName) -> - // "RecordConstructionDuplicateField", - // [ RT2DT.FQTypeName.toDT typeName; DString duplicateFieldName ] - - // case caseName fields - RuntimeError.oldError "TODO" - - let raise (callStack : CallStack) (e : Error) : 'a = toDT e |> raiseRTE callStack - - -// let rec evalConst (callStack : CallStack) (c : Const) : Dval = -// let r = evalConst callStack - -// match c with -// | CUnit -> DUnit -// | CBool b -> DBool b - -// | CInt8 i -> DInt8 i -// | CUInt8 i -> DUInt8 i -// | CInt16 i -> DInt16 i -// | CUInt16 i -> DUInt16 i -// | CInt32 i -> DInt32 i -// | CUInt32 i -> DUInt32 i -// | CInt64 i -> DInt64 i -// | CUInt64 i -> DUInt64 i -// | CInt128 i -> DInt128 i -// | CUInt128 i -> DUInt128 i - -// | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) - -// | CChar c -> DChar c -// | CString s -> DString s - -// | CList items -> DList(ValueType.Unknown, (List.map r items)) -// | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) -// | CDict items -> -// DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) - -// | CEnum(Ok typeName, caseName, fields) -> -// // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the -// DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) - -// | CEnum(Error msg, _caseName, _fields) -> -// raiseRTE callStack (RuntimeError.oldError $"Invalid const name: {msg}") - - - -// /// Used in the ELet and ELambda evals -// /// Answers: does the `dval` "match" the given pattern? -// /// -// /// Returns: -// /// - whether or not the expr 'matches' the pattern -// /// - new vars (name * value) -// let rec checkPattern -// (callStack : CallStack) -// (dv : Dval) -// (pattern : LetPattern) -// : List = - -// let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) -// let chPat = checkPattern callStack - -// match pattern with - -// | LPVariable(_, varName) -> [ (varName, dv) ] - -// | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] - -// | LPTuple(_, firstPat, secondPat, theRestPat) -> -// let allPatterns = firstPat :: secondPat :: theRestPat - -// match dv with -// | DTuple(first, second, theRest) -> -// let allVals = first :: second :: theRest - -// if List.length allVals = List.length allPatterns then -// List.zip allVals allPatterns -// |> List.map (fun (dv, pat) -> chPat dv pat) -// |> List.concat -// else -// errStr "Tuple pattern has wrong number of elements" -// | _ -> errStr "Tuple pattern does not match" - -// fsharplint:disable FL0039 - - -let typeResolutionError - (callStack : CallStack) - (errorType : NameResolutionError.ErrorType) - : Ply<'a> = - let error : NameResolutionError.Error = - { errorType = errorType; nameType = NameResolutionError.Type } - error |> NameResolutionError.RTE.toRuntimeError |> raiseRTE callStack - - -// let recordMaybe -// (callStack : CallStack) -// (types : Types) -// (typeName : FQTypeName.FQTypeName) -// // TypeName, typeParam list, fully-resolved (except for typeParam) field list -// : Ply * List> = -// let rec inner (typeName : FQTypeName.FQTypeName) = -// uply { -// match! Types.find typeName types with -// | Some({ typeParams = outerTypeParams -// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), -// outerTypeArgs)) }) -> -// // Here we have found an alias, so we need to combine the type's -// // typeArgs with the aliased type's typeParams. -// // e.g. in -// // `type Var = Result` -// // we need to combine Var's typeArgs () with Result's -// // typeParams (<`Ok, `Error>) -// // -// // To do this, we use typeArgs from the alias definition -// // (outerTypeArgs) and apply them to the aliased type -// // (innerTypeName)'s params (which are returned from the lookup and -// // used as innerTypeParams below). -// // Example: suppose we have -// // type Outer<'a> = Inner<'a, Int> -// // type Inner<'x, 'y> = { x : 'x; y : 'y } -// // The recursive search for Inner will get: -// // innerTypeName = "Inner" -// // innerTypeParams = ["x"; "y"] -// // fields = [("x", TVar "x"); ("y", TVar "y")] -// // The Outer definition provides: -// // outerTypeArgs = [TVar "a"; TInt64] -// // We combine this with innerTypeParams to get: -// // fields = [("x", TVar "a"); ("y", TInt64)] -// // outerTypeParams = ["a"] -// // So the effective result of this is: -// // type Outer<'a> = { x : 'a; y : Int } -// let! (innerTypeName, innerTypeParams, fields) = inner innerTypeName -// return -// (innerTypeName, -// outerTypeParams, -// fields -// |> List.map (fun (k, v) -> -// (k, Types.substitute innerTypeParams outerTypeArgs v))) - -// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> -// return raiseRTE callStack e - -// | Some({ typeParams = typeParams; definition = TypeDeclaration.Record fields }) -> -// return -// (typeName, -// typeParams, -// fields |> NEList.toList |> List.map (fun f -> f.name, f.typ)) - -// | Some({ definition = TypeDeclaration.Alias(_) }) -// | Some({ definition = TypeDeclaration.Enum _ }) -> -// let packageTypeID = -// match typeName with -// | FQTypeName.FQTypeName.Package id -> id -// return! -// typeResolutionError -// callStack -// (NameResolutionError.ExpectedRecordButNot packageTypeID) - -// | None -> -// return! typeResolutionError callStack (NameResolutionError.NotFound []) -// } -// inner typeName - - -// let enumMaybe -// (callStack : CallStack) -// (types : Types) -// (typeName : FQTypeName.FQTypeName) -// : Ply * NEList> = -// let rec inner (typeName : FQTypeName.FQTypeName) = -// uply { -// match! Types.find typeName types with -// | Some({ typeParams = outerTypeParams -// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), -// outerTypeArgs)) }) -> -// let! (innerTypeName, innerTypeParams, cases) = inner innerTypeName -// return -// (innerTypeName, -// outerTypeParams, -// cases -// |> NEList.map (fun (c : TypeDeclaration.EnumCase) -> -// { c with -// fields = -// List.map -// (Types.substitute innerTypeParams outerTypeArgs) -// c.fields })) - -// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> -// return raiseRTE callStack e - -// | Some({ typeParams = typeParams; definition = TypeDeclaration.Enum cases }) -> -// return (typeName, typeParams, cases) - -// | Some({ definition = TypeDeclaration.Alias _ }) -// | Some({ definition = TypeDeclaration.Record _ }) -> -// let packageTypeID = -// match typeName with -// | FQTypeName.FQTypeName.Package id -> id -// return! -// typeResolutionError -// callStack -// (NameResolutionError.ExpectedEnumButNot packageTypeID) -// | None -> -// return! typeResolutionError callStack (NameResolutionError.NotFound []) // typeName -// } -// inner typeName - - -/// Interprets an expression and reduces it to a Dark value -/// (or a task that should result in such) -let rec eval (state : ExecutionState) (e : Expr) : DvalTask = - // Some helper fns to make it easier to update the state's callstack - // for a given expr, match pattern, etc. - let callStackID (id : id) = - { state.tracing.callStack with - lastCalled = (fst state.tracing.callStack.lastCalled, Some id) } - let stateWithUpdatedCallStack id = - { state with tracing.callStack = callStackID id } - - // Update the state's callStack with the id of the expr we're evaluating - let state = stateWithUpdatedCallStack (Expr.toID e) - let callStack = state.tracing.callStack - - // Some helper fns to make it easier to raise RTEs - let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) - //let err callStack rte : 'a = raiseRTE callStack rte - let raiseExeRTE callStack (e : ExecutionError.Error) : Ply<'a> = - ExecutionError.raise callStack e - +type Registers = Dval array + +type VMState = + { registers : Registers + variables : Map + callStack : List } + +/// TODO: don't pass ExecutionState around so much? +/// The parts that change, (e.g. `st` and `tst`) should probably all be part of VMState +/// +/// Maybe rename ExecutionState to something else +/// , like ExecutionContext or Execution +let rec execute + (state : ExecutionState) + (vmState : VMState) + (instructions : Instructions) + (resultReg : Register) + (counter : int) + : Ply = uply { - match e with - | EUnit _ -> return DUnit - - | EBool(_, b) -> return DBool b - - // | EInt8(_, i) -> return DInt8 i - // | EUInt8(_, i) -> return DUInt8 i - // | EInt16(_, i) -> return DInt16 i - // | EUInt16(_, i) -> return DUInt16 i - // | EInt32(_, i) -> return DInt32 i - // | EUInt32(_, i) -> return DUInt32 i - | EInt64(_, i) -> return DInt64 i - // | EUInt64(_, i) -> return DUInt64 i - // | EInt128(_, i) -> return DInt128 i - // | EUInt128(_, i) -> return DUInt128 i - - // | EFloat(_, value) -> return DFloat value - - // | EChar(_, s) -> return DChar s - - | EString(_, [ StringText s ]) -> - // We expect strings to be normalized during parsing - return DString(s) - | EString(_, segments) -> - let! segments = - segments - |> Ply.List.mapSequentially (fun seg -> - uply { - match seg with - | StringText text -> return text - | StringInterpolation expr -> - match! eval state expr with - | DString s -> return s - | dv -> - // TODO: maybe better with a type error here - return! - raiseExeRTE - callStack - (ExecutionError.NonStringInStringInterpolation dv) - }) - return segments |> String.concat "" |> String.normalize |> DString - - - // | EConstant(_, name) -> - // match name with - // | FQConstantName.Builtin c -> - // match Map.find c state.builtins.constants with - // | None -> - // return! - // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - // | Some constant -> return constant.body - - // | FQConstantName.Package c -> - // match! state.packageManager.getConstant c with - // | None -> - // return! - // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - // | Some constant -> return evalConst callStack constant.body - - - // | ELet(_, pattern, rhs, body) -> - // let! rhs = eval state rhs - // let newDefs = checkPattern callStack rhs pattern - // let newSymtable = Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - - // return! eval { state with symbolTable = newSymtable } body - - // | EList(_, exprs) -> - // let! results = Ply.List.mapSequentially (eval state) exprs - // return TypeChecker.DvalCreator.list callStack VT.unknown results - - // | ETuple(_, first, second, theRest) -> - // let! firstResult = eval state first - // let! secondResult = eval state second - // let! otherResults = Ply.List.mapSequentially (eval state) theRest - // return DTuple(firstResult, secondResult, otherResults) - - // | EVariable(_, name) -> - // match Map.find name state.symbolTable with - // | None -> return errStr callStack $"There is no variable named: {name}" - // | Some other -> return other - - - // | ERecord(_, typeName, fields) -> - // let types = ExecutionState.availableTypes state - - // let! (aliasTypeName, _typeParams, expectedFields) = - // recordMaybe callStack types typeName - // let expectedFields = Map expectedFields - - // let! fields = - // fields - // |> NEList.toList - // |> Ply.List.foldSequentially - // (fun fields (fieldName, expr) -> - // uply { - // match Map.find fieldName expectedFields with - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionFieldDoesntExist( - // typeName, - // fieldName - // )) - // | Some fieldType -> - // let! v = eval state expr - // if Map.containsKey fieldName fields then - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionDuplicateField( - // typeName, - // fieldName - // )) - - // else - // let context = - // TypeChecker.RecordField(typeName, fieldName, fieldType) - // let check = TypeChecker.unify context types Map.empty fieldType v - // match! check with - // | Ok() -> return Map.add fieldName v fields - // | Error e -> return err callStack e - // }) - // Map.empty - - // if Map.count fields = Map.count expectedFields then - // return DRecord(aliasTypeName, typeName, VT.typeArgsTODO, fields) - // else - // let expectedFields = Map.keys expectedFields - // let fieldName = - // Seq.find (fun k -> not (Map.containsKey k fields)) expectedFields - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionMissingField(typeName, fieldName)) - - - // | ERecordUpdate(_, baseRecord, updates) -> - // // CLEANUP refactor this impl - // // namely, focus more on the `fields` and don't pass around DRecord so much - - // let! baseRecord = eval state baseRecord - // match baseRecord with - // | DRecord(typeName, _, typ, _) -> - // let typeStr = FQTypeName.toString typeName - // let types = ExecutionState.availableTypes state - - // let! (_, _, expected) = recordMaybe callStack types typeName - // let expectedFields = Map expected - // return! - // updates - // |> NEList.toList - // |> Ply.List.foldSequentially - // (fun record (fieldName, expr) -> - // uply { - // let! dv = eval state expr - - // match record, fieldName, dv with - // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" - // | _, _, _ when not (Map.containsKey fieldName expectedFields) -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionFieldDoesntExist( - // typeName, - // fieldName - // )) - - // | DRecord(typeName, original, _, m), fieldName, dv -> - // let fieldType = Map.findUnsafe fieldName expectedFields - - // let context = - // TypeChecker.RecordField(typeName, fieldName, fieldType) - - // match! TypeChecker.unify context types Map.empty fieldType dv with - // | Ok() -> - // return DRecord(typeName, original, typ, Map.add fieldName dv m) - // | Error rte -> return raiseRTE callStack rte - - // | _ -> - // return - // errStr - // callStack - // $"Expected a record but {typeStr} is something else" - // }) - // baseRecord - // | _ -> return errStr callStack "Expected a record in record update" - - // | EDict(_, fields) -> - // let! fields = - // fields - // |> Ply.List.mapSequentially (fun (k, v) -> - // uply { - // let! v = eval state v - // return (k, v) - // }) - // return TypeChecker.DvalCreator.dict ValueType.Unknown fields - - | EFnName(_, name) -> return DFnVal(NamedFn name) - - | EApply(_, fnTarget, typeArgs, exprs) -> - match! eval state fnTarget with - | DFnVal fnVal -> - let! args = Ply.NEList.mapSequentially (eval state) exprs - return! applyFnVal state fnVal typeArgs args - | other -> - return - errStr - callStack - $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" - - - // | EFieldAccess(_, e, fieldName) -> - // let! obj = eval state e - - // if fieldName = "" then - // return errStr callStack "Field name is empty" - // else - // match obj with - // | DRecord(_, typeName, _, fields) -> - // match Map.find fieldName fields with - // | Some v -> return v - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.FieldAccessFieldDoesntExist(typeName, fieldName)) - // | DDB _ -> - // let msg = - // $"Attempting to access field '{fieldName}' of a Datastore " - // + "(use `DB.*` standard library functions to interact with Datastores. " - // + "Field access only work with records)" - // return errStr callStack msg - // | _ -> - - // return - // ExecutionError.raise - // callStack - // (ExecutionError.FieldAccessNotRecord(Dval.toValueType obj, fieldName)) - - - // | ELambda(_, parameters, body) -> - // // It is the responsibility of wherever executes the DBlock to pass in - // // args and execute the body. - // return - // DFnVal( - // Lambda - // { typeSymbolTable = state.typeSymbolTable - // symtable = state.symbolTable - // parameters = parameters - // body = body } - // ) - - - // | EMatch(_, matchExpr, cases) -> - // /// Does the dval 'match' the given pattern? - // /// - // /// Returns: - // /// - whether or not the expr 'matches' the pattern - // /// - new vars (name * value) - // let rec checkPattern - // (dv : Dval) - // (pattern : MatchPattern) - // : Ply> = - // uply { - // // CLEANUP things down the line assume that the `id` in the callStack is an _Expression_ ID. - // // It might be nice to also allow for MP IDs. This would require a change in the callStack here. - // // let state = stateWithUpdatedCallStack (MatchPattern.toID pattern) - // // let callStack = state.tracing.callStack - - // let errWrongType expected = - // raiseExeRTE - // callStack - // (ExecutionError.MatchExprPatternWrongType(expected, dv)) - - // match pattern with - // | MPUnit(_) -> - // match dv with - // | DUnit -> return true, [] - // | _ -> return! errWrongType "Unit" - - // | MPBool(_, pb) -> - // match dv with - // | DBool db -> return (db = pb), [] - // | _ -> return! errWrongType "Bool" - - // | MPInt8(_, pi) -> - // match dv with - // | DInt8 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int8" - // | MPUInt8(_, pi) -> - // match dv with - // | DUInt8 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt8" - // | MPInt16(_, pi) -> - // match dv with - // | DInt16 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int16" - // | MPUInt16(_, pi) -> - // match dv with - // | DUInt16 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt16" - // | MPInt32(_, pi) -> - // match dv with - // | DInt32 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int32" - // | MPUInt32(_, pi) -> - // match dv with - // | DUInt32 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt32" - // | MPInt64(_, pi) -> - // match dv with - // | DInt64 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int64" - // | MPUInt64(_, pi) -> - // match dv with - // | DUInt64 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt64" - // | MPInt128(_, pi) -> - // match dv with - // | DInt128 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int128" - // | MPUInt128(_, pi) -> - // match dv with - // | DUInt128 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt128" - - // | MPFloat(_, pf) -> - // match dv with - // | DFloat df -> return (df = pf), [] - // | _ -> return! errWrongType "Float" - - // | MPChar(_, pc) -> - // match dv with - // | DChar dc -> return (dc = pc), [] - // | _ -> return! errWrongType "Char" - // | MPString(_, ps) -> - // match dv with - // | DString ds -> return (ds = ps), [] - // | _ -> return! errWrongType "String" - - // | MPEnum(_, caseName, fieldPats) -> - // match dv with - // | DEnum(_dTypeName, _oTypeName, _typeArgsDEnumTODO, dCaseName, dFields) -> - // if caseName <> dCaseName then - // return false, [] - // else - // let dvFieldLength = List.length dFields - // match fieldPats with - // // wildcard - // | [ MPVariable(_, "_") ] when dvFieldLength > 0 -> return true, [] - // | _ -> - // let patFieldLength = List.length fieldPats - // if dvFieldLength <> patFieldLength then - // return! - // raiseExeRTE - // callStack - // (ExecutionError.MatchExprEnumPatternWrongCount( - // dCaseName, - // patFieldLength, - // dvFieldLength - // )) - // else - // let! (passResults, newVarResults) = - // List.zip dFields fieldPats - // |> Ply.List.mapSequentially (fun (dv, pat) -> - // checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - - // | _dv -> return! errWrongType caseName - - - // | MPTuple(_, firstPat, secondPat, theRestPat) -> - // let allPatterns = firstPat :: secondPat :: theRestPat - - // match dv with - // | DTuple(first, second, theRest) -> - // let allVals = first :: second :: theRest - - // if List.length allVals = List.length allPatterns then - // let! (passResults, newVarResults) = - // List.zip allVals allPatterns - // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - // else - // return false, [] - // | _ -> - // // TODO: specify length? - // return! errWrongType "Tuple" - - - // | MPListCons(_, headPat, tailPat) -> - // match dv with - // | DList(_, []) -> return false, [] - // | DList(vt, headVal :: tailVals) -> - // let! (headPass, headVars) = checkPattern headVal headPat - // let! (tailPass, tailVars) = - // checkPattern - // (TypeChecker.DvalCreator.list callStack vt tailVals) - // tailPat - - // let allSubVars = headVars @ tailVars - // let pass = headPass && tailPass - // return pass, allSubVars - // | _ -> return! errWrongType "List" - - // | MPList(_, pats) -> - // match dv with - // | DList(_, vals) -> - // if List.length vals = List.length pats then - // let! (passResults, newVarResults) = - // List.zip vals pats - // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - // else - // return false, [] - // | _ -> return! errWrongType "List" - - // | MPVariable(_, varName) -> return true, [ (varName, dv) ] - // } - - - // // The value we're matching against - // let! matchVal = eval state matchExpr - - // let mutable matchResult = None - - // for case in NEList.toList cases do - // if Option.isSome matchResult then - // () - // else - // let! passesPattern, newDefs = checkPattern matchVal case.pat - // let newSymtable = - // Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - // let state = { state with symbolTable = newSymtable } - // let! passesWhenCondition = - // uply { - // match case.whenCondition with - // | Some whenCondition when passesPattern -> - // match! eval state whenCondition with - // | DBool b -> return b - // | _ -> return errStr callStack "When condition should be a boolean" - // | _ -> return true - // } - // if passesPattern && passesWhenCondition then - // let! r = eval state case.rhs - // matchResult <- Some r - - // match matchResult with - // | Some r -> return r - // | None -> - // return! raiseExeRTE callStack (ExecutionError.MatchExprUnmatched matchVal) - - - // | EIf(_, cond, thenBody, elseBody) -> - // match! eval state cond with - // | DBool false -> - // match elseBody with - // | None -> return DUnit - // | Some eb -> return! eval state eb - // | DBool true -> return! eval state thenBody - // | _ -> return errStr callStack "If only supports Booleans" - - - // | EOr(_, left, right) -> - // match! eval state left with - // | DBool true -> return DBool true - // | DBool false -> - // match! eval state right with - // | DBool _ as b -> return b - // | _ -> return errStr callStack "|| only supports Booleans" - // | _ -> return errStr callStack "|| only supports Booleans" - - - // | EAnd(_, left, right) -> - // match! eval state left with - // | DBool false -> return DBool false - // | DBool true -> - // match! eval state right with - // | DBool _ as b -> return b - // | _ -> return errStr callStack "&& only supports Booleans" - // | _ -> return errStr callStack "&& only supports Booleans" - - - // | EEnum(_, sourceTypeName, caseName, fields) -> - // let types = ExecutionState.availableTypes state - - // let! (resolvedTypeName, _, cases) = enumMaybe callStack types sourceTypeName - // let case = cases |> NEList.find (fun c -> c.name = caseName) - - // match case with - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.EnumConstructionCaseNotFound(sourceTypeName, caseName)) - - // | Some case -> - // if case.fields.Length <> fields.Length then - // let msg = - // $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" - // return errStr callStack msg - // else - // let! (fields : List) = - // Ply.List.foldSequentiallyWithIndex - // (fun - // fieldIndex - // fieldsSoFar - // ((enumFieldType : TypeReference), fieldExpr) -> - // uply { - // let! v = eval state fieldExpr - - // let context = - // TypeChecker.EnumField( - // sourceTypeName, - // case.name, - // fieldIndex, - // List.length fields, - // enumFieldType - // ) - - // // VTTODO: we should be passing in a proper tst, not Map.empty - right? - // match! - // TypeChecker.unify context types Map.empty enumFieldType v - // with - // | Ok() -> return (List.append fieldsSoFar [ v ]) - // | Error rte -> return raiseRTE callStack rte - // }) - // [] - // (List.zip case.fields fields) - - // return! - // TypeChecker.DvalCreator.enum - // resolvedTypeName - // sourceTypeName - // caseName - // fields - - | EError(_, rte, exprs) -> - let! (_ : List) = Ply.List.mapSequentially (eval state) exprs - return raiseRTE callStack rte + if counter >= instructions.Length then + // is this OK? + return vmState.registers[resultReg] + else + let instruction = instructions[counter] + + match instruction with + | Return reg -> return vmState.registers[reg] + + // `1L` -> next register + | LoadVal(reg, value) -> + vmState.registers[reg] <- value + return! execute state vmState instructions resultReg (counter + 1) + + // `let x = 1` + | SetVar(varName, loadFrom) -> + let value = vmState.registers[loadFrom] + let vmState = + { vmState with variables = Map.add varName value vmState.variables } + return! execute state vmState instructions resultReg (counter + 1) + + // later, `x` + | GetVar(loadTo, varName) -> + let value = Map.find varName vmState.variables |> Option.defaultValue DUnit // TODO + vmState.registers[loadTo] <- value + return! execute state vmState instructions resultReg (counter + 1) + + + // `add (increment 1L) (3L)` and store results in `resultReg` + // At this point, the 'increment' has already been evaluated. + // But maybe that's something we should change, (CLEANUP) + // so that we don't execute things until they're needed + | Apply(resultReg, thingToCallReg, typeArgs, argRegs) -> + let args = argRegs |> NEList.map (fun r -> vmState.registers[r]) + let thingToCall = vmState.registers[thingToCallReg] + let! result = call state thingToCall typeArgs args + vmState.registers[resultReg] <- result + return! execute state vmState instructions resultReg (counter + 1) + + | AddItemToList(listReg, itemToAddReg) -> + match vmState.registers[listReg] with + | DList(vt, list) -> + // TODO: type checking of item-add; adjust vt + let itemToAdd = vmState.registers[itemToAddReg] + vmState.registers[listReg] <- DList(vt, list @ [ itemToAdd ]) + return! execute state vmState instructions resultReg (counter + 1) + | _ -> return DString "TODO can't operate list-add to a non-list" + + | Fail _rte -> return DUnit // TODO } -and applyFnVal +and call (state : ExecutionState) - (fnVal : FnValImpl) + (thingToCall : Dval) (typeArgs : List) (args : NEList) - : DvalTask = - match fnVal with - //| Lambda l -> executeLambda state l args - | NamedFn fn -> callFn state fn typeArgs args - -// and executeLambda -// (state : ExecutionState) -// (l : LambdaImpl) -// (args : NEList) -// : DvalTask = - -// // One of the reasons to take a separate list of params and args is to -// // provide this error message here. We don't have this information in -// // other places, and the alternative is just to provide incompletes -// // with no context -// let expectedLength = NEList.length l.parameters -// let actualLength = NEList.length args -// if expectedLength <> actualLength then -// raiseRTE -// state.tracing.callStack -// (RuntimeError.oldError -// $"Expected {expectedLength} arguments, got {actualLength}") - -// else -// let checkPattern' = checkPattern state.tracing.callStack - -// let paramSyms = -// NEList.map2 checkPattern' args l.parameters -// |> NEList.toList -// |> List.flatten -// |> Map - -// let state = -// { state with symbolTable = Map.mergeFavoringRight l.symtable paramSyms } - -// eval state l.body - -and callFn - (state : ExecutionState) - (fnToCall : FQFnName.FQFnName) - (typeArgs : List) - (args : NEList) - : DvalTask = + : Ply = uply { - let! fn = - match fnToCall with - | FQFnName.Builtin std -> - Map.find std state.builtins.fns |> Option.map builtInFnToFn |> Ply - - | FQFnName.Package pkg -> - uply { - let! fn = state.packageManager.getFn pkg - return Option.map packageFnToFn fn - } - - match fn with - | Some fn -> - let expectedTypeParams = List.length fn.typeParams - let expectedArgs = NEList.length fn.parameters - - let actualTypeArgs = List.length typeArgs - let actualArgs = NEList.length args - - if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then - ExecutionError.raise - state.tracing.callStack - (ExecutionError.WrongNumberOfFnArgs( - fnToCall, - expectedTypeParams, - expectedArgs, - actualTypeArgs, - actualArgs - )) - - let state = - let boundArgs = - NEList.map2 (fun (p : Param) actual -> (p.name, actual)) fn.parameters args - |> NEList.toList - |> Map - { state with - symbolTable = Map.mergeFavoringRight state.symbolTable boundArgs } - - let state = - let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map - { state with - typeSymbolTable = - Map.mergeFavoringRight state.typeSymbolTable newlyBoundTypeArgs } - - return! execFn state fnToCall fn typeArgs args + match thingToCall with + | DFnVal(NamedFn fnName) -> + let! fn = + match fnName with + | FQFnName.Builtin std -> + Map.find std state.builtins.fns |> Option.map builtInFnToFn |> Ply + + | FQFnName.Package pkg -> + uply { + let! fn = state.packageManager.getFn pkg + return Option.map packageFnToFn fn + } - | None -> - // Functions which aren't available in the runtime (for whatever reason) - // may have results available in traces. (use case: inspecting a cloud-run trace locally) - let fnResult = - state.tracing.loadFnResult - (state.tracing.callStack.lastCalled, fnToCall) - args + match fn with + | Some fn -> + // let expectedTypeParams = List.length fn.typeParams + // let expectedArgs = NEList.length fn.parameters + + // let actualTypeArgs = List.length typeArgs + // let actualArgs = NEList.length args + + // if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then + // ExecutionError.raise + // state.tracing.callStack + // (ExecutionError.WrongNumberOfFnArgs( + // fnToCall, + // expectedTypeParams, + // expectedArgs, + // actualTypeArgs, + // actualArgs + // )) + + let state = + let boundArgs = + NEList.map2 + (fun (p : Param) actual -> (p.name, actual)) + fn.parameters + args + |> NEList.toList + |> Map + { state with + symbolTable = Map.mergeFavoringRight state.symbolTable boundArgs } + + let state = + let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map + { state with + typeSymbolTable = + Map.mergeFavoringRight state.typeSymbolTable newlyBoundTypeArgs } + + return! execFn state fnName fn typeArgs args - match fnResult with - | Some(result, _ts) -> return result | None -> - return - raiseRTE - state.tracing.callStack - (RuntimeError.oldError - $"Function {FQFnName.toString fnToCall} is not found") + // Functions which aren't available in the runtime (for whatever reason) + // may have results available in traces. (use case: inspecting a cloud-run trace locally) + let fnResult = + state.tracing.loadFnResult + (state.tracing.callStack.lastCalled, fnName) + args + + match fnResult with + | Some(result, _ts) -> return result + | None -> + return + raiseRTE + state.tracing.callStack + (RuntimeError.oldError + $"Function {FQFnName.toString fnName} is not found") + + | _ -> + debuG "thingToCall" thingToCall + return DUnit // TODO } - and execFn (state : ExecutionState) (fnDesc : FQFnName.FQFnName) @@ -1082,20 +224,35 @@ and execFn return result } - | PackageFunction(id, body) -> - // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? - // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) - let executionPoint = ExecutionPoint.Function(FQFnName.Package id) + | PackageFunction(_id, _body) -> + // // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? + // // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) + // let executionPoint = ExecutionPoint.Function(FQFnName.Package id) - state.tracing.traceExecutionPoint executionPoint + // state.tracing.traceExecutionPoint executionPoint - let state = - { state with - tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } + // // let state = + // // { state with + // // tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } - eval state body + // eval state body + Ply DUnit // TODO match! TypeChecker.checkFunctionReturnType types typeSymbolTable fn result with | Error rte -> return raiseRTE state.tracing.callStack rte | Ok() -> return result } + + + +let rec eval + (state : ExecutionState) + (instructions : Instructions) + (resultReg : Register) + : Ply = + let vmState = + { registers = Array.zeroCreate 256 // Or some other appropriate size + variables = Map.empty + callStack = [] } + + execute state vmState instructions resultReg 0 diff --git a/backend/src/LibExecution/NameResolutionError.fs b/backend/src/LibExecution/NameResolutionError.fs index 9dd2814e6a..9c3905a470 100644 --- a/backend/src/LibExecution/NameResolutionError.fs +++ b/backend/src/LibExecution/NameResolutionError.fs @@ -106,7 +106,7 @@ module RTE = //Error.toDT e |> RT.RuntimeError.nameResolutionError "TODO" |> RT.RuntimeError.oldError - // let fromRuntimeError (re : RT.RuntimeError) : Error = - // // TODO: this probably doesn't unwrap the type - // // see above function - // RT.RuntimeError.toDT re |> Error.fromDT +// let fromRuntimeError (re : RT.RuntimeError) : Error = +// // TODO: this probably doesn't unwrap the type +// // see above function +// RT.RuntimeError.toDT re |> Error.fromDT diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index c5537ea15f..1f4036a9cc 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -115,14 +115,14 @@ module FQFnName = type NameResolution<'a> = Result<'a, NameResolutionError.Error> -// type LetPattern = -// // | LPUnit of id -// // | LPTuple of -// // id * -// // first : LetPattern * -// // second : LetPattern * -// // theRest : List -// | LPVariable of id * name : string +type LetPattern = + | LPUnit of id + // | LPTuple of + // id * + // first : LetPattern * + // second : LetPattern * + // theRest : List + | LPVariable of id * name : string // /// Used for pattern matching in a match statement // type MatchPattern = @@ -154,13 +154,13 @@ type NameResolution<'a> = Result<'a, NameResolutionError.Error> // | MPVariable of id * string -// type BinaryOperation = -// | BinOpAnd -// | BinOpOr +type BinaryOperation = + | BinOpAnd + | BinOpOr -// type InfixFnName = -// | ArithmeticPlus -// | ArithmeticMinus +type InfixFnName = + | ArithmeticPlus + | ArithmeticMinus // | ArithmeticMultiply // | ArithmeticDivide // | ArithmeticModulo @@ -173,9 +173,9 @@ type NameResolution<'a> = Result<'a, NameResolutionError.Error> // | ComparisonNotEquals // | StringConcat -// type Infix = -// | InfixFnCall of InfixFnName -// | BinOp of BinaryOperation +type Infix = + | InfixFnCall of InfixFnName + | BinOp of BinaryOperation /// Darklang's available types /// - `Int64` @@ -194,36 +194,36 @@ type TypeReference = // | TInt32 // | TUInt32 | TInt64 - // | TUInt64 - // | TInt128 - // | TUInt128 +// | TUInt64 +// | TInt128 +// | TUInt128 - // | TFloat +// | TFloat - // | TChar - | TString +// | TChar +//| TString - // | TUuid - // | TDateTime +// | TUuid +// | TDateTime - // | TList of TypeReference - // | TTuple of TypeReference * TypeReference * List - // | TDict of TypeReference +// | TList of TypeReference +// | TTuple of TypeReference * TypeReference * List +// | TDict of TypeReference - //| TFn of arguments : NEList * ret : TypeReference +//| TFn of arguments : NEList * ret : TypeReference - //| TDB of TypeReference - // A named variable, eg `a` in `List`, matches anything +//| TDB of TypeReference +// A named variable, eg `a` in `List`, matches anything - // /// A type defined by a standard library module, a canvas/user, or a package - // /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` - // /// `typeArgs` is the list of type arguments, if any - // | TCustomType of - // // TODO: this reference should be by-hash - // NameResolution * - // typeArgs : List +// /// A type defined by a standard library module, a canvas/user, or a package +// /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` +// /// `typeArgs` is the list of type arguments, if any +// | TCustomType of +// // TODO: this reference should be by-hash +// NameResolution * +// typeArgs : List - //| TVariable of string +//| TVariable of string /// Expressions - the main part of the language. type Expr = @@ -250,7 +250,7 @@ type Expr = // /// A character is an Extended Grapheme Cluster (hence why we use a string). This // /// is equivalent to one screen-visible "character" in Unicode. // | EChar of id * string - | EString of id * List + //| EString of id * List // // -- Flow control -- @@ -270,26 +270,29 @@ type Expr = // // cases is a list to represent when a user starts typing but doesn't complete it // | EMatch of id * arg : Expr * cases : List - // // - // // Composed of binding pattern, the expression to create bindings for, - // // and the expression that follows, where the bound values are available - // // - // // - // // - // // let str = expr1 - // // expr2 - // // - // | ELet of id * LetPattern * Expr * Expr - // // Reference some local variable by name - // // - // // i.e. after a `let binding = value`, any use of `binding` - // | EVariable of id * string + // + // Composed of binding pattern, the expression to create bindings for, + // and the expression that follows, where the bound values are available + // + // + // + // let str = expr1 + // expr2 + // + | ELet of id * LetPattern * Expr * Expr + + // Reference some local variable by name + // + // i.e. after a `let binding = value`, any use of `binding` + | EVariable of id * string + + // // Access a field of some expression (e.g. `someExpr.fieldName`) // | EFieldAccess of id * Expr * string // -- Basic structures -- - // | EList of id * List + | EList of id * List // | EDict of id * List // | ETuple of id * Expr * Expr * List @@ -304,52 +307,52 @@ type Expr = /// Reference a function name, _usually_ so we can _apply_ it with args | EFnName of id * NameResolution - // // Composed of a parameters * the expression itself - // // The id in the varname list is the analysis id, used to get a livevalue - // // from the analysis engine - // | ELambda of id * pats : NEList * body : Expr - - // /// Calls upon an infix function - // | EInfix of id * Infix * lhs : Expr * rhs : Expr - - - // // -- References to custom types and data -- - // | EConstant of - // id * - // // TODO: this reference should be by-hash - // NameResolution - - // // See NameResolution comment above - // | ERecord of - // id * - // // TODO: this reference should be by-hash - // typeName : NameResolution * - // // User is allowed type `Name {}` even if that's an error - // fields : List - // | ERecordUpdate of id * record : Expr * updates : NEList - - // // Enums include `Some`, `None`, `Error`, `Ok`, as well - // // as user-defined enums. - // // - // /// Given an Enum type of: - // /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` - // /// , this is the expression - // /// `C (1, "title")` - // /// represented as - // /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` - // | EEnum of - // id * - // // TODO: this reference should be by-hash - // typeName : NameResolution * - // caseName : string * - // fields : List +// // Composed of a parameters * the expression itself +// // The id in the varname list is the analysis id, used to get a livevalue +// // from the analysis engine +// | ELambda of id * pats : NEList * body : Expr + +// /// Calls upon an infix function +// | EInfix of id * Infix * lhs : Expr * rhs : Expr + + +// // -- References to custom types and data -- +// | EConstant of +// id * +// // TODO: this reference should be by-hash +// NameResolution + +// // See NameResolution comment above +// | ERecord of +// id * +// // TODO: this reference should be by-hash +// typeName : NameResolution * +// // User is allowed type `Name {}` even if that's an error +// fields : List +// | ERecordUpdate of id * record : Expr * updates : NEList + +// // Enums include `Some`, `None`, `Error`, `Ok`, as well +// // as user-defined enums. +// // +// /// Given an Enum type of: +// /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` +// /// , this is the expression +// /// `C (1, "title")` +// /// represented as +// /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` +// | EEnum of +// id * +// // TODO: this reference should be by-hash +// typeName : NameResolution * +// caseName : string * +// fields : List //and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } -and StringSegment = - | StringText of string - | StringInterpolation of Expr +// and StringSegment = +// | StringText of string +// | StringInterpolation of Expr // and PipeExpr = // | EPipeVariable of id * string * List // value is an fn taking one or more arguments @@ -383,18 +386,18 @@ module Expr = // | EInt128(id, _) // | EUInt128(id, _) // | EChar(id, _) - | EString(id, _) + //| EString(id, _) // | EFloat(id, _, _, _) // | EConstant(id, _) - // | ELet(id, _, _, _) + | ELet(id, _, _, _) // | EIf(id, _, _, _) - // | EInfix(id, _, _, _) + //| EInfix(id, _, _, _) // | ELambda(id, _, _) | EFnName(id, _) // | EFieldAccess(id, _, _) - // | EVariable(id, _) + | EVariable(id, _) | EApply(id, _, _, _) - // | EList(id, _) + | EList(id, _) // | EDict(id, _) // | ETuple(id, _, _, _) // | EPipe(id, _, _) @@ -402,7 +405,7 @@ module Expr = // | ERecordUpdate(id, _, _) // | EEnum(id, _, _, _) // | EMatch(id, _, _) - -> id + -> id // module PipeExpr = // let toID (expr : PipeExpr) : id = diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 68faa37509..83dcb59629 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -5,6 +5,7 @@ open Prelude // Used for conversion functions module RT = RuntimeTypes +module VT = RT.ValueType module PT = ProgramTypes // module FQTypeName = @@ -85,31 +86,31 @@ module TypeReference = // | PT.TInt32 -> RT.TInt32 // | PT.TUInt32 -> RT.TUInt32 | PT.TInt64 -> RT.TInt64 - // | PT.TUInt64 -> RT.TUInt64 - // | PT.TInt128 -> RT.TInt128 - // | PT.TUInt128 -> RT.TUInt128 +// | PT.TUInt64 -> RT.TUInt64 +// | PT.TInt128 -> RT.TInt128 +// | PT.TUInt128 -> RT.TUInt128 - // | PT.TFloat -> RT.TFloat +// | PT.TFloat -> RT.TFloat - // | PT.TChar -> RT.TChar - | PT.TString -> RT.TString +// | PT.TChar -> RT.TChar +//| PT.TString -> RT.TString - // | PT.TList inner -> RT.TList(toRT inner) - // | PT.TTuple(first, second, theRest) -> - // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) - // | PT.TDict typ -> RT.TDict(toRT typ) +// | PT.TList inner -> RT.TList(toRT inner) +// | PT.TTuple(first, second, theRest) -> +// RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) +// | PT.TDict typ -> RT.TDict(toRT typ) - // | PT.TDateTime -> RT.TDateTime - // | PT.TUuid -> RT.TUuid - // | PT.TCustomType(typeName, typeArgs) -> - // RT.TCustomType( - // NameResolution.toRT FQTypeName.toRT typeName, - // List.map toRT typeArgs - // ) - // | PT.TVariable(name) -> RT.TVariable(name) - // | PT.TFn(paramTypes, returnType) -> - // RT.TFn(NEList.map toRT paramTypes, toRT returnType) - //| PT.TDB typ -> RT.TDB(toRT typ) +// | PT.TDateTime -> RT.TDateTime +// | PT.TUuid -> RT.TUuid +// | PT.TCustomType(typeName, typeArgs) -> +// RT.TCustomType( +// NameResolution.toRT FQTypeName.toRT typeName, +// List.map toRT typeArgs +// ) +// | PT.TVariable(name) -> RT.TVariable(name) +// | PT.TFn(paramTypes, returnType) -> +// RT.TFn(NEList.map toRT paramTypes, toRT returnType) +//| PT.TDB typ -> RT.TDB(toRT typ) // module InfixFnName = @@ -130,13 +131,29 @@ module TypeReference = // | PT.ComparisonNotEquals -> ("notEquals", 0) -// module LetPattern = -// let rec toRT (p : PT.LetPattern) : RT.LetPattern = -// match p with -// | PT.LPVariable(id, str) -> RT.LPVariable(id, str) -// | PT.LPUnit id -> RT.LPUnit id -// | PT.LPTuple(id, first, second, theRest) -> -// RT.LPTuple(id, toRT first, toRT second, List.map toRT theRest) +module LetPattern = + let rec toRT + (regCounter : int) + (p : PT.LetPattern) + (valueReg : RT.Register) + (instrs : RT.Instructions) + : (int * RT.Instructions) = + match p with + // No binding needed for unit pattern + // (would also be the case if we have a `_ignore` pattern later) + | PT.LPUnit _ -> (regCounter, instrs) + + // | LPTuple(_id, first, second, rest) -> + // // Destructure the tuple value into registers and compile sub-patterns + // let (regCounter, instrs) = compileLetPattern regCounter first valueReg instructions + // let (regCounter, instrs) = compileLetPattern regCounter second (valueReg + 1) instrs + // List.fold (fun (rc, instrs) pat -> compileLetPattern rc pat (valueReg + 2) instrs) (regCounter, instrs) rest + + | PT.LPVariable(_id, varName) -> + (regCounter + 1, instrs @ [ RT.SetVar(varName, valueReg) ]) + + + // module MatchPattern = @@ -169,198 +186,299 @@ module TypeReference = module Expr = - let rec toRT (e : PT.Expr) : RT.Expr = + let rec toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = match e with - | PT.EUnit id -> RT.EUnit id - - | PT.EBool(id, b) -> RT.EBool(id, b) - - // | PT.EInt8(id, num) -> RT.EInt8(id, num) - // | PT.EUInt8(id, num) -> RT.EUInt8(id, num) - // | PT.EInt16(id, num) -> RT.EInt16(id, num) - // | PT.EUInt16(id, num) -> RT.EUInt16(id, num) - // | PT.EInt32(id, num) -> RT.EInt32(id, num) - // | PT.EUInt32(id, num) -> RT.EUInt32(id, num) - | PT.EInt64(id, num) -> RT.EInt64(id, num) - // | PT.EUInt64(id, num) -> RT.EUInt64(id, num) - // | PT.EInt128(id, num) -> RT.EInt128(id, num) - // | PT.EUInt128(id, num) -> RT.EUInt128(id, num) - - // | PT.EFloat(id, sign, whole, fraction) -> - // let whole = if whole = "" then "0" else whole - // let fraction = if fraction = "" then "0" else fraction - // RT.EFloat(id, makeFloat sign whole fraction) - - // | PT.EChar(id, char) -> RT.EChar(id, char) - | PT.EString(id, segments) -> RT.EString(id, List.map stringSegmentToRT segments) - - - // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) - // | PT.EConstant(id, Error err) -> - // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - - // | PT.EVariable(id, var) -> RT.EVariable(id, var) - - // | PT.EFieldAccess(id, obj, fieldname) -> RT.EFieldAccess(id, toRT obj, fieldname) - - | PT.EApply(id, fnName, typeArgs, args) -> - RT.EApply( - id, - toRT fnName, - List.map TypeReference.toRT typeArgs, - NEList.map toRT args - ) - - | PT.EFnName(id, Ok name) -> RT.EFnName(id, FQFnName.toRT name) - | PT.EFnName(id, Error err) -> - RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - - // // CLEANUP tidy infix stuff - extract to another fn? - // | PT.EInfix(id, PT.InfixFnCall fnName, left, right) -> - // let (fn, version) = InfixFnName.toFnName fnName - // let name = RT.FQFnName.Builtin({ name = fn; version = version }) - // RT.EApply( - // id, - // RT.EFnName(id, name), - // [], - // NEList.ofList (toRT left) [ toRT right ] - // ) - // | PT.EInfix(id, PT.BinOp PT.BinOpAnd, left, right) -> - // RT.EAnd(id, toRT left, toRT right) - // | PT.EInfix(id, PT.BinOp PT.BinOpOr, left, right) -> - // RT.EOr(id, toRT left, toRT right) - - // | PT.ELambda(id, pats, body) -> - // RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) - - // | PT.ELet(id, pattern, rhs, body) -> - // RT.ELet(id, LetPattern.toRT pattern, toRT rhs, toRT body) - - // | PT.EIf(id, cond, thenExpr, elseExpr) -> - // RT.EIf(id, toRT cond, toRT thenExpr, elseExpr |> Option.map toRT) - - // | PT.EList(id, exprs) -> RT.EList(id, List.map toRT exprs) - - // | PT.ETuple(id, first, second, theRest) -> - // RT.ETuple(id, toRT first, toRT second, List.map toRT theRest) - - // | PT.ERecord(id, Ok typeName, fields) -> - // match fields with - // | [] -> - // let fields = fields |> List.map Tuple2.second |> List.map toRT - // RT.EError( - // id, - // RT.RuntimeError.oldError "Record must have at least one field", - // fields - // ) - // | head :: tail -> - // let fields = - // NEList.ofList head tail - // |> NEList.map (fun (name, expr) -> (name, toRT expr)) - // RT.ERecord(id, FQTypeName.toRT typeName, fields) - // | PT.ERecord(id, Error err, fields) -> - // RT.EError( - // id, - // err |> NameResolutionError.RTE.toRuntimeError, - // fields |> List.map Tuple2.second |> List.map toRT - // ) - - // | PT.ERecordUpdate(id, record, updates) -> - // RT.ERecordUpdate( - // id, - // toRT record, - // updates |> NEList.map (fun (fieldName, update) -> (fieldName, toRT update)) - // ) - - // | PT.EPipe(pipeID, expr1, rest) -> - // // Convert v |> fn1 a |> fn2 |> fn3 b c - // // into fn3 (fn2 (fn1 v a)) b c - // let folder (prev : RT.Expr) (next : PT.PipeExpr) : RT.Expr = - // let applyFn (expr : RT.Expr) (args : List) = - // let typeArgs = [] - // RT.EApply(pipeID, expr, typeArgs, NEList.ofList prev args) - - // match next with - // | PT.EPipeFnCall(id, Error err, _typeArgs, exprs) -> - // let err = NameResolutionError.RTE.toRuntimeError err - // let addlExprs = List.map toRT exprs - // RT.EError(id, err, prev :: addlExprs) - // | PT.EPipeFnCall(id, Ok fnName, typeArgs, exprs) -> - // RT.EApply( - // id, - // RT.EFnName(id, FQFnName.toRT fnName), - // List.map TypeReference.toRT typeArgs, - // exprs |> List.map toRT |> NEList.ofList prev - // ) - // | PT.EPipeInfix(id, PT.InfixFnCall fnName, expr) -> - // let (fn, version) = InfixFnName.toFnName fnName - // let name = PT.FQFnName.Builtin({ name = fn; version = version }) - // RT.EApply( - // id, - // RT.EFnName(id, FQFnName.toRT name), - // [], - // NEList.doubleton prev (toRT expr) - // ) - // // Binops work pretty naturally here - // | PT.EPipeInfix(id, PT.BinOp op, expr) -> - // match op with - // | PT.BinOpAnd -> RT.EAnd(id, prev, toRT expr) - // | PT.BinOpOr -> RT.EOr(id, prev, toRT expr) - // | PT.EPipeEnum(id, Ok typeName, caseName, fields) -> - // RT.EEnum( - // id, - // FQTypeName.toRT typeName, - // caseName, - // prev :: (List.map toRT fields) - // ) - // | PT.EPipeEnum(id, Error err, _caseName, fields) -> - // RT.EError( - // id, - // NameResolutionError.RTE.toRuntimeError err, - // prev :: (List.map toRT fields) - // ) - // | PT.EPipeVariable(id, name, exprs) -> - // applyFn (RT.EVariable(id, name)) (List.map toRT exprs) - // | PT.EPipeLambda(id, pats, body) -> - // applyFn (RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body)) [] - - // let init = toRT expr1 - // List.fold folder init rest - - // | PT.EMatch(id, mexpr, cases) -> - // match cases with - // | [] -> - // RT.EError( - // id, - // RT.RuntimeError.oldError "Match must have at least one case", - // [ toRT mexpr ] - // ) - // | head :: tail -> - // let cases = - // NEList.ofList head tail - // |> NEList.map (fun case -> - // let pattern = MatchPattern.toRT case.pat - // let whenCondition = Option.map toRT case.whenCondition - // let expr = toRT case.rhs - // let result : RT.MatchCase = - // { pat = pattern; whenCondition = whenCondition; rhs = expr } - // result) - - // RT.EMatch(id, toRT mexpr, cases) - - // | PT.EEnum(id, Ok typeName, caseName, fields) -> - // RT.EEnum(id, FQTypeName.toRT typeName, caseName, List.map toRT fields) - // | PT.EEnum(id, Error err, _caseName, fields) -> - // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, List.map toRT fields) - - // | PT.EDict(id, entries) -> - // RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) - - - and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment = - match segment with - | PT.StringText text -> RT.StringText text - | PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr) + | PT.EUnit _id -> (rc + 1, [ RT.LoadVal(rc, RT.DUnit) ], rc) + + | PT.EBool(_id, b) -> (rc + 1, [ RT.LoadVal(rc, RT.DBool b) ], rc) + + | PT.EInt64(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt64 num) ], rc) + + + | PT.EList(_id, items) -> + let listReg = rc + let init = (rc + 1, [ RT.LoadVal(listReg, RT.DList(VT.unknown, [])) ]) + + let (regCounter, instrs) = + items + |> List.fold + (fun (rc, instrs) item -> + let (newRc, itemInstrs, innerResultReg) = toRT rc item + (newRc, + instrs @ itemInstrs @ [ RT.AddItemToList(listReg, innerResultReg) ])) + init + + (regCounter, instrs, listReg) + + + // let x = 1 + | PT.ELet(_id, pat, expr, body) -> + // I should debug and breakpoint here to watch stuff. + + // eval the expr before we attempt to deconstruct with the LP + let (regCounter, exprInstrs, exprReg) = toRT rc expr + + // deconstruct the expr per the pat + // TODO: do we need a resultReg thing here? hmm. + let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg [] // why is this an empty list? + + // finally, get the instructions for the body + let (regCounter, bodyInstrs, bodyExprReg) = toRT regCounter body + + (regCounter, exprInstrs @ patInstrs @ bodyInstrs, bodyExprReg) + + + | PT.EVariable(_id, varName) -> + let reg = rc + (rc + 1, [ RT.GetVar(reg, varName) ], reg) + + + | PT.EFnName(_, Ok name) -> + let reg = rc + (rc + 1, [ RT.LoadVal(reg, RT.DFnVal(RT.NamedFn(FQFnName.toRT name))) ], reg) + + | PT.EFnName(_, Error _err) -> + // TODO improve + // hmm maybe we shouldn't fail yet here. + // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. + // maybe the 'value' here is (still) some unresolved name? + // (which should fail when we apply it) + (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) + + | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> + let (regCounter, thingToApplyInstrs, thingToApplyReg) = + // (usually, a fn name) + toRT rc thingToApplyExpr + // TODO: maybe one or both of these lists should be an `NEList`? + + // CLEANUP find a way to get rid of silly NEList stuff + let (regCounter, argInstrs, argRegs) = + let init = (regCounter, [], []) + + args + |> NEList.fold + (fun (rc, instrs, argResultRegs) arg -> + let (newRc, newInstrs, argResultReg) = toRT rc arg + (newRc, instrs @ newInstrs, argResultRegs @ [ argResultReg ])) + init + + let resultReg = regCounter + let callInstr = + RT.Apply( + resultReg, + thingToApplyReg, + List.map TypeReference.toRT typeArgs, + NEList.ofListUnsafe "" [] argRegs + ) + + (resultReg + 1, + thingToApplyInstrs @ argInstrs @ [ callInstr; RT.Return resultReg ], + resultReg) + + +// let rec toRT (e : PT.Expr) : RT.Instructions = +// match e with +// | PT.EUnit id -> +// //RT.EUnit id +// [ RT.LoadVar(id, RT.DUnit) ] + +// | PT.EBool(id, b) -> +// //RT.EBool(id, b) +// [ RT.LoadVar(id, RT.DBool b) ] + +// // | PT.EInt8(id, num) -> RT.EInt8(id, num) +// // | PT.EUInt8(id, num) -> RT.EUInt8(id, num) +// // | PT.EInt16(id, num) -> RT.EInt16(id, num) +// // | PT.EUInt16(id, num) -> RT.EUInt16(id, num) +// // | PT.EInt32(id, num) -> RT.EInt32(id, num) +// // | PT.EUInt32(id, num) -> RT.EUInt32(id, num) +// | PT.EInt64(id, num) -> +// //RT.EInt64(id, num) +// [ RT.LoadVar(id, RT.DInt64 num) ] +// // | PT.EUInt64(id, num) -> RT.EUInt64(id, num) +// // | PT.EInt128(id, num) -> RT.EInt128(id, num) +// // | PT.EUInt128(id, num) -> RT.EUInt128(id, num) + +// // | PT.EFloat(id, sign, whole, fraction) -> +// // let whole = if whole = "" then "0" else whole +// // let fraction = if fraction = "" then "0" else fraction +// // RT.EFloat(id, makeFloat sign whole fraction) + +// // | PT.EChar(id, char) -> RT.EChar(id, char) +// //| PT.EString(id, segments) -> RT.EString(id, List.map stringSegmentToRT segments) + + +// // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) +// // | PT.EConstant(id, Error err) -> +// // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) + +// // | PT.EVariable(id, var) -> RT.EVariable(id, var) + +// // | PT.EFieldAccess(id, obj, fieldname) -> RT.EFieldAccess(id, toRT obj, fieldname) + +// | PT.EApply(id, fnName, typeArgs, args) -> +// // RT.EApply( +// // id, +// // toRT fnName, +// // List.map TypeReference.toRT typeArgs, +// // NEList.map toRT args +// // ) +// let fnInstr = +// match fnName with +// | PT.EFnName(_, Ok name) -> RT.Call(id, FQFnName.toRT name, List.map TypeReference.toRT typeArgs, NEList.map (fun a -> 0) args) +// | _ -> failwith "Unsupported function name resolution" +// fnInstr :: (args |> NEList.toList |> List.map toRT |> List.concat) + +// | PT.EFnName(id, Ok name) -> RT.EFnName(id, FQFnName.toRT name) +// | PT.EFnName(id, Error err) -> +// RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) + +// // // CLEANUP tidy infix stuff - extract to another fn? +// // | PT.EInfix(id, PT.InfixFnCall fnName, left, right) -> +// // let (fn, version) = InfixFnName.toFnName fnName +// // let name = RT.FQFnName.Builtin({ name = fn; version = version }) +// // RT.EApply( +// // id, +// // RT.EFnName(id, name), +// // [], +// // NEList.ofList (toRT left) [ toRT right ] +// // ) +// // | PT.EInfix(id, PT.BinOp PT.BinOpAnd, left, right) -> +// // RT.EAnd(id, toRT left, toRT right) +// // | PT.EInfix(id, PT.BinOp PT.BinOpOr, left, right) -> +// // RT.EOr(id, toRT left, toRT right) + +// // | PT.ELambda(id, pats, body) -> +// // RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) + +// // | PT.ELet(id, pattern, rhs, body) -> +// // RT.ELet(id, LetPattern.toRT pattern, toRT rhs, toRT body) + +// // | PT.EIf(id, cond, thenExpr, elseExpr) -> +// // RT.EIf(id, toRT cond, toRT thenExpr, elseExpr |> Option.map toRT) + +// // | PT.EList(id, exprs) -> RT.EList(id, List.map toRT exprs) + +// // | PT.ETuple(id, first, second, theRest) -> +// // RT.ETuple(id, toRT first, toRT second, List.map toRT theRest) + +// // | PT.ERecord(id, Ok typeName, fields) -> +// // match fields with +// // | [] -> +// // let fields = fields |> List.map Tuple2.second |> List.map toRT +// // RT.EError( +// // id, +// // RT.RuntimeError.oldError "Record must have at least one field", +// // fields +// // ) +// // | head :: tail -> +// // let fields = +// // NEList.ofList head tail +// // |> NEList.map (fun (name, expr) -> (name, toRT expr)) +// // RT.ERecord(id, FQTypeName.toRT typeName, fields) +// // | PT.ERecord(id, Error err, fields) -> +// // RT.EError( +// // id, +// // err |> NameResolutionError.RTE.toRuntimeError, +// // fields |> List.map Tuple2.second |> List.map toRT +// // ) + +// // | PT.ERecordUpdate(id, record, updates) -> +// // RT.ERecordUpdate( +// // id, +// // toRT record, +// // updates |> NEList.map (fun (fieldName, update) -> (fieldName, toRT update)) +// // ) + +// // | PT.EPipe(pipeID, expr1, rest) -> +// // // Convert v |> fn1 a |> fn2 |> fn3 b c +// // // into fn3 (fn2 (fn1 v a)) b c +// // let folder (prev : RT.Expr) (next : PT.PipeExpr) : RT.Expr = +// // let applyFn (expr : RT.Expr) (args : List) = +// // let typeArgs = [] +// // RT.EApply(pipeID, expr, typeArgs, NEList.ofList prev args) + +// // match next with +// // | PT.EPipeFnCall(id, Error err, _typeArgs, exprs) -> +// // let err = NameResolutionError.RTE.toRuntimeError err +// // let addlExprs = List.map toRT exprs +// // RT.EError(id, err, prev :: addlExprs) +// // | PT.EPipeFnCall(id, Ok fnName, typeArgs, exprs) -> +// // RT.EApply( +// // id, +// // RT.EFnName(id, FQFnName.toRT fnName), +// // List.map TypeReference.toRT typeArgs, +// // exprs |> List.map toRT |> NEList.ofList prev +// // ) +// // | PT.EPipeInfix(id, PT.InfixFnCall fnName, expr) -> +// // let (fn, version) = InfixFnName.toFnName fnName +// // let name = PT.FQFnName.Builtin({ name = fn; version = version }) +// // RT.EApply( +// // id, +// // RT.EFnName(id, FQFnName.toRT name), +// // [], +// // NEList.doubleton prev (toRT expr) +// // ) +// // // Binops work pretty naturally here +// // | PT.EPipeInfix(id, PT.BinOp op, expr) -> +// // match op with +// // | PT.BinOpAnd -> RT.EAnd(id, prev, toRT expr) +// // | PT.BinOpOr -> RT.EOr(id, prev, toRT expr) +// // | PT.EPipeEnum(id, Ok typeName, caseName, fields) -> +// // RT.EEnum( +// // id, +// // FQTypeName.toRT typeName, +// // caseName, +// // prev :: (List.map toRT fields) +// // ) +// // | PT.EPipeEnum(id, Error err, _caseName, fields) -> +// // RT.EError( +// // id, +// // NameResolutionError.RTE.toRuntimeError err, +// // prev :: (List.map toRT fields) +// // ) +// // | PT.EPipeVariable(id, name, exprs) -> +// // applyFn (RT.EVariable(id, name)) (List.map toRT exprs) +// // | PT.EPipeLambda(id, pats, body) -> +// // applyFn (RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body)) [] + +// // let init = toRT expr1 +// // List.fold folder init rest + +// // | PT.EMatch(id, mexpr, cases) -> +// // match cases with +// // | [] -> +// // RT.EError( +// // id, +// // RT.RuntimeError.oldError "Match must have at least one case", +// // [ toRT mexpr ] +// // ) +// // | head :: tail -> +// // let cases = +// // NEList.ofList head tail +// // |> NEList.map (fun case -> +// // let pattern = MatchPattern.toRT case.pat +// // let whenCondition = Option.map toRT case.whenCondition +// // let expr = toRT case.rhs +// // let result : RT.MatchCase = +// // { pat = pattern; whenCondition = whenCondition; rhs = expr } +// // result) + +// // RT.EMatch(id, toRT mexpr, cases) + +// // | PT.EEnum(id, Ok typeName, caseName, fields) -> +// // RT.EEnum(id, FQTypeName.toRT typeName, caseName, List.map toRT fields) +// // | PT.EEnum(id, Error err, _caseName, fields) -> +// // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, List.map toRT fields) + +// // | PT.EDict(id, entries) -> +// // RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) + + +// and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment = +// match segment with +// | PT.StringText text -> RT.StringText text +// | PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr) // module Const = @@ -442,7 +560,11 @@ module PackageFn = let toRT (f : PT.PackageFn.PackageFn) : RT.PackageFn.PackageFn = { id = f.id - body = f.body |> Expr.toRT + body = + let initialRegCounter = + // TODO: OK? depends if we try to 'inline' package fns or not... + 0 + Expr.toRT initialRegCounter f.body typeParams = f.typeParams parameters = f.parameters |> NEList.map Parameter.toRT returnType = f.returnType |> TypeReference.toRT } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index a857253e0e..591cc51187 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -164,9 +164,9 @@ type KnownType = // | KTUuid // | KTDateTime - // /// let empty = [] // KTList Unknown - // /// let intList = [1] // KTList (ValueType.Known KTInt64) - // | KTList of ValueType + /// let empty = [] // KTList Unknown + /// let intList = [1] // KTList (ValueType.Known KTInt64) + | KTList of ValueType // /// Intuitively, since Dvals generate KnownTypes, you would think that we can // /// use KnownTypes in a KTTuple. @@ -192,20 +192,20 @@ type KnownType = /// `[z1, z2]` is allowed now but might not be allowed later | KTFn of args : NEList * ret : ValueType - // /// At time of writing, all DBs are of a specific type, and DBs may only be - // /// referenced directly, but we expect to eventually allow references to DBs - // /// where the type may be unknown - // /// List.head ([]: List>) // KTDB (Unknown) - // | KTDB of ValueType +// /// At time of writing, all DBs are of a specific type, and DBs may only be +// /// referenced directly, but we expect to eventually allow references to DBs +// /// where the type may be unknown +// /// List.head ([]: List>) // KTDB (Unknown) +// | KTDB of ValueType - // /// let n = None // type args: [Unknown] - // /// let s = Some(5) // type args: [Known KTInt64] - // /// let o = Ok (5) // type args: [Known KTInt64, Unknown] - // /// let e = Error ("str") // type args: [Unknown, Known KTString] - // | KTCustomType of FQTypeName.FQTypeName * typeArgs : List +// /// let n = None // type args: [Unknown] +// /// let s = Some(5) // type args: [Known KTInt64] +// /// let o = Ok (5) // type args: [Known KTInt64, Unknown] +// /// let e = Error ("str") // type args: [Unknown, Known KTString] +// | KTCustomType of FQTypeName.FQTypeName * typeArgs : List - // /// let myDict = {} // KTDict Unknown - // | KTDict of ValueType +// /// let myDict = {} // KTDict Unknown +// | KTDict of ValueType /// Represents the actual type of a Dval /// @@ -281,7 +281,7 @@ module ValueType = // | KTUuid -> "Uuid" // | KTDateTime -> "DateTime" - // | KTList inner -> $"List<{toString inner}>" + | KTList inner -> $"List<{toString inner}>" // | KTDict inner -> $"Dict<{toString inner}>" // | KTTuple(first, second, theRest) -> // first :: second :: theRest @@ -303,7 +303,7 @@ module ValueType = | KTFn(args, ret) -> NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " - //| KTDB inner -> $"DB<{toString inner}>" + //| KTDB inner -> $"DB<{toString inner}>" let rec private mergeKnownTypes @@ -424,6 +424,9 @@ module ValueType = // | MPVariable of id * string +// ------------ +// Instructions ("bytecode") +// ------------ type NameResolution<'a> = Result<'a, RuntimeError> and TypeReference = @@ -444,7 +447,7 @@ and TypeReference = | TString // | TUuid // | TDateTime - // | TList of TypeReference + | TList of TypeReference // | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference // | TDB of TypeReference @@ -479,82 +482,128 @@ and TypeReference = | TString // | TUuid // | TDateTime - -> true + -> true - // | TList t -> isConcrete t + | TList t -> isConcrete t // | TTuple(t1, t2, ts) -> // isConcrete t1 && isConcrete t2 && List.forall isConcrete ts | TFn(ts, t) -> NEList.forall isConcrete ts && isConcrete t - // | TDB t -> isConcrete t - // | TCustomType(_, ts) -> List.forall isConcrete ts - // | TDict t -> isConcrete t + // | TDB t -> isConcrete t + // | TCustomType(_, ts) -> List.forall isConcrete ts + // | TDict t -> isConcrete t - //| TVariable _-> false + //| TVariable _-> false isConcrete this +and Register = int // TODO: unit of measure -// Expressions here are runtime variants of the AST in ProgramTypes, having had -// superfluous information removed. -and Expr = - | EUnit of id - - | EBool of id * bool - - // | EInt8 of id * int8 - // | EUInt8 of id * uint8 - // | EInt16 of id * int16 - // | EUInt16 of id * uint16 - // | EInt32 of id * int32 - // | EUInt32 of id * uint32 - | EInt64 of id * int64 - // | EUInt64 of id * uint64 - // | EInt128 of id * System.Int128 - // | EUInt128 of id * System.UInt128 - - // | EFloat of id * double - - // | EChar of id * string - | EString of id * List - - // // flow control - // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option - // | EMatch of id * Expr * NEList - // | EAnd of id * lhs : Expr * rhs : Expr - // | EOr of id * lhs : Expr * rhs : Expr - - // // declaring and referencing vars - // | ELet of id * LetPattern * Expr * Expr - // | EVariable of id * string - // | EFieldAccess of id * Expr * string - - // calling fns and other things - | EFnName of id * FQFnName.FQFnName - | EApply of id * Expr * typeArgs : List * args : NEList - //| ELambda of id * pats : NEList * body : Expr - - // // structures - // | EList of id * List - // | ETuple of id * Expr * Expr * List - // | EDict of id * List - - // // working with custom types - // | EConstant of id * FQConstantName.FQConstantName - // | ERecord of id * FQTypeName.FQTypeName * NEList - // | ERecordUpdate of id * record : Expr * updates : NEList - // | EEnum of id * FQTypeName.FQTypeName * caseName : string * fields : List - - // A runtime error. This is included so that we can allow the program to run in the - // presence of compile-time errors (which are converted to this error). We may - // adapt this to include more information as we go. This list of exprs is the - // subexpressions to evaluate before evaluating the error. - | EError of id * RuntimeError * List - -// and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } - -and StringSegment = - | StringText of string - | StringInterpolation of Expr +// TODO: consider if each of these should include the Expr ID that they came from +// +// Would Expr ID be enough? +// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) +and Instruction = + /// Push a ("constant") value into a register + | LoadVal of loadTo : Register * Dval + + /// Apply some args (and maybe type args) to something + /// (a named function, or lambda, etc) + | Apply of + putResultIn : Register * + thingToApply : Register * + typeArgs : List * + args : NEList + + /// Loads the value of a register into a variable + | SetVar of varName : string * loadFrom : Register + + /// Stores the value of a variable to a register + | GetVar of loadTo : Register * varName : string + + // | Jump of jumpTo: Register + // | JumpIfFalse of condition: Register * jumpTo: Register + + /// Add an item to an existing list + /// , and type-check to make sure it matches the ValueType of that list + /// + /// Note: lists are _created_ with `LoadVal` + /// (always an empty list of unknown type, to ensure type safety) + | AddItemToList of listRegister : Register * itemToAdd : Register + + /// Return whatever's in the noted register + /// (usually relevant only for branching logic like `if`, `match`) + | Return of from : Register + + /// Fail if this is hit (basically "raise an exception") + | Fail of RuntimeError + + +and Instructions = List +and InstructionsWithContext = + // (rc, instructions, result register) + (int * Instructions * Register) + +// // Expressions here are runtime variants of the AST in ProgramTypes, having had +// // superfluous information removed. +// and Expr = +// | EUnit of id + +// | EBool of id * bool + +// // | EInt8 of id * int8 +// // | EUInt8 of id * uint8 +// // | EInt16 of id * int16 +// // | EUInt16 of id * uint16 +// // | EInt32 of id * int32 +// // | EUInt32 of id * uint32 +// | EInt64 of id * int64 +// // | EUInt64 of id * uint64 +// // | EInt128 of id * System.Int128 +// // | EUInt128 of id * System.UInt128 + +// // | EFloat of id * double + +// // | EChar of id * string +// | EString of id * List + +// // // flow control +// // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option +// // | EMatch of id * Expr * NEList +// // | EAnd of id * lhs : Expr * rhs : Expr +// // | EOr of id * lhs : Expr * rhs : Expr + +// // // declaring and referencing vars +// // | ELet of id * LetPattern * Expr * Expr +// // | EVariable of id * string +// // | EFieldAccess of id * Expr * string + +// // calling fns and other things +// | EFnName of id * FQFnName.FQFnName +// | EApply of id * Expr * typeArgs : List * args : NEList +// //| ELambda of id * pats : NEList * body : Expr + +// // // structures +// // | EList of id * List +// // | ETuple of id * Expr * Expr * List +// // | EDict of id * List + +// // // working with custom types +// // | EConstant of id * FQConstantName.FQConstantName +// // | ERecord of id * FQTypeName.FQTypeName * NEList +// // | ERecordUpdate of id * record : Expr * updates : NEList +// // | EEnum of id * FQTypeName.FQTypeName * caseName : string * fields : List + +// // A runtime error. This is included so that we can allow the program to run in the +// // presence of compile-time errors (which are converted to this error). We may +// // adapt this to include more information as we go. This list of exprs is the +// // subexpressions to evaluate before evaluating the error. +// | EError of id * RuntimeError * List + +// // and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } + +// and StringSegment = +// | StringText of string +// | StringInterpolation of Expr and DvalMap = Map @@ -604,8 +653,8 @@ and [] Dval = // | DDateTime of DarkDateTime.T // | DUuid of System.Guid - // // Compound types - // | DList of ValueType * List + // Compound types + | DList of ValueType * List // | DTuple of first : Dval * second : Dval * theRest : List // | DDict of // // This is the type of the _values_, not the keys. Once users can specify the @@ -634,8 +683,8 @@ and [] Dval = // Functions | DFnVal of FnValImpl // VTTODO I'm not sure how ValueType fits in here - // // References - // | DDB of name : string +// // References +// | DDB of name : string and DvalTask = Ply @@ -735,31 +784,31 @@ module CallStack = module RuntimeError = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error + // let typeName = + // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error -// let toDT (RuntimeError e : RuntimeError) : Dval = e + // let toDT (RuntimeError e : RuntimeError) : Dval = e -// let fromDT (dv : Dval) : RuntimeError = RuntimeError dv + // let fromDT (dv : Dval) : RuntimeError = RuntimeError dv -// let case (caseName : string) (fields : List) : RuntimeError = -// DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError + // let case (caseName : string) (fields : List) : RuntimeError = + // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError -// let cliError field = case "CliError" [ field ] + // let cliError field = case "CliError" [ field ] -// let nameResolutionError field = case "NameResolutionError" [ field ] + // let nameResolutionError field = case "NameResolutionError" [ field ] -// let typeCheckerError field = case "TypeCheckerError" [ field ] + // let typeCheckerError field = case "TypeCheckerError" [ field ] -// let jsonError field = case "JsonError" [ field ] + // let jsonError field = case "JsonError" [ field ] -// let sqlCompilerRuntimeError (internalError : RuntimeError) = -// case "SqlCompilerRuntimeError" [ toDT internalError ] + // let sqlCompilerRuntimeError (internalError : RuntimeError) = + // case "SqlCompilerRuntimeError" [ toDT internalError ] -// let executionError field = case "ExecutionError" [ field ] + // let executionError field = case "ExecutionError" [ field ] -// let intError field = case "IntError" [ field ] + // let intError field = case "IntError" [ field ] // TODO remove all usages of this in favor of better error cases @@ -832,49 +881,49 @@ type Deprecation<'name> = // type T = { typeParams : List; definition : Definition } -// Functions for working with Dark runtime expressions -module Expr = - let toID (expr : Expr) : id = - match expr with - | EUnit id - - | EBool(id, _) - - // | EInt8(id, _) - // | EUInt8(id, _) - // | EInt16(id, _) - // | EUInt16(id, _) - // | EInt32(id, _) - // | EUInt32(id, _) - | EInt64(id, _) - // | EUInt64(id, _) - // | EInt128(id, _) - // | EUInt128(id, _) - - // | EFloat(id, _) - - // | EChar(id, _) - | EString(id, _) - - // | EConstant(id, _) - // | EVariable(id, _) - // | EFieldAccess(id, _, _) - // | ELambda(id, _, _) - // | ELet(id, _, _, _) - // | EIf(id, _, _, _) - | EApply(id, _, _, _) - | EFnName(id, _) - // | EList(id, _) - // | ETuple(id, _, _, _) - // | ERecord(id, _, _) - // | ERecordUpdate(id, _, _) - // | EDict(id, _) - // | EEnum(id, _, _, _) - // | EMatch(id, _, _) - | EError(id, _, _) - // | EAnd(id, _, _) - // | EOr(id, _, _) - -> id +// // Functions for working with Dark runtime expressions +// module Expr = +// let toID (expr : Expr) : id = +// match expr with +// | EUnit id + +// | EBool(id, _) + +// // | EInt8(id, _) +// // | EUInt8(id, _) +// // | EInt16(id, _) +// // | EUInt16(id, _) +// // | EInt32(id, _) +// // | EUInt32(id, _) +// | EInt64(id, _) +// // | EUInt64(id, _) +// // | EInt128(id, _) +// // | EUInt128(id, _) + +// // | EFloat(id, _) + +// // | EChar(id, _) +// | EString(id, _) + +// // | EConstant(id, _) +// // | EVariable(id, _) +// // | EFieldAccess(id, _, _) +// // | ELambda(id, _, _) +// // | ELet(id, _, _, _) +// // | EIf(id, _, _, _) +// | EApply(id, _, _, _) +// | EFnName(id, _) +// // | EList(id, _) +// // | ETuple(id, _, _, _) +// // | ERecord(id, _, _) +// // | ERecordUpdate(id, _, _) +// // | EDict(id, _) +// // | EEnum(id, _, _, _) +// // | EMatch(id, _, _) +// | EError(id, _, _) +// // | EAnd(id, _, _) +// // | EOr(id, _, _) +// -> id // // Functions for working with Dark Let patterns // module LetPattern = @@ -922,7 +971,7 @@ module Dval = // accuracy is better, as the runtime is perfectly accurate. // let rec typeMatches (typ : TypeReference) (dv : Dval) : bool = - //let r = typeMatches + let r = typeMatches match (dv, typ) with //| _, TVariable _ -> true @@ -949,13 +998,14 @@ module Dval = // | DDateTime _, TDateTime // | DUuid _, TUuid - // | DDB _, TDB _ -> true + // | DDB _, TDB _ + -> true // | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> // let pairs = // [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes // pairs |> List.all (fun (v, subtype) -> r subtype v) - // | DList(_vtTODO, l), TList t -> List.all (r t) l + | DList(_vtTODO, l), TList t -> List.all (r t) l // | DDict(_vtTODO, m), TDict t -> Map.all (r t) m // | DFnVal(Lambda l), TFn(parameters, _) -> // NEList.length parameters = NEList.length l.parameters @@ -993,13 +1043,13 @@ module Dval = // | DUuid _, _ // | DChar _, _ // | DDB _, _ - // | DList _, _ + | DList _, _ // | DTuple _, _ // | DDict _, _ // | DRecord _, _ | DFnVal _, _ //| DEnum _, _ - -> false + -> false let rec toValueType (dv : Dval) : ValueType = @@ -1024,7 +1074,7 @@ module Dval = // | DDateTime _ -> ValueType.Known KTDateTime // | DUuid _ -> ValueType.Known KTUuid - // | DList(t, _) -> ValueType.Known(KTList t) + | DList(t, _) -> ValueType.Known(KTList t) // | DDict(t, _) -> ValueType.Known(KTDict t) // | DTuple(first, second, theRest) -> // ValueType.Known( @@ -1049,8 +1099,8 @@ module Dval = // VTTODO look up type, etc | NamedFn _named -> ValueType.Unknown - // // CLEANUP follow up when DDB has a typeReference - // | DDB _ -> ValueType.Unknown + // // CLEANUP follow up when DDB has a typeReference + // | DDB _ -> ValueType.Unknown // let asList (dv : Dval) : Option> = @@ -1138,10 +1188,10 @@ module Dval = | DBool b -> Some b | _ -> None - // let asUuid (dv : Dval) : Option = - // match dv with - // | DUuid u -> Some u - // | _ -> None +// let asUuid (dv : Dval) : Option = +// match dv with +// | DUuid u -> Some u +// | _ -> None // type Const = @@ -1192,7 +1242,7 @@ module PackageFn = typeParams : List parameters : NEList returnType : TypeReference - body : Expr } + body : InstructionsWithContext } // // ------------ @@ -1352,7 +1402,7 @@ and BuiltInFnSig = and FnImpl = | BuiltInFunction of BuiltInFnSig - | PackageFunction of FQFnName.Package * Expr + | PackageFunction of FQFnName.Package * InstructionsWithContext //* localCount: int and FunctionRecord = Source * FQFnName.FQFnName @@ -1371,9 +1421,9 @@ and StoreFnResult = FunctionRecord -> NEList -> Dval -> unit and Program = { canvasID : CanvasID internalFnsAllowed : bool - //dbs : Map - //secrets : List - } + //dbs : Map + //secrets : List + } /// Set of callbacks used to trace the interpreter, and other context needed to run code and Tracing = @@ -1385,6 +1435,8 @@ and Tracing = callStack : CallStack } // Used for testing +// TODO: maybe this belongs in Execution rather than RuntimeTypes? +// and taken out of ExecutionState, where it's not really used? and TestContext = { mutable sideEffectCount : int @@ -1471,16 +1523,22 @@ and ExecutionState = // -- Can change over time during execution -- - packageManager : PackageManager // TODO update to availableTypes? + // (probably move these things to VMState) + + // Maybe replace this and `builtins` with availTypes, availConsts, availFns? + // We're doing some ExecutionState -> (those) mappings at runtime on occasion, + // probably a lot more than we need + packageManager : PackageManager + // Is anything actually referencing this right now? symbolTable : Symtable typeSymbolTable : TypeSymbolTable } and Types = { typeSymbolTable : TypeSymbolTable - //package : FQTypeName.Package -> Ply> - } + //package : FQTypeName.Package -> Ply> + } // and Constants = // { builtIn : Map @@ -1495,8 +1553,8 @@ and Functions = module ExecutionState = let availableTypes (state : ExecutionState) : Types = { typeSymbolTable = state.typeSymbolTable - //package = state.packageManager.getType - } + //package = state.packageManager.getType + } // let availableConstants (state : ExecutionState) : Constants = // { builtIn = state.builtins.constants diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index 6c3928e0ef..c2edc6cbc5 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -39,87 +39,87 @@ type Context = type ErrorType = // TODO? swap these fields | ValueNotExpectedType of actualValue : Dval * expectedType : TypeReference - //| TypeDoesntExist of FQTypeName.FQTypeName +//| TypeDoesntExist of FQTypeName.FQTypeName type Error = { errorType : ErrorType; context : Context } module Error = -// module RT2DT = RuntimeTypesToDarkTypes + // module RT2DT = RuntimeTypesToDarkTypes -// module Context = -// let typeName = -// FQTypeName.Package -// PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.context + // module Context = + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.context -// let rec toDT (context : Context) : Dval = -// let (caseName, fields) = -// match context with -// | FunctionCallParameter(fnName, param, paramIndex) -> -// "FunctionCallParameter", -// [ RT2DT.FQFnName.toDT fnName; RT2DT.Param.toDT param; DInt64 paramIndex ] + // let rec toDT (context : Context) : Dval = + // let (caseName, fields) = + // match context with + // | FunctionCallParameter(fnName, param, paramIndex) -> + // "FunctionCallParameter", + // [ RT2DT.FQFnName.toDT fnName; RT2DT.Param.toDT param; DInt64 paramIndex ] -// | FunctionCallResult(fnName, returnType) -> -// "FunctionCallResult", -// [ RT2DT.FQFnName.toDT fnName; RT2DT.TypeReference.toDT returnType ] + // | FunctionCallResult(fnName, returnType) -> + // "FunctionCallResult", + // [ RT2DT.FQFnName.toDT fnName; RT2DT.TypeReference.toDT returnType ] -// | RecordField(recordTypeName, fieldName, fieldType) -> -// "RecordField", -// [ RT2DT.FQTypeName.toDT recordTypeName -// DString fieldName -// RT2DT.TypeReference.toDT fieldType ] + // | RecordField(recordTypeName, fieldName, fieldType) -> + // "RecordField", + // [ RT2DT.FQTypeName.toDT recordTypeName + // DString fieldName + // RT2DT.TypeReference.toDT fieldType ] -// | DictKey(key, typ) -> -// "DictKey", [ DString key; RT2DT.TypeReference.toDT typ ] + // | DictKey(key, typ) -> + // "DictKey", [ DString key; RT2DT.TypeReference.toDT typ ] -// | EnumField(enumTypeName, caseName, fieldIndex, fieldCount, fieldType) -> -// "EnumField", -// [ RT2DT.FQTypeName.toDT enumTypeName -// DString caseName -// DInt64 fieldIndex -// DInt64 fieldCount -// RT2DT.TypeReference.toDT fieldType ] + // | EnumField(enumTypeName, caseName, fieldIndex, fieldCount, fieldType) -> + // "EnumField", + // [ RT2DT.FQTypeName.toDT enumTypeName + // DString caseName + // DInt64 fieldIndex + // DInt64 fieldCount + // RT2DT.TypeReference.toDT fieldType ] -// | DBQueryVariable(varName, expected) -> -// "DBQueryVariable", [ DString varName; RT2DT.TypeReference.toDT expected ] + // | DBQueryVariable(varName, expected) -> + // "DBQueryVariable", [ DString varName; RT2DT.TypeReference.toDT expected ] -// | DBSchemaType(name, expectedType) -> -// "DBSchemaType", [ DString name; RT2DT.TypeReference.toDT expectedType ] + // | DBSchemaType(name, expectedType) -> + // "DBSchemaType", [ DString name; RT2DT.TypeReference.toDT expectedType ] -// | ListIndex(index, listTyp, parent) -> -// "ListIndex", -// [ DInt64 index; RT2DT.TypeReference.toDT listTyp; toDT parent ] + // | ListIndex(index, listTyp, parent) -> + // "ListIndex", + // [ DInt64 index; RT2DT.TypeReference.toDT listTyp; toDT parent ] -// | TupleIndex(index, elementType, parent) -> -// "TupleIndex", -// [ DInt64 index; RT2DT.TypeReference.toDT elementType; toDT parent ] + // | TupleIndex(index, elementType, parent) -> + // "TupleIndex", + // [ DInt64 index; RT2DT.TypeReference.toDT elementType; toDT parent ] -// | FnValResult(returnType) -> -// "FnValResult", [ RT2DT.TypeReference.toDT returnType ] + // | FnValResult(returnType) -> + // "FnValResult", [ RT2DT.TypeReference.toDT returnType ] -// DEnum(typeName, typeName, [], caseName, fields) + // DEnum(typeName, typeName, [], caseName, fields) -// module ErrorType = -// let typeName = -// FQTypeName.Package -// PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.errorType + // module ErrorType = + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.errorType -// let toDT (et : ErrorType) : Dval = -// let (caseName, fields) = -// match et with -// | ValueNotExpectedType(actualValue, expectedType) -> -// "ValueNotExpectedType", -// [ actualValue |> RT2DT.Dval.toDT -// expectedType |> RT2DT.TypeReference.toDT ] + // let toDT (et : ErrorType) : Dval = + // let (caseName, fields) = + // match et with + // | ValueNotExpectedType(actualValue, expectedType) -> + // "ValueNotExpectedType", + // [ actualValue |> RT2DT.Dval.toDT + // expectedType |> RT2DT.TypeReference.toDT ] -// | TypeDoesntExist(typeName) -> -// "TypeDoesntExist", [ RT2DT.FQTypeName.toDT typeName ] + // | TypeDoesntExist(typeName) -> + // "TypeDoesntExist", [ RT2DT.FQTypeName.toDT typeName ] -// DEnum(typeName, typeName, [], caseName, fields) + // DEnum(typeName, typeName, [], caseName, fields) -// let typeName = -// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.error + // let typeName = + // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.error let toRuntimeError (_e : Error) : RuntimeError = // let fields = @@ -240,7 +240,7 @@ let rec valueTypeUnifies let rec unify (context : Context) (types : Types) - (_tst : TypeSymbolTable) + (tst : TypeSymbolTable) (expected : TypeReference) (value : Dval) : Ply> = @@ -285,16 +285,16 @@ let rec unify // | TUuid, DUuid _ -> return Ok() // | TDB _, DDB _ -> return Ok() // TODO: check DB type - // | TList expected, DList(actual, _dvs) -> - // match! valueTypeUnifies tst expected actual with - // | false -> - // return - // { errorType = ValueNotExpectedType(value, TList expected) - // context = context } - // |> Error.toRuntimeError - // |> Error + | TList expected, DList(actual, _dvs) -> + match! valueTypeUnifies tst expected actual with + | false -> + return + { errorType = ValueNotExpectedType(value, TList expected) + context = context } + |> Error.toRuntimeError + |> Error - // | true -> return! Ply() + | true -> return! Ply() // | TDict _expected, DDict(_actual, _entries) -> // // VTTODO uncomment this @@ -443,14 +443,14 @@ let rec unify // | TCustomType _, _ // | TVariable _, _ | TString, _ - // | TList _, _ + | TList _, _ // | TDateTime, _ // | TDict _, _ | TFn _, _ // | TUuid, _ // | TChar, _ // | TDB _, _ - -> + -> return { errorType = ValueNotExpectedType(value, expected); context = context } |> Error.toRuntimeError diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index b50aafd0ac..ac5e95c41b 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -47,234 +47,234 @@ module PackageIDs = LibExecution.PackageIDs let fns : List = [ - // { name = fn "testDerrorMessage" 0 - // typeParams = [] - // parameters = [ Param.make "errorMessage" TString "" ] - // returnType = - // TCustomType( - // Ok( - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // ), - // [] - // ) - // description = "Return a value representing a runtime type error" - // fn = - // (function - // | _, _, [ DString error ] -> - // let typeName = - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - // // CLEANUP consider renaming to `oldError` or something more clear - // { name = fn "testRuntimeError" 0 - // typeParams = [] - // parameters = [ Param.make "errorString" TString "" ] - // returnType = TInt64 - // description = "Return a value representing a type error" - // fn = - // (function - // | _, _, [ DString errorString ] -> - // raiseUntargetedRTE (RuntimeError.oldError errorString) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - // { name = fn "testDerrorSqlMessage" 0 - // typeParams = [] - // parameters = [ Param.make "errorString" TString "" ] - // returnType = - // TCustomType( - // Ok( - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // ), - // [] - // ) - // description = "Return a value that matches errors thrown by the SqlCompiler" - // fn = - // (function - // | _, _, [ DString errorString ] -> - // let msg = LibCloud.SqlCompiler.errorTemplate + errorString - // let typeName = - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // DEnum(typeName, typeName, [], "ErrorString", [ DString msg ]) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - // { name = fn "testToChar" 0 - // typeParams = [] - // parameters = [ Param.make "c" TString "" ] - // returnType = TypeReference.option TChar - // description = "Turns a string of length 1 into a character" - // fn = - // (function - // | _, _, [ DString s ] -> - // let chars = String.toEgcSeq s - - // if Seq.length chars = 1 then - // chars - // |> Seq.toList - // |> (fun l -> l[0]) - // |> DChar - // |> Dval.optionSome KTChar - // |> Ply - // else - // Dval.optionNone KTChar |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testIncrementSideEffectCounter" 0 - // typeParams = [] - // parameters = - // [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] - // returnType = TVariable "a" - // description = - // "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." - // fn = - // (function - // | state, _, [ arg ] -> - // state.test.sideEffectCount <- state.test.sideEffectCount + 1 - // Ply(arg) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testSideEffectCount" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = TInt64 - // description = "Return the value of the side-effect counter" - // fn = - // (function - // | state, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testInspect" 0 - // typeParams = [] - // parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] - // returnType = varA - // description = "Prints the value into stdout" - // fn = - // (function - // | _, _, [ v; DString msg ] -> - // print $"{msg}: {v}" - // Ply v - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testDeleteUser" 0 - // typeParams = [] - // parameters = [ Param.make "username" TString "" ] - // returnType = TypeReference.result TUnit varB - // description = "Delete a user (test only)" - // fn = - // (function - // | _, _, [ DString username ] -> - // uply { - // do! - // // This is unsafe. A user has canvases, and canvases have traces. It - // // will either break or cascade (haven't checked) - // Sql.query "DELETE FROM accounts_v0 WHERE username = @username" - // |> Sql.parameters [ "username", Sql.string (string username) ] - // |> Sql.executeStatementAsync - // return DUnit - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testGetQueue" 0 - // typeParams = [] - // parameters = [ Param.make "eventName" TString "" ] - // returnType = TList TString - // description = "Fetch a queue (test only)" - // fn = - // (function - // | state, _, [ DString eventName ] -> - // uply { - // let canvasID = state.program.canvasID - // let! results = - // LibCloud.Queue.Test.loadEvents canvasID ("WORKER", eventName, "_") - // let results = - // results - // |> List.map LibExecution.DvalReprDeveloper.toRepr - // |> List.map DString - // return DList(VT.string, results) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Impure - // deprecated = NotDeprecated } - - - // { name = fn "testRaiseException" 0 - // typeParams = [] - // parameters = [ Param.make "message" TString "" ] - // returnType = TVariable "a" - // description = "A function that raises an F# exception" - // fn = - // (function - // | _, _, [ DString message ] -> raise (System.Exception(message)) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testGetCanvasID" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = TUuid - // description = "Get the name of the canvas that's running" - // fn = - // (function - // | state, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testSetExpectedExceptionCount" 0 - // typeParams = [] - // parameters = [ Param.make "count" TInt64 "" ] - // returnType = TUnit - // description = "Set the expected exception count for the current test" - // fn = - // (function - // | state, _, [ DInt64 count ] -> - // uply { - // state.test.expectedExceptionCount <- int count - // return DUnit - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - ] + // { name = fn "testDerrorMessage" 0 + // typeParams = [] + // parameters = [ Param.make "errorMessage" TString "" ] + // returnType = + // TCustomType( + // Ok( + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // ), + // [] + // ) + // description = "Return a value representing a runtime type error" + // fn = + // (function + // | _, _, [ DString error ] -> + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // // CLEANUP consider renaming to `oldError` or something more clear + // { name = fn "testRuntimeError" 0 + // typeParams = [] + // parameters = [ Param.make "errorString" TString "" ] + // returnType = TInt64 + // description = "Return a value representing a type error" + // fn = + // (function + // | _, _, [ DString errorString ] -> + // raiseUntargetedRTE (RuntimeError.oldError errorString) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // { name = fn "testDerrorSqlMessage" 0 + // typeParams = [] + // parameters = [ Param.make "errorString" TString "" ] + // returnType = + // TCustomType( + // Ok( + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // ), + // [] + // ) + // description = "Return a value that matches errors thrown by the SqlCompiler" + // fn = + // (function + // | _, _, [ DString errorString ] -> + // let msg = LibCloud.SqlCompiler.errorTemplate + errorString + // let typeName = + // FQTypeName.Package + // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + // DEnum(typeName, typeName, [], "ErrorString", [ DString msg ]) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + // { name = fn "testToChar" 0 + // typeParams = [] + // parameters = [ Param.make "c" TString "" ] + // returnType = TypeReference.option TChar + // description = "Turns a string of length 1 into a character" + // fn = + // (function + // | _, _, [ DString s ] -> + // let chars = String.toEgcSeq s + + // if Seq.length chars = 1 then + // chars + // |> Seq.toList + // |> (fun l -> l[0]) + // |> DChar + // |> Dval.optionSome KTChar + // |> Ply + // else + // Dval.optionNone KTChar |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testIncrementSideEffectCounter" 0 + // typeParams = [] + // parameters = + // [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] + // returnType = TVariable "a" + // description = + // "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." + // fn = + // (function + // | state, _, [ arg ] -> + // state.test.sideEffectCount <- state.test.sideEffectCount + 1 + // Ply(arg) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testSideEffectCount" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TInt64 + // description = "Return the value of the side-effect counter" + // fn = + // (function + // | state, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testInspect" 0 + // typeParams = [] + // parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] + // returnType = varA + // description = "Prints the value into stdout" + // fn = + // (function + // | _, _, [ v; DString msg ] -> + // print $"{msg}: {v}" + // Ply v + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testDeleteUser" 0 + // typeParams = [] + // parameters = [ Param.make "username" TString "" ] + // returnType = TypeReference.result TUnit varB + // description = "Delete a user (test only)" + // fn = + // (function + // | _, _, [ DString username ] -> + // uply { + // do! + // // This is unsafe. A user has canvases, and canvases have traces. It + // // will either break or cascade (haven't checked) + // Sql.query "DELETE FROM accounts_v0 WHERE username = @username" + // |> Sql.parameters [ "username", Sql.string (string username) ] + // |> Sql.executeStatementAsync + // return DUnit + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testGetQueue" 0 + // typeParams = [] + // parameters = [ Param.make "eventName" TString "" ] + // returnType = TList TString + // description = "Fetch a queue (test only)" + // fn = + // (function + // | state, _, [ DString eventName ] -> + // uply { + // let canvasID = state.program.canvasID + // let! results = + // LibCloud.Queue.Test.loadEvents canvasID ("WORKER", eventName, "_") + // let results = + // results + // |> List.map LibExecution.DvalReprDeveloper.toRepr + // |> List.map DString + // return DList(VT.string, results) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + + + // { name = fn "testRaiseException" 0 + // typeParams = [] + // parameters = [ Param.make "message" TString "" ] + // returnType = TVariable "a" + // description = "A function that raises an F# exception" + // fn = + // (function + // | _, _, [ DString message ] -> raise (System.Exception(message)) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testGetCanvasID" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TUuid + // description = "Get the name of the canvas that's running" + // fn = + // (function + // | state, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "testSetExpectedExceptionCount" 0 + // typeParams = [] + // parameters = [ Param.make "count" TInt64 "" ] + // returnType = TUnit + // description = "Set the expected exception count for the current test" + // fn = + // (function + // | state, _, [ DInt64 count ] -> + // uply { + // state.test.expectedExceptionCount <- int count + // return DUnit + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + ] let builtins = LibExecution.Builtin.make fns diff --git a/backend/tests/TestUtils/RTShortcuts.fs b/backend/tests/TestUtils/RTShortcuts.fs index 121dcfe20f..50dddd992a 100644 --- a/backend/tests/TestUtils/RTShortcuts.fs +++ b/backend/tests/TestUtils/RTShortcuts.fs @@ -7,9 +7,9 @@ open LibExecution.RuntimeTypes module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -let eUnit () : Expr = EUnit(gid ()) +// let eUnit () : Expr = EUnit(gid ()) -let eBool (b : bool) : Expr = EBool(gid (), b) +// let eBool (b : bool) : Expr = EBool(gid (), b) // let eInt8 (i : int8) : Expr = EInt8(gid (), i) // let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) @@ -17,7 +17,7 @@ let eBool (b : bool) : Expr = EBool(gid (), b) // let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) // let eInt32 (i : int32) : Expr = EInt32(gid (), i) // let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) -let eInt64 (i : int64) : Expr = EInt64(gid (), i) +// let eInt64 (i : int64) : Expr = EInt64(gid (), i) // let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) // let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) // let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) @@ -26,7 +26,7 @@ let eInt64 (i : int64) : Expr = EInt64(gid (), i) // EFloat(gid (), makeFloat sign whole fraction) //let eChar (c : string) : Expr = EChar(gid (), c) -let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) +// let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) @@ -50,37 +50,37 @@ let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) // EEnum(gid (), typeName, name, args) -let eBuiltinFnName (name : string) (version : int) : Expr = - PT.FQFnName.fqBuiltIn name version - |> PT2RT.FQFnName.toRT - |> fun x -> EFnName(gid (), x) - - -let eFn' - (function_ : string) - (version : int) - (typeArgs : List) - (args : List) - : Expr = - let args = NEList.ofListUnsafe "eFn'" [] args - EApply(gid (), (eBuiltinFnName function_ version), typeArgs, args) - -let eFn - (function_ : string) - (version : int) - (typeArgs : List) - (args : List) - : Expr = - eFn' function_ version typeArgs args - - -let eApply - (target : Expr) - (typeArgs : List) - (args : List) - : Expr = - let args = NEList.ofListUnsafe "eApply" [] args - EApply(gid (), target, typeArgs, args) +// let eBuiltinFnName (name : string) (version : int) : Expr = +// PT.FQFnName.fqBuiltIn name version +// |> PT2RT.FQFnName.toRT +// |> fun x -> EFnName(gid (), x) + + +// let eFn' +// (function_ : string) +// (version : int) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eFn'" [] args +// EApply(gid (), (eBuiltinFnName function_ version), typeArgs, args) + +// let eFn +// (function_ : string) +// (version : int) +// (typeArgs : List) +// (args : List) +// : Expr = +// eFn' function_ version typeArgs args + + +// let eApply +// (target : Expr) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eApply" [] args +// EApply(gid (), target, typeArgs, args) // let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = // ETuple(gid (), first, second, theRest) diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 213288544d..2f1b23467d 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -151,14 +151,14 @@ let executionStateFor //(dbs : Map) : Task = task { - let domains = []//Canvas.domainsForCanvasID canvasID + let domains = [] //Canvas.domainsForCanvasID canvasID let program : RT.Program = { canvasID = canvasID internalFnsAllowed = internalFnsAllowed - // dbs = dbs - // secrets = [] - } + // dbs = dbs + // secrets = [] + } let testContext : RT.TestContext = { sideEffectCount = 0 @@ -357,7 +357,7 @@ module Expect = // representation (in the event that there are multiple ways to represent // it). Think of this as a general form of string normalization. let rec isCanonical (dv : Dval) : bool = - //let check = isCanonical + let r = isCanonical match dv with | DUnit @@ -380,16 +380,16 @@ module Expect = // | DUuid _ | DFnVal _ // | DDB _ - -> true + -> true // | DChar str -> str.IsNormalized() && String.lengthInEgcs str = 1 | DString str -> str.IsNormalized() - // | DList(_, items) -> List.all check items - // | DTuple(first, second, rest) -> List.all check ([ first; second ] @ rest) - // | DDict(_, entries) -> entries |> Map.values |> List.all check - // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all check - // | DEnum(_, _, _, _, fields) -> fields |> List.all check + | DList(_, items) -> List.all r items + // | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) + // | DDict(_, entries) -> entries |> Map.values |> List.all r + // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all r + // | DEnum(_, _, _, _, fields) -> fields |> List.all r type Path = string list @@ -521,202 +521,202 @@ module Expect = - let rec exprEqualityBaseFn - (checkIDs : bool) - (path : Path) - (actual : Expr) - (expected : Expr) - (errorFn : Path -> string -> string -> unit) - : unit = - let eq path a e = exprEqualityBaseFn checkIDs path a e errorFn - - let check path (a : 'a) (e : 'a) = - if a <> e then errorFn path (string actual) (string expected) - - let eqList path (l1 : List) (l2 : List) = - List.iteri2 (fun i -> eq (string i :: path)) l1 l2 - check path (List.length l1) (List.length l2) - - let eqNEList path (l1 : NEList) (l2 : NEList) = - NEList.iteri2 (fun i -> eq (string i :: path)) l1 l2 - check path (NEList.length l1) (NEList.length l2) - - if checkIDs then check path (Expr.toID actual) (Expr.toID expected) - - match actual, expected with - // expressions with no values - | EUnit _, EUnit _ -> () - - - // Simple exprs - | EBool(_, v), EBool(_, v') -> check path v v' - - // | EInt8(_, v), EInt8(_, v') -> check path v v' - // | EUInt8(_, v), EUInt8(_, v') -> check path v v' - // | EInt16(_, v), EInt16(_, v') -> check path v v' - // | EUInt16(_, v), EUInt16(_, v') -> check path v v' - // | EInt32(_, v), EInt32(_, v') -> check path v v' - // | EUInt32(_, v), EUInt32(_, v') -> check path v v' - | EInt64(_, v), EInt64(_, v') -> check path v v' - // | EUInt64(_, v), EUInt64(_, v') -> check path v v' - // | EInt128(_, v), EInt128(_, v') -> check path v v' - // | EUInt128(_, v), EUInt128(_, v') -> check path v v' - - // | EFloat(_, v), EFloat(_, v') -> check path v v' - - // expressions with single string values - | EString(_, s), EString(_, s') -> - let rec checkSegment s s' = - match s, s' with - | StringText s, StringText s' -> check path s s' - | StringInterpolation e, StringInterpolation e' -> eq path e e' - | _ -> check path s s' - List.iter2 checkSegment s s' - - // | EChar(_, v), EChar(_, v') - // | EVariable(_, v), EVariable(_, v') -> check path v v' - // | EConstant(_, name), EConstant(_, name') -> check path name name' - // | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> - // letPatternEqualityBaseFn checkIDs path pat pat' errorFn - // eq ("rhs" :: path) rhs rhs' - // eq ("body" :: path) body body' - // | EIf(_, con, thn, els), EIf(_, con', thn', els') -> - // eq ("cond" :: path) con con' - // eq ("then" :: path) thn thn' - // match els, els' with - // | Some el, Some el' -> eq ("else" :: path) el el' - // | None, None -> () - // | _ -> - // errorFn ("else" :: path) (string actual) (string expected) - // () - - // | EList(_, l), EList(_, l') -> eqList path l l' - // | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> - // eq ("first" :: path) first first' - // eq ("second" :: path) second second' - // eqList path theRest theRest' + // let rec exprEqualityBaseFn + // (checkIDs : bool) + // (path : Path) + // (actual : Expr) + // (expected : Expr) + // (errorFn : Path -> string -> string -> unit) + // : unit = + // let eq path a e = exprEqualityBaseFn checkIDs path a e errorFn - | EApply(_, name, typeArgs, args), EApply(_, name', typeArgs', args') -> - let path = (string name :: path) - eq path name name' + // let check path (a : 'a) (e : 'a) = + // if a <> e then errorFn path (string actual) (string expected) - check path (List.length typeArgs) (List.length typeArgs') - List.iteri2 - (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) - typeArgs - typeArgs' + // let eqList path (l1 : List) (l2 : List) = + // List.iteri2 (fun i -> eq (string i :: path)) l1 l2 + // check path (List.length l1) (List.length l2) - eqNEList path args args' + // let eqNEList path (l1 : NEList) (l2 : NEList) = + // NEList.iteri2 (fun i -> eq (string i :: path)) l1 l2 + // check path (NEList.length l1) (NEList.length l2) - | EFnName(_, name), EFnName(_, name') -> check path name name' + // if checkIDs then check path (Expr.toID actual) (Expr.toID expected) - // | ERecord(_, typeName, fields), ERecord(_, typeName', fields') -> - // userTypeNameEqualityBaseFn path typeName typeName' errorFn - // NEList.iter2 - // (fun (k, v) (k', v') -> - // check path k k' - // eq (k :: path) v v') - // fields - // fields' - // | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> - // check path record record' - // NEList.iter2 - // (fun (k, v) (k', v') -> - // check path k k' - // eq (k :: path) v v') - // updates - // updates' - // | EDict(_, fields), EDict(_, fields') -> - // List.iter2 - // (fun (k, v) (k', v') -> - // check ("key" :: path) k k' - // eq ("value" :: path) v v') - // fields - // fields' - - // | EFieldAccess(_, e, f), EFieldAccess(_, e', f') -> - // eq (f :: path) e e' - // check path f f' - - // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> - // userTypeNameEqualityBaseFn path typeName typeName' errorFn - // check path caseName caseName' - // eqList path fields fields' - // () + // match actual, expected with + // // expressions with no values + // | EUnit _, EUnit _ -> () + + + // // Simple exprs + // | EBool(_, v), EBool(_, v') -> check path v v' + + // // | EInt8(_, v), EInt8(_, v') -> check path v v' + // // | EUInt8(_, v), EUInt8(_, v') -> check path v v' + // // | EInt16(_, v), EInt16(_, v') -> check path v v' + // // | EUInt16(_, v), EUInt16(_, v') -> check path v v' + // // | EInt32(_, v), EInt32(_, v') -> check path v v' + // // | EUInt32(_, v), EUInt32(_, v') -> check path v v' + // | EInt64(_, v), EInt64(_, v') -> check path v v' + // // | EUInt64(_, v), EUInt64(_, v') -> check path v v' + // // | EInt128(_, v), EInt128(_, v') -> check path v v' + // // | EUInt128(_, v), EUInt128(_, v') -> check path v v' + + // // | EFloat(_, v), EFloat(_, v') -> check path v v' + + // // expressions with single string values + // | EString(_, s), EString(_, s') -> + // let rec checkSegment s s' = + // match s, s' with + // | StringText s, StringText s' -> check path s s' + // | StringInterpolation e, StringInterpolation e' -> eq path e e' + // | _ -> check path s s' + // List.iter2 checkSegment s s' + + // // | EChar(_, v), EChar(_, v') + // // | EVariable(_, v), EVariable(_, v') -> check path v v' + // // | EConstant(_, name), EConstant(_, name') -> check path name name' + // // | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> + // // letPatternEqualityBaseFn checkIDs path pat pat' errorFn + // // eq ("rhs" :: path) rhs rhs' + // // eq ("body" :: path) body body' + // // | EIf(_, con, thn, els), EIf(_, con', thn', els') -> + // // eq ("cond" :: path) con con' + // // eq ("then" :: path) thn thn' + // // match els, els' with + // // | Some el, Some el' -> eq ("else" :: path) el el' + // // | None, None -> () + // // | _ -> + // // errorFn ("else" :: path) (string actual) (string expected) + // // () + + // // | EList(_, l), EList(_, l') -> eqList path l l' + // // | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> + // // eq ("first" :: path) first first' + // // eq ("second" :: path) second second' + // // eqList path theRest theRest' + + // | EApply(_, name, typeArgs, args), EApply(_, name', typeArgs', args') -> + // let path = (string name :: path) + // eq path name name' + + // check path (List.length typeArgs) (List.length typeArgs') + // List.iteri2 + // (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) + // typeArgs + // typeArgs' + + // eqNEList path args args' + + // | EFnName(_, name), EFnName(_, name') -> check path name name' + + // // | ERecord(_, typeName, fields), ERecord(_, typeName', fields') -> + // // userTypeNameEqualityBaseFn path typeName typeName' errorFn + // // NEList.iter2 + // // (fun (k, v) (k', v') -> + // // check path k k' + // // eq (k :: path) v v') + // // fields + // // fields' + // // | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> + // // check path record record' + // // NEList.iter2 + // // (fun (k, v) (k', v') -> + // // check path k k' + // // eq (k :: path) v v') + // // updates + // // updates' + // // | EDict(_, fields), EDict(_, fields') -> + // // List.iter2 + // // (fun (k, v) (k', v') -> + // // check ("key" :: path) k k' + // // eq ("value" :: path) v v') + // // fields + // // fields' + + // // | EFieldAccess(_, e, f), EFieldAccess(_, e', f') -> + // // eq (f :: path) e e' + // // check path f f' + + // // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> + // // userTypeNameEqualityBaseFn path typeName typeName' errorFn + // // check path caseName caseName' + // // eqList path fields fields' + // // () + + // // | ELambda(_, pats, e), ELambda(_, pats', e') -> + // // let path = ("lambda" :: path) + // // eq path e e' + // // NEList.iter2 + // // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) + // // pats + // // pats' + // // | EMatch(_, e, branches), EMatch(_, e', branches') -> + // // eq ("matchCond" :: path) e e' + + // // check path (NEList.length branches) (NEList.length branches') + // // NEList.iteri2 + // // (fun i branch branch' -> + // // let path = $"Case {i} - {branch.pat}" :: path + // // matchPatternEqualityBaseFn + // // checkIDs + // // ("pat" :: path) + // // branch.pat + // // branch'.pat + // // errorFn + // // match branch.whenCondition, branch'.whenCondition with + // // | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' + // // | None, None -> () + // // | _ -> + // // errorFn ("whenCondition" :: path) (string actual) (string expected) + // // () + // // eq ("rhs" :: path) branch.rhs branch'.rhs) + // // branches + // // branches' + // // | EAnd(_, l, r), EAnd(_, l', r') -> + // // eq ("left" :: path) l l' + // // eq ("right" :: path) r r' + // // | EOr(_, l, r), EOr(_, l', r') -> + // // eq ("left" :: path) l l' + // // eq ("right" :: path) r r' + // | EError(_, msg, exprs), EError(_, msg', exprs') -> + // check path msg msg' + // eqList path exprs exprs' - // | ELambda(_, pats, e), ELambda(_, pats', e') -> - // let path = ("lambda" :: path) - // eq path e e' - // NEList.iter2 - // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) - // pats - // pats' - // | EMatch(_, e, branches), EMatch(_, e', branches') -> - // eq ("matchCond" :: path) e e' - - // check path (NEList.length branches) (NEList.length branches') - // NEList.iteri2 - // (fun i branch branch' -> - // let path = $"Case {i} - {branch.pat}" :: path - // matchPatternEqualityBaseFn - // checkIDs - // ("pat" :: path) - // branch.pat - // branch'.pat - // errorFn - // match branch.whenCondition, branch'.whenCondition with - // | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' - // | None, None -> () - // | _ -> - // errorFn ("whenCondition" :: path) (string actual) (string expected) - // () - // eq ("rhs" :: path) branch.rhs branch'.rhs) - // branches - // branches' - // | EAnd(_, l, r), EAnd(_, l', r') -> - // eq ("left" :: path) l l' - // eq ("right" :: path) r r' - // | EOr(_, l, r), EOr(_, l', r') -> - // eq ("left" :: path) l l' - // eq ("right" :: path) r r' - | EError(_, msg, exprs), EError(_, msg', exprs') -> - check path msg msg' - eqList path exprs exprs' - - // exhaustiveness check - | EUnit _, _ - // | EInt8 _, _ - // | EUInt8 _, _ - // | EInt16 _, _ - // | EUInt16 _, _ - // | EInt32 _, _ - // | EUInt32 _, _ - | EInt64 _, _ - // | EUInt64 _, _ - // | EInt128 _, _ - // | EUInt128 _, _ - | EString _, _ - // | EChar _, _ - // | EVariable _, _ - // | EConstant _, _ - | EBool _, _ - // | EFloat _, _ - // | ELet _, _ - // | EIf _, _ - // | EList _, _ - // | ETuple _, _ - | EApply _, _ - | EFnName _, _ - // | ERecord _, _ - // | ERecordUpdate _, _ - // | EDict _, _ - // | EFieldAccess _, _ - // | EEnum _, _ - // | ELambda _, _ - // | EMatch _, _ - // | EAnd _, _ - // | EOr _, _ - | EError _, _ -> check path actual expected + // // exhaustiveness check + // | EUnit _, _ + // // | EInt8 _, _ + // // | EUInt8 _, _ + // // | EInt16 _, _ + // // | EUInt16 _, _ + // // | EInt32 _, _ + // // | EUInt32 _, _ + // | EInt64 _, _ + // // | EUInt64 _, _ + // // | EInt128 _, _ + // // | EUInt128 _, _ + // | EString _, _ + // // | EChar _, _ + // // | EVariable _, _ + // // | EConstant _, _ + // | EBool _, _ + // // | EFloat _, _ + // // | ELet _, _ + // // | EIf _, _ + // // | EList _, _ + // // | ETuple _, _ + // | EApply _, _ + // | EFnName _, _ + // // | ERecord _, _ + // // | ERecordUpdate _, _ + // // | EDict _, _ + // // | EFieldAccess _, _ + // // | EEnum _, _ + // // | ELambda _, _ + // // | EMatch _, _ + // // | EAnd _, _ + // // | EOr _, _ + // | EError _, _ -> check path actual expected @@ -728,16 +728,16 @@ module Expect = (expected : Dval) (errorFn : Path -> string -> string -> unit) : unit = - //let de p a e = dvalEqualityBaseFn p a e errorFn + let de p a e = dvalEqualityBaseFn p a e errorFn //let error path = errorFn path (string actual) (string expected) let check (path : Path) (a : 'a) (e : 'a) : unit = if a <> e then errorFn path (debugDval actual) (debugDval expected) - // let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = - // match VT.merge a e with - // | Ok _merged -> () - // | Error() -> errorFn path (debugDval actual) (debugDval expected) + let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = + match VT.merge a e with + | Ok _merged -> () + | Error() -> errorFn path (debugDval actual) (debugDval expected) match actual, expected with // | DFloat l, DFloat r -> @@ -769,11 +769,11 @@ module Expect = // // equal if they print the same string. // check path (string l) (string r) - // | DList(lType, ls), DList(rType, rs) -> - // checkValueType ("Type" :: path) lType rType + | DList(lType, ls), DList(rType, rs) -> + checkValueType ("Type" :: path) lType rType - // check ("Length" :: path) (List.length ls) (List.length rs) - // List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs + check ("Length" :: path) (List.length ls) (List.length rs) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs // | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> // de path firstL firstR @@ -876,14 +876,14 @@ module Expect = | DString _, _ // | DDateTime _, _ // | DUuid _, _ - // | DList _, _ + | DList _, _ // | DTuple _, _ // | DDict _, _ // | DRecord _, _ // | DEnum _, _ | DFnVal _, _ // | DDB _, _ - -> check path actual expected + -> check path actual expected let formatMsg (initialMsg : string) (path : Path) (actual : 'a) : string = let initial = if initialMsg = "" then "" else $"{initialMsg}\n\n" @@ -908,13 +908,13 @@ module Expect = // matchPatternEqualityBaseFn false [] actual expected (fun path a e -> // Expect.equal a e (formatMsg "" path actual)) - let rec equalExpr (actual : Expr) (expected : Expr) (msg : string) : unit = - exprEqualityBaseFn true [] actual expected (fun path a e -> - Expect.equal a e (formatMsg msg path actual)) + // let rec equalExpr (actual : Expr) (expected : Expr) (msg : string) : unit = + // exprEqualityBaseFn true [] actual expected (fun path a e -> + // Expect.equal a e (formatMsg msg path actual)) - let rec equalExprIgnoringIDs (actual : Expr) (expected : Expr) : unit = - exprEqualityBaseFn false [] actual expected (fun path a e -> - Expect.equal a e (formatMsg "" path actual)) + // let rec equalExprIgnoringIDs (actual : Expr) (expected : Expr) : unit = + // exprEqualityBaseFn false [] actual expected (fun path a e -> + // Expect.equal a e (formatMsg "" path actual)) let dvalEquality (left : Dval) (right : Dval) : bool = let mutable success = true @@ -930,7 +930,7 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = // | DRecord(_, _, _, fields) -> // Map.values fields |> List.map visit |> ignore> // | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> - // | DList(_, items) -> List.map visit items |> ignore> + | DList(_, items) -> List.map visit items |> ignore> // | DTuple(first, second, theRest) -> // List.map visit ([ first; second ] @ theRest) |> ignore> @@ -949,12 +949,12 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = // | DUInt128 _ // | DFloat _ // | DChar _ - | DString _ // TODO: should actually traverse in interpolations + | DString _ // TODO: should actually traverse in interpolations // | DUuid _ // | DDateTime _ | DFnVal _ // | DDB _ - -> f dv + -> f dv f dv visit dv state diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs new file mode 100644 index 0000000000..7bc0c318e4 --- /dev/null +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -0,0 +1,58 @@ +module Tests.Interpreter + +open Expecto +open Prelude +open TestUtils.TestUtils + +module PT = LibExecution.ProgramTypes +module RT = LibExecution.RuntimeTypes +module VT = RT.ValueType +module PT2RT = LibExecution.ProgramTypesToRuntimeTypes + +module E = Tests.ProgramTypesToRuntimeTypes.Expressions + +let eval pt = + uply { + let _registersNeeded, instructions, resultReg = PT2RT.Expr.toRT 0 pt + + let! executionState = + executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false + + return! LibExecution.Interpreter.eval executionState instructions resultReg + } + + +let onePlusTwo = + testTask "1+2" { + let! actual = eval E.onePlusTwo |> Ply.toTask + return Expect.equal actual (RT.DInt64 3L) "" + } + +let boolList = + testTask "[true; false; true]" { + let! actual = eval E.boolList |> Ply.toTask + + return + Expect.equal + actual + (RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ])) + "" + } + +let boolListList = + testTask "[[true; false]; [false; true]]" { + let! actual = eval E.boolListList |> Ply.toTask + + return + Expect.equal + actual + (RT.DList( + VT.unknown, + [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] + )) + "" + } + + +let tests = testList "Interpreter" [ onePlusTwo; boolList ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs new file mode 100644 index 0000000000..c2d09fb7b9 --- /dev/null +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -0,0 +1,150 @@ +module Tests.ProgramTypesToRuntimeTypes + +open Expecto +open Prelude +open TestUtils.TestUtils + +module PT = LibExecution.ProgramTypes +module RT = LibExecution.RuntimeTypes +module VT = RT.ValueType +module PT2RT = LibExecution.ProgramTypesToRuntimeTypes +module PackageIDs = LibExecution.PackageIDs + +// TODO: consider adding an Expect.equalInstructions, +// which better points out the diffs in the lists + +module Expressions = + let one = PT.EInt64(gid (), 1) + + let onePlusTwo : PT.Expr = + PT.EApply( + gid (), + PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0)), + [], + (NEList.ofList (PT.EInt64(gid (), 1)) [ PT.EInt64(gid (), 2) ]) + ) + + // TODO: try to use undefined variable + // TODO: lpunit + let defineAndUseVar : PT.Expr = + PT.ELet( + gid (), + PT.LPVariable(gid (), "x"), + PT.EBool(gid (), true), + PT.EVariable(gid (), "x") + ) + + let boolList : PT.Expr = + PT.EList( + gid (), + [ PT.EBool(gid (), true); PT.EBool(gid (), false); PT.EBool(gid (), true) ] + ) + + let boolListList : PT.Expr = + PT.EList( + gid (), + [ PT.EList(gid (), [ PT.EBool(gid (), true); PT.EBool(gid (), false) ]) + PT.EList(gid (), [ PT.EBool(gid (), false); PT.EBool(gid (), true) ]) ] + ) + +module E = Expressions + + +let one = + testTask "1" { + let actual = PT2RT.Expr.toRT 0 E.one + let expected = (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) + return Expect.equal actual expected "" + } + +let onePlusTwo = + testTask "1+2" { + let actual = PT2RT.Expr.toRT 0 E.onePlusTwo + + let expected = + (4, + [ RT.LoadVal( + 0, + RT.DFnVal( + RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) + RT.Return(3) ], + 3) + + return Expect.equal actual expected "" + } + +let defineAndUseVar = + testTask "let x = true in x" { + let actual = PT2RT.Expr.toRT 0 E.defineAndUseVar + + // TODO: re-evaluate if the 3 and 2 here cound be 2 and 1 + // PT2RT uses a register to pass the pass the 'result' of the LP deconstruction + //, and maybe we could reduce that? + let expected = + (3, + [ RT.LoadVal(0, RT.DBool true) + RT.SetVar("x", 0) // where the 'true' is stored + RT.GetVar(2, "x") ], + 2) + + return Expect.equal actual expected "" + } +let boolList = + testTask "[true, false, true]" { + let actual = PT2RT.Expr.toRT 0 E.boolList + + let expected = + (4, + [ RT.LoadVal(0, RT.DList(VT.unknown, [])) + + RT.LoadVal(1, RT.DBool true) + RT.AddItemToList(0, 1) + + RT.LoadVal(2, RT.DBool false) + RT.AddItemToList(0, 2) + + RT.LoadVal(3, RT.DBool true) + RT.AddItemToList(0, 3) ], + 0) + + return Expect.equal actual expected "" + } + +let boolListList = + testTask "[[true; false]; [false; true]]" { + let actual = PT2RT.Expr.toRT 0 E.boolListList + + let expected = + (7, + [ // create outer list + RT.LoadVal(0, RT.DList(VT.unknown, [])) + + // first inner list + RT.LoadVal(1, RT.DList(VT.unknown, [])) + RT.LoadVal(2, RT.DBool true) + RT.AddItemToList(1, 2) + RT.LoadVal(3, RT.DBool false) + RT.AddItemToList(1, 3) + // add it to outer + RT.AddItemToList(0, 1) + + // second inner list + RT.LoadVal(4, RT.DList(VT.unknown, [])) + RT.LoadVal(5, RT.DBool false) + RT.AddItemToList(4, 5) + RT.LoadVal(6, RT.DBool true) + RT.AddItemToList(4, 6) + // add it to outer + RT.AddItemToList(0, 4) ], + 0) + + return Expect.equal actual expected "" + } + +let tests = + testList "PT2RT" [ one; onePlusTwo; defineAndUseVar; boolList; boolListList ] diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 7230634f1f..ec6284e84d 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -35,8 +35,10 @@ let main (args : string array) : int = [ // core Tests.Prelude.tests Tests.ProgramTypes.tests + Tests.ProgramTypesToRuntimeTypes.tests + Tests.Interpreter.tests //Tests.AnalysisTypes.tests - Tests.TreeSitter.tests + //Tests.TreeSitter.tests // Tests.DvalRepr.tests // Tests.PackageManager.tests diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 04beb48348..312d30091b 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -14,8 +14,8 @@ - - + + @@ -37,7 +37,9 @@ - + + + diff --git a/scripts/build/build-parser b/scripts/build/build-parser index 7839a51c94..cbce511d6b 100755 --- a/scripts/build/build-parser +++ b/scripts/build/build-parser @@ -23,7 +23,9 @@ fi echo "Building tree-sitter-darklang.so" zig cc -o tree-sitter-darklang.so -shared src/parser.c src/scanner.c -Isrc -O3 -fPIC - +# compile for WASM +#echo "Building tree-sitter-darklang.wasm" +#zig cc -target wasm32-freestanding -o tree-sitter-darklang.wasm -shared src/parser.c src/scanner.c -Isrc -O3 -fPIC # Optionally cross-compile to other platforms if $cross_compile; then @@ -55,10 +57,12 @@ fi cd .. -# copy `tree-sitter-darklang.so` to `backend/src/LibTreeSitter/lib` +# Copy `tree-sitter-darklang.so`, `.wasm` to `backend/src/LibTreeSitter/lib` mkdir -p backend/src/LibTreeSitter/lib echo "Copying tree-sitter-darklang.so to backend/src/LibTreeSitter/lib" cp tree-sitter-darklang/tree-sitter-darklang.so backend/src/LibTreeSitter/lib +#echo "Copying tree-sitter-darklang.wasm to backend/src/LibTreeSitter/lib" +#cp tree-sitter-darklang/tree-sitter-darklang.wasm backend/src/LibTreeSitter/lib # copy the others too if $cross_compile; then diff --git a/scripts/build/build-tree-sitter.sh b/scripts/build/build-tree-sitter.sh index a01d24b118..11a165d290 100755 --- a/scripts/build/build-tree-sitter.sh +++ b/scripts/build/build-tree-sitter.sh @@ -47,6 +47,7 @@ parallel ::: \ "$HOME/zig/zig cc -target arm-linux-gnueabihf -fPIC -shared -o $output_base_dir/tree-sitter-linux-arm.so $tree_sitter_sources" \ "$HOME/zig/zig cc -target x86_64-macos-none -fPIC -shared -o $output_base_dir/tree-sitter-macos-x64.dylib $tree_sitter_sources" \ "$HOME/zig/zig cc -target aarch64-macos-none -fPIC -shared -o $output_base_dir/tree-sitter-macos-arm64.dylib $tree_sitter_sources" + # "$HOME/zig/zig cc -target wasm32-freestanding -fPIC -shared -o $output_base_dir/tree-sitter.wasm $tree_sitter_sources" # Clean up rm -rf tree-sitter/ \ No newline at end of file diff --git a/scripts/devcontainer/_vscode-post-start-command b/scripts/devcontainer/_vscode-post-start-command index d7eac61dd4..92dee82a90 100755 --- a/scripts/devcontainer/_vscode-post-start-command +++ b/scripts/devcontainer/_vscode-post-start-command @@ -2,8 +2,8 @@ set -euo pipefail -echo "Fetching and building tree-sitter library" -./scripts/build/build-tree-sitter.sh +#echo "Fetching and building tree-sitter library" +#./scripts/build/build-tree-sitter.sh echo "Starting build server" From 06236ce02a356c722ebeeab1cf15ca858b850a04 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 31 Jul 2024 15:10:59 -0400 Subject: [PATCH 04/60] A few more exprs --- backend/src/LibExecution/DvalReprDeveloper.fs | 98 ++--- backend/src/LibExecution/ProgramTypes.fs | 86 ++-- .../ProgramTypesToRuntimeTypes.fs | 49 ++- backend/src/LibExecution/RuntimeTypes.fs | 375 +++++++++--------- backend/src/LibExecution/TypeChecker.fs | 52 +-- backend/tests/TestUtils/TestUtils.fs | 136 +++---- scripts/build/compile | 1 + 7 files changed, 402 insertions(+), 395 deletions(-) diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index 3e45bde3c6..03cd6de507 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -10,23 +10,23 @@ let rec typeName (t : TypeReference) : string = | TUnit -> "Unit" | TBool -> "Bool" - // | TInt8 -> "Int8" - // | TUInt8 -> "UInt8" - // | TInt16 -> "Int16" - // | TUInt16 -> "UInt16" - // | TInt32 -> "Int32" - // | TUInt32 -> "UInt32" + | TInt8 -> "Int8" + | TUInt8 -> "UInt8" + | TInt16 -> "Int16" + | TUInt16 -> "UInt16" + | TInt32 -> "Int32" + | TUInt32 -> "UInt32" | TInt64 -> "Int64" - // | TUInt64 -> "UInt64" - // | TInt128 -> "Int128" - // | TUInt128 -> "UInt128" + | TUInt64 -> "UInt64" + | TInt128 -> "Int128" + | TUInt128 -> "UInt128" - // | TFloat -> "Float" - // | TChar -> "Char" + | TFloat -> "Float" + | TChar -> "Char" | TString -> "String" - // | TDateTime -> "DateTime" - // | TUuid -> "Uuid" + | TDateTime -> "DateTime" + | TUuid -> "Uuid" | TList nested -> $"List<{typeName nested}>" // | TTuple(n1, n2, rest) -> @@ -58,24 +58,24 @@ let rec private knownTypeName (vt : KnownType) : string = | KTBool -> "Bool" - // | KTInt8 -> "Int8" - // | KTUInt8 -> "UInt8" - // | KTInt16 -> "Int16" - // | KTUInt16 -> "UInt16" - // | KTInt32 -> "Int32" - // | KTUInt32 -> "UInt32" + | KTInt8 -> "Int8" + | KTUInt8 -> "UInt8" + | KTInt16 -> "Int16" + | KTUInt16 -> "UInt16" + | KTInt32 -> "Int32" + | KTUInt32 -> "UInt32" | KTInt64 -> "Int64" - // | KTUInt64 -> "UInt64" - // | KTInt128 -> "Int128" - // | KTUInt128 -> "UInt128" + | KTUInt64 -> "UInt64" + | KTInt128 -> "Int128" + | KTUInt128 -> "UInt128" - // | KTFloat -> "Float" + | KTFloat -> "Float" - // | KTChar -> "Char" + | KTChar -> "Char" | KTString -> "String" - // | KTDateTime -> "DateTime" - // | KTUuid -> "Uuid" + | KTDateTime -> "DateTime" + | KTUuid -> "Uuid" | KTList typ -> $"List<{valueTypeName typ}>" // | KTDict typ -> $"Dict<{valueTypeName typ}>" @@ -135,34 +135,34 @@ let toRepr (dv : Dval) : string = | DBool true -> "true" | DBool false -> "false" - // | DInt8 i -> string i - // | DUInt8 i -> string i - // | DInt16 i -> string i - // | DUInt16 i -> string i - // | DInt32 i -> string i - // | DUInt32 i -> string i + | DInt8 i -> string i + | DUInt8 i -> string i + | DInt16 i -> string i + | DUInt16 i -> string i + | DInt32 i -> string i + | DUInt32 i -> string i | DInt64 i -> string i - // | DUInt64 i -> string i - // | DInt128 i -> string i - // | DUInt128 i -> string i - - // | DFloat f -> - // if System.Double.IsPositiveInfinity f then - // "Infinity" - // else if System.Double.IsNegativeInfinity f then - // "-Infinity" - // else if System.Double.IsNaN f then - // "NaN" - // else - // let result = sprintf "%.12g" f - // if result.Contains "." then result else $"{result}.0" + | DUInt64 i -> string i + | DInt128 i -> string i + | DUInt128 i -> string i + + | DFloat f -> + if System.Double.IsPositiveInfinity f then + "Infinity" + else if System.Double.IsNegativeInfinity f then + "-Infinity" + else if System.Double.IsNaN f then + "NaN" + else + let result = sprintf "%.12g" f + if result.Contains "." then result else $"{result}.0" - // | DChar c -> $"'{c}'" + | DChar c -> $"'{c}'" | DString s -> $"\"{s}\"" - // | DDateTime d -> wrap (DarkDateTime.toIsoString d) + | DDateTime d -> wrap (DarkDateTime.toIsoString d) // | DDB name -> wrap name - // | DUuid uuid -> wrap (string uuid) + | DUuid uuid -> wrap (string uuid) | DList(_, l) -> if List.isEmpty l then diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 1f4036a9cc..a2070328ed 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -187,26 +187,26 @@ type TypeReference = | TBool - // | TInt8 - // | TUInt8 - // | TInt16 - // | TUInt16 - // | TInt32 - // | TUInt32 + | TInt8 + | TUInt8 + | TInt16 + | TUInt16 + | TInt32 + | TUInt32 | TInt64 -// | TUInt64 -// | TInt128 -// | TUInt128 + | TUInt64 + | TInt128 + | TUInt128 -// | TFloat + | TFloat -// | TChar + | TChar //| TString -// | TUuid -// | TDateTime + | TUuid + | TDateTime -// | TList of TypeReference + | TList of TypeReference // | TTuple of TypeReference * TypeReference * List // | TDict of TypeReference @@ -231,25 +231,25 @@ type Expr = | EUnit of id | EBool of id * bool - // | EInt8 of id * int8 - // | EUInt8 of id * uint8 - // | EInt16 of id * int16 - // | EUInt16 of id * uint16 - // | EInt32 of id * int32 - // | EUInt32 of id * uint32 + | EInt8 of id * int8 + | EUInt8 of id * uint8 + | EInt16 of id * int16 + | EUInt16 of id * uint16 + | EInt32 of id * int32 + | EUInt32 of id * uint32 | EInt64 of id * int64 - // | EUInt64 of id * uint64 - // | EInt128 of id * System.Int128 - // | EUInt128 of id * System.UInt128 - - // // Allow the user to have arbitrarily big numbers, even if they don't make sense as - // // floats. The float is split as we want to preserve what the user entered. - // // Strings are used as numbers lose the leading zeros (eg 7.00007) - // | EFloat of id * Sign * string * string - - // /// A character is an Extended Grapheme Cluster (hence why we use a string). This - // /// is equivalent to one screen-visible "character" in Unicode. - // | EChar of id * string + | EUInt64 of id * uint64 + | EInt128 of id * System.Int128 + | EUInt128 of id * System.UInt128 + + // Allow the user to have arbitrarily big numbers, even if they don't make sense as + // floats. The float is split as we want to preserve what the user entered. + // Strings are used as numbers lose the leading zeros (eg 7.00007) + | EFloat of id * Sign * string * string + + /// A character is an Extended Grapheme Cluster (hence why we use a string). This + /// is equivalent to one screen-visible "character" in Unicode. + | EChar of id * string //| EString of id * List @@ -375,19 +375,19 @@ module Expr = match expr with | EUnit id | EBool(id, _) - // | EInt8(id, _) - // | EUInt8(id, _) - // | EInt16(id, _) - // | EUInt16(id, _) - // | EInt32(id, _) - // | EUInt32(id, _) + | EInt8(id, _) + | EUInt8(id, _) + | EInt16(id, _) + | EUInt16(id, _) + | EInt32(id, _) + | EUInt32(id, _) | EInt64(id, _) - // | EUInt64(id, _) - // | EInt128(id, _) - // | EUInt128(id, _) - // | EChar(id, _) + | EUInt64(id, _) + | EInt128(id, _) + | EUInt128(id, _) + | EChar(id, _) //| EString(id, _) - // | EFloat(id, _, _, _) + | EFloat(id, _, _, _) // | EConstant(id, _) | ELet(id, _, _, _) // | EIf(id, _, _, _) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 83dcb59629..ac1ca71a07 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -79,29 +79,29 @@ module TypeReference = | PT.TBool -> RT.TBool - // | PT.TInt8 -> RT.TInt8 - // | PT.TUInt8 -> RT.TUInt8 - // | PT.TInt16 -> RT.TInt16 - // | PT.TUInt16 -> RT.TUInt16 - // | PT.TInt32 -> RT.TInt32 - // | PT.TUInt32 -> RT.TUInt32 + | PT.TInt8 -> RT.TInt8 + | PT.TUInt8 -> RT.TUInt8 + | PT.TInt16 -> RT.TInt16 + | PT.TUInt16 -> RT.TUInt16 + | PT.TInt32 -> RT.TInt32 + | PT.TUInt32 -> RT.TUInt32 | PT.TInt64 -> RT.TInt64 -// | PT.TUInt64 -> RT.TUInt64 -// | PT.TInt128 -> RT.TInt128 -// | PT.TUInt128 -> RT.TUInt128 + | PT.TUInt64 -> RT.TUInt64 + | PT.TInt128 -> RT.TInt128 + | PT.TUInt128 -> RT.TUInt128 -// | PT.TFloat -> RT.TFloat + | PT.TFloat -> RT.TFloat -// | PT.TChar -> RT.TChar + | PT.TChar -> RT.TChar //| PT.TString -> RT.TString -// | PT.TList inner -> RT.TList(toRT inner) + | PT.TList inner -> RT.TList(toRT inner) // | PT.TTuple(first, second, theRest) -> // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) // | PT.TDict typ -> RT.TDict(toRT typ) -// | PT.TDateTime -> RT.TDateTime -// | PT.TUuid -> RT.TUuid + | PT.TDateTime -> RT.TDateTime + | PT.TUuid -> RT.TUuid // | PT.TCustomType(typeName, typeArgs) -> // RT.TCustomType( // NameResolution.toRT FQTypeName.toRT typeName, @@ -192,7 +192,23 @@ module Expr = | PT.EBool(_id, b) -> (rc + 1, [ RT.LoadVal(rc, RT.DBool b) ], rc) + | PT.EInt8(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt8 num) ], rc) + | PT.EInt16(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt16 num) ], rc) + | PT.EInt32(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt32 num) ], rc) | PT.EInt64(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt64 num) ], rc) + | PT.EInt128(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt128 num) ], rc) + | PT.EUInt8(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt8 num) ], rc) + | PT.EUInt16(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt16 num) ], rc) + | PT.EUInt32(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt32 num) ], rc) + | PT.EUInt64(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt64 num) ], rc) + | PT.EUInt128(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt128 num) ], rc) + + | PT.EFloat(_id, sign, whole, fraction) -> + let whole = if whole = "" then "0" else whole + let fraction = if fraction = "" then "0" else fraction + (rc + 1, [ RT.LoadVal(rc, RT.DFloat(makeFloat sign whole fraction)) ], rc) + + | PT.EChar(_id, c) -> (rc + 1, [ RT.LoadVal(rc, RT.DChar c) ], rc) | PT.EList(_id, items) -> @@ -210,6 +226,11 @@ module Expr = (regCounter, instrs, listReg) + // | PT.ETuple(_id, first, second, theRest) -> + // let tupleReg = rc + // //TODO handle VT + // let init = (rc + 1, [ RT.LoadVal(tupleReg, RT.DTuple(VT.unknown, VT.unknown, [])) ]) + // let x = 1 | PT.ELet(_id, pat, expr, body) -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 591cc51187..e2c693dedd 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -148,21 +148,21 @@ module FQFnName = type KnownType = | KTUnit | KTBool - // | KTInt8 - // | KTUInt8 - // | KTInt16 - // | KTUInt16 - // | KTInt32 - // | KTUInt32 + | KTInt8 + | KTUInt8 + | KTInt16 + | KTUInt16 + | KTInt32 + | KTUInt32 | KTInt64 - // | KTUInt64 - // | KTInt128 - // | KTUInt128 - // | KTFloat - // | KTChar + | KTUInt64 + | KTInt128 + | KTUInt128 + | KTFloat + | KTChar | KTString - // | KTUuid - // | KTDateTime + | KTUuid + | KTDateTime /// let empty = [] // KTList Unknown /// let intList = [1] // KTList (ValueType.Known KTInt64) @@ -227,23 +227,23 @@ module ValueType = let unit = known KTUnit let bool = known KTBool - // let int8 = known KTInt8 - // let uint8 = known KTUInt8 - // let int16 = known KTInt16 - // let uint16 = known KTUInt16 - // let int32 = known KTInt32 - // let uint32 = known KTUInt32 + let int8 = known KTInt8 + let uint8 = known KTUInt8 + let int16 = known KTInt16 + let uint16 = known KTUInt16 + let int32 = known KTInt32 + let uint32 = known KTUInt32 let int64 = known KTInt64 - // let uint64 = known KTUInt64 - // let int128 = known KTInt128 - // let uint128 = known KTUInt128 - // let float = known KTFloat - // let char = known KTChar + let uint64 = known KTUInt64 + let int128 = known KTInt128 + let uint128 = known KTUInt128 + let float = known KTFloat + let char = known KTChar let string = known KTString - // let dateTime = known KTDateTime - // let uuid = known KTUuid + let dateTime = known KTDateTime + let uuid = known KTUuid - // let list (inner : ValueType) : ValueType = known (KTList inner) + let list (inner : ValueType) : ValueType = known (KTList inner) // let dict (inner : ValueType) : ValueType = known (KTDict inner) // let tuple // (first : ValueType) @@ -265,21 +265,21 @@ module ValueType = match kt with | KTUnit -> "Unit" | KTBool -> "Bool" - // | KTInt8 -> "Int8" - // | KTUInt8 -> "UInt8" - // | KTInt16 -> "Int16" - // | KTUInt16 -> "UInt16" - // | KTInt32 -> "Int32" - // | KTUInt32 -> "UInt32" + | KTInt8 -> "Int8" + | KTUInt8 -> "UInt8" + | KTInt16 -> "Int16" + | KTUInt16 -> "UInt16" + | KTInt32 -> "Int32" + | KTUInt32 -> "UInt32" | KTInt64 -> "Int64" - // | KTUInt64 -> "UInt64" - // | KTInt128 -> "Int128" - // | KTUInt128 -> "UInt128" - // | KTFloat -> "Float" - // | KTChar -> "Char" + | KTUInt64 -> "UInt64" + | KTInt128 -> "Int128" + | KTUInt128 -> "UInt128" + | KTFloat -> "Float" + | KTChar -> "Char" | KTString -> "String" - // | KTUuid -> "Uuid" - // | KTDateTime -> "DateTime" + | KTUuid -> "Uuid" + | KTDateTime -> "DateTime" | KTList inner -> $"List<{toString inner}>" // | KTDict inner -> $"Dict<{toString inner}>" @@ -314,23 +314,23 @@ module ValueType = match left, right with | KTUnit, KTUnit -> KTUnit |> Ok | KTBool, KTBool -> KTBool |> Ok - // | KTInt8, KTInt8 -> KTInt8 |> Ok - // | KTUInt8, KTUInt8 -> KTUInt8 |> Ok - // | KTInt16, KTInt16 -> KTInt16 |> Ok - // | KTUInt16, KTUInt16 -> KTUInt16 |> Ok - // | KTInt32, KTInt32 -> KTInt32 |> Ok - // | KTUInt32, KTUInt32 -> KTUInt32 |> Ok + | KTInt8, KTInt8 -> KTInt8 |> Ok + | KTUInt8, KTUInt8 -> KTUInt8 |> Ok + | KTInt16, KTInt16 -> KTInt16 |> Ok + | KTUInt16, KTUInt16 -> KTUInt16 |> Ok + | KTInt32, KTInt32 -> KTInt32 |> Ok + | KTUInt32, KTUInt32 -> KTUInt32 |> Ok | KTInt64, KTInt64 -> KTInt64 |> Ok - // | KTUInt64, KTUInt64 -> KTUInt64 |> Ok - // | KTInt128, KTInt128 -> KTInt128 |> Ok - // | KTUInt128, KTUInt128 -> KTUInt128 |> Ok - // | KTFloat, KTFloat -> KTFloat |> Ok - // | KTChar, KTChar -> KTChar |> Ok + | KTUInt64, KTUInt64 -> KTUInt64 |> Ok + | KTInt128, KTInt128 -> KTInt128 |> Ok + | KTUInt128, KTUInt128 -> KTUInt128 |> Ok + | KTFloat, KTFloat -> KTFloat |> Ok + | KTChar, KTChar -> KTChar |> Ok | KTString, KTString -> KTString |> Ok - // | KTUuid, KTUuid -> KTUuid |> Ok - // | KTDateTime, KTDateTime -> KTDateTime |> Ok + | KTUuid, KTUuid -> KTUuid |> Ok + | KTDateTime, KTDateTime -> KTDateTime |> Ok - // | KTList left, KTList right -> r left right |> Result.map KTList + | KTList left, KTList right -> r left right |> Result.map KTList // | KTDict left, KTDict right -> r left right |> Result.map KTDict // | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> // let firstMerged = r l1 r1 @@ -432,21 +432,21 @@ type NameResolution<'a> = Result<'a, RuntimeError> and TypeReference = | TUnit | TBool - // | TInt8 - // | TUInt8 - // | TInt16 - // | TUInt16 - // | TInt32 - // | TUInt32 + | TInt8 + | TUInt8 + | TInt16 + | TUInt16 + | TInt32 + | TUInt32 | TInt64 - // | TUInt64 - // | TInt128 - // | TUInt128 - // | TFloat - // | TChar + | TUInt64 + | TInt128 + | TUInt128 + | TFloat + | TChar | TString - // | TUuid - // | TDateTime + | TUuid + | TDateTime | TList of TypeReference // | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference @@ -467,21 +467,21 @@ and TypeReference = match t with | TUnit | TBool - // | TInt8 - // | TUInt8 - // | TInt16 - // | TUInt16 - // | TInt32 - // | TUInt32 + | TInt8 + | TUInt8 + | TInt16 + | TUInt16 + | TInt32 + | TUInt32 | TInt64 - // | TUInt64 - // | TInt128 - // | TUInt128 - // | TFloat - // | TChar + | TUInt64 + | TInt128 + | TUInt128 + | TFloat + | TChar | TString - // | TUuid - // | TDateTime + | TUuid + | TDateTime -> true | TList t -> isConcrete t @@ -546,20 +546,6 @@ and InstructionsWithContext = // // Expressions here are runtime variants of the AST in ProgramTypes, having had // // superfluous information removed. // and Expr = -// | EUnit of id - -// | EBool of id * bool - -// // | EInt8 of id * int8 -// // | EUInt8 of id * uint8 -// // | EInt16 of id * int16 -// // | EUInt16 of id * uint16 -// // | EInt32 of id * int32 -// // | EUInt32 of id * uint32 -// | EInt64 of id * int64 -// // | EUInt64 of id * uint64 -// // | EInt128 of id * System.Int128 -// // | EUInt128 of id * System.UInt128 // // | EFloat of id * double @@ -583,7 +569,6 @@ and InstructionsWithContext = // //| ELambda of id * pats : NEList * body : Expr // // // structures -// // | EList of id * List // // | ETuple of id * Expr * Expr * List // // | EDict of id * List @@ -634,24 +619,24 @@ and [] Dval = // Simple types | DBool of bool - // | DInt8 of int8 - // | DUInt8 of uint8 - // | DInt16 of int16 - // | DUInt16 of uint16 - // | DInt32 of int32 - // | DUInt32 of uint32 + | DInt8 of int8 + | DUInt8 of uint8 + | DInt16 of int16 + | DUInt16 of uint16 + | DInt32 of int32 + | DUInt32 of uint32 | DInt64 of int64 - // | DUInt64 of uint64 - // | DInt128 of System.Int128 - // | DUInt128 of System.UInt128 + | DUInt64 of uint64 + | DInt128 of System.Int128 + | DUInt128 of System.UInt128 - // | DFloat of double + | DFloat of double - // | DChar of string // TextElements (extended grapheme clusters) are provided as strings + | DChar of string // TextElements (extended grapheme clusters) are provided as strings | DString of string - // | DDateTime of DarkDateTime.T - // | DUuid of System.Guid + | DDateTime of DarkDateTime.T + | DUuid of System.Guid // Compound types | DList of ValueType * List @@ -979,24 +964,24 @@ module Dval = | DUnit, TUnit | DBool _, TBool - // | DInt8 _, TInt8 - // | DUInt8 _, TUInt8 - // | DInt16 _, TInt16 - // | DUInt16 _, TUInt16 - // | DInt32 _, TInt32 - // | DUInt32 _, TUInt32 + | DInt8 _, TInt8 + | DUInt8 _, TUInt8 + | DInt16 _, TInt16 + | DUInt16 _, TUInt16 + | DInt32 _, TInt32 + | DUInt32 _, TUInt32 | DInt64 _, TInt64 - // | DUInt64 _, TUInt64 - // | DInt128 _, TInt128 - // | DUInt128 _, TUInt128 + | DUInt64 _, TUInt64 + | DInt128 _, TInt128 + | DUInt128 _, TUInt128 - // | DFloat _, TFloat + | DFloat _, TFloat - // | DChar _, TChar + | DChar _, TChar | DString _, TString - // | DDateTime _, TDateTime - // | DUuid _, TUuid + | DDateTime _, TDateTime + | DUuid _, TUuid // | DDB _, TDB _ -> true @@ -1027,21 +1012,21 @@ module Dval = // exhaustiveness checking | DUnit, _ | DBool _, _ - // | DInt8 _, _ - // | DUInt8 _, _ - // | DInt16 _, _ - // | DUInt16 _, _ - // | DInt32 _, _ - // | DUInt32 _, _ + | DInt8 _, _ + | DUInt8 _, _ + | DInt16 _, _ + | DUInt16 _, _ + | DInt32 _, _ + | DUInt32 _, _ | DInt64 _, _ - // | DUInt64 _, _ - // | DInt128 _, _ - // | DUInt128 _, _ - // | DFloat _, _ + | DUInt64 _, _ + | DInt128 _, _ + | DUInt128 _, _ + | DFloat _, _ | DString _, _ - // | DDateTime _, _ - // | DUuid _, _ - // | DChar _, _ + | DDateTime _, _ + | DUuid _, _ + | DChar _, _ // | DDB _, _ | DList _, _ // | DTuple _, _ @@ -1058,21 +1043,21 @@ module Dval = | DBool _ -> ValueType.Known KTBool - // | DInt8 _ -> ValueType.Known KTInt8 - // | DUInt8 _ -> ValueType.Known KTUInt8 - // | DInt16 _ -> ValueType.Known KTInt16 - // | DUInt16 _ -> ValueType.Known KTUInt16 - // | DInt32 _ -> ValueType.Known KTInt32 - // | DUInt32 _ -> ValueType.Known KTUInt32 + | DInt8 _ -> ValueType.Known KTInt8 + | DUInt8 _ -> ValueType.Known KTUInt8 + | DInt16 _ -> ValueType.Known KTInt16 + | DUInt16 _ -> ValueType.Known KTUInt16 + | DInt32 _ -> ValueType.Known KTInt32 + | DUInt32 _ -> ValueType.Known KTUInt32 | DInt64 _ -> ValueType.Known KTInt64 - // | DUInt64 _ -> ValueType.Known KTUInt64 - // | DInt128 _ -> ValueType.Known KTInt128 - // | DUInt128 _ -> ValueType.Known KTUInt128 - // | DFloat _ -> ValueType.Known KTFloat - // | DChar _ -> ValueType.Known KTChar + | DUInt64 _ -> ValueType.Known KTUInt64 + | DInt128 _ -> ValueType.Known KTInt128 + | DUInt128 _ -> ValueType.Known KTUInt128 + | DFloat _ -> ValueType.Known KTFloat + | DChar _ -> ValueType.Known KTChar | DString _ -> ValueType.Known KTString - // | DDateTime _ -> ValueType.Known KTDateTime - // | DUuid _ -> ValueType.Known KTUuid + | DDateTime _ -> ValueType.Known KTDateTime + | DUuid _ -> ValueType.Known KTUuid | DList(t, _) -> ValueType.Known(KTList t) // | DDict(t, _) -> ValueType.Known(KTDict t) @@ -1103,10 +1088,10 @@ module Dval = // | DDB _ -> ValueType.Unknown - // let asList (dv : Dval) : Option> = - // match dv with - // | DList(_, l) -> Some l - // | _ -> None + let asList (dv : Dval) : Option> = + match dv with + | DList(_, l) -> Some l + | _ -> None // let asDict (dv : Dval) : Option> = // match dv with @@ -1128,70 +1113,70 @@ module Dval = | DString s -> Some s | _ -> None - // let asInt8 (dv : Dval) : Option = - // match dv with - // | DInt8 i -> Some i - // | _ -> None + let asInt8 (dv : Dval) : Option = + match dv with + | DInt8 i -> Some i + | _ -> None - // let asUInt8 (dv : Dval) : Option = - // match dv with - // | DUInt8 i -> Some i - // | _ -> None + let asUInt8 (dv : Dval) : Option = + match dv with + | DUInt8 i -> Some i + | _ -> None - // let asInt16 (dv : Dval) : Option = - // match dv with - // | DInt16 i -> Some i - // | _ -> None + let asInt16 (dv : Dval) : Option = + match dv with + | DInt16 i -> Some i + | _ -> None - // let asUInt16 (dv : Dval) : Option = - // match dv with - // | DUInt16 i -> Some i - // | _ -> None + let asUInt16 (dv : Dval) : Option = + match dv with + | DUInt16 i -> Some i + | _ -> None - // let asInt32 (dv : Dval) : Option = - // match dv with - // | DInt32 i -> Some i - // | _ -> None + let asInt32 (dv : Dval) : Option = + match dv with + | DInt32 i -> Some i + | _ -> None - // let asUInt32 (dv : Dval) : Option = - // match dv with - // | DUInt32 i -> Some i - // | _ -> None + let asUInt32 (dv : Dval) : Option = + match dv with + | DUInt32 i -> Some i + | _ -> None let asInt64 (dv : Dval) : Option = match dv with | DInt64 i -> Some i | _ -> None - // let asUInt64 (dv : Dval) : Option = - // match dv with - // | DUInt64 i -> Some i - // | _ -> None + let asUInt64 (dv : Dval) : Option = + match dv with + | DUInt64 i -> Some i + | _ -> None - // let asInt128 (dv : Dval) : Option = - // match dv with - // | DInt128 i -> Some i - // | _ -> None + let asInt128 (dv : Dval) : Option = + match dv with + | DInt128 i -> Some i + | _ -> None - // let asUInt128 (dv : Dval) : Option = - // match dv with - // | DUInt128 i -> Some i - // | _ -> None + let asUInt128 (dv : Dval) : Option = + match dv with + | DUInt128 i -> Some i + | _ -> None - // let asFloat (dv : Dval) : Option = - // match dv with - // | DFloat f -> Some f - // | _ -> None + let asFloat (dv : Dval) : Option = + match dv with + | DFloat f -> Some f + | _ -> None let asBool (dv : Dval) : Option = match dv with | DBool b -> Some b | _ -> None -// let asUuid (dv : Dval) : Option = -// match dv with -// | DUuid u -> Some u -// | _ -> None + let asUuid (dv : Dval) : Option = + match dv with + | DUuid u -> Some u + | _ -> None // type Const = diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index c2edc6cbc5..96fc7c1fce 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -265,24 +265,24 @@ let rec unify | TBool, DBool _ -> return Ok() | TUnit, DUnit -> return Ok() - // | TInt8, DInt8 _ -> return Ok() - // | TUInt8, DUInt8 _ -> return Ok() - // | TInt16, DInt16 _ -> return Ok() - // | TUInt16, DUInt16 _ -> return Ok() - // | TInt32, DInt32 _ -> return Ok() - // | TUInt32, DUInt32 _ -> return Ok() + | TInt8, DInt8 _ -> return Ok() + | TUInt8, DUInt8 _ -> return Ok() + | TInt16, DInt16 _ -> return Ok() + | TUInt16, DUInt16 _ -> return Ok() + | TInt32, DInt32 _ -> return Ok() + | TUInt32, DUInt32 _ -> return Ok() | TInt64, DInt64 _ -> return Ok() - // | TUInt64, DUInt64 _ -> return Ok() - // | TInt128, DInt128 _ -> return Ok() - // | TUInt128, DUInt128 _ -> return Ok() + | TUInt64, DUInt64 _ -> return Ok() + | TInt128, DInt128 _ -> return Ok() + | TUInt128, DUInt128 _ -> return Ok() - // | TFloat, DFloat _ -> return Ok() + | TFloat, DFloat _ -> return Ok() - //| TChar, DChar _ -> return Ok() + | TChar, DChar _ -> return Ok() | TString, DString _ -> return Ok() - // | TDateTime, DDateTime _ -> return Ok() - // | TUuid, DUuid _ -> return Ok() + | TDateTime, DDateTime _ -> return Ok() + | TUuid, DUuid _ -> return Ok() // | TDB _, DDB _ -> return Ok() // TODO: check DB type | TList expected, DList(actual, _dvs) -> @@ -426,29 +426,29 @@ let rec unify | TUnit, _ | TBool, _ - // | TInt8, _ - // | TUInt8, _ - // | TInt16, _ - // | TUInt16, _ - // | TInt32, _ - // | TUInt32, _ + | TInt8, _ + | TUInt8, _ + | TInt16, _ + | TUInt16, _ + | TInt32, _ + | TUInt32, _ | TInt64, _ - // | TUInt64, _ - // | TInt128, _ - // | TUInt128, _ + | TUInt64, _ + | TInt128, _ + | TUInt128, _ - // | TFloat, _ + | TFloat, _ // | TTuple _, _ // | TCustomType _, _ // | TVariable _, _ | TString, _ | TList _, _ - // | TDateTime, _ + | TDateTime, _ // | TDict _, _ | TFn _, _ - // | TUuid, _ - // | TChar, _ + | TUuid, _ + | TChar, _ // | TDB _, _ -> return diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 2f1b23467d..13e5087165 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -363,26 +363,26 @@ module Expect = | DUnit | DBool _ - // | DInt8 _ - // | DUInt8 _ - // | DInt16 _ - // | DUInt16 _ - // | DInt32 _ - // | DUInt32 _ + | DInt8 _ + | DUInt8 _ + | DInt16 _ + | DUInt16 _ + | DInt32 _ + | DUInt32 _ | DInt64 _ - // | DUInt64 _ - // | DInt128 _ - // | DUInt128 _ + | DUInt64 _ + | DInt128 _ + | DUInt128 _ - // | DFloat _ + | DFloat _ - // | DDateTime _ - // | DUuid _ + | DDateTime _ + | DUuid _ | DFnVal _ // | DDB _ -> true - // | DChar str -> str.IsNormalized() && String.lengthInEgcs str = 1 + | DChar str -> str.IsNormalized() && String.lengthInEgcs str = 1 | DString str -> str.IsNormalized() | DList(_, items) -> List.all r items @@ -729,7 +729,7 @@ module Expect = (errorFn : Path -> string -> string -> unit) : unit = let de p a e = dvalEqualityBaseFn p a e errorFn - //let error path = errorFn path (string actual) (string expected) + let error path = errorFn path (string actual) (string expected) let check (path : Path) (a : 'a) (e : 'a) : unit = if a <> e then errorFn path (debugDval actual) (debugDval expected) @@ -740,34 +740,34 @@ module Expect = | Error() -> errorFn path (debugDval actual) (debugDval expected) match actual, expected with - // | DFloat l, DFloat r -> - // if System.Double.IsNaN l && System.Double.IsNaN r then - // // This isn't "true" equality, it's just for tests - // () - // else if - // System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r - // then - // () - // else if - // System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r - // then - // () - // else if - // System.Double.IsNaN l - // || System.Double.IsNaN r - // || System.Double.IsPositiveInfinity l - // || System.Double.IsPositiveInfinity r - // || System.Double.IsNegativeInfinity l - // || System.Double.IsNegativeInfinity r - // then - // error path - // else if not (Accuracy.areClose Accuracy.veryHigh l r) then - // error path - // | DDateTime l, DDateTime r -> - // // Two dates can be the same millisecond and not be equal if they don't - // // have the same number of ticks. For testing, we shall consider them - // // equal if they print the same string. - // check path (string l) (string r) + | DFloat l, DFloat r -> + if System.Double.IsNaN l && System.Double.IsNaN r then + // This isn't "true" equality, it's just for tests + () + else if + System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r + then + () + else if + System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r + then + () + else if + System.Double.IsNaN l + || System.Double.IsNaN r + || System.Double.IsPositiveInfinity l + || System.Double.IsPositiveInfinity r + || System.Double.IsNegativeInfinity l + || System.Double.IsNegativeInfinity r + then + error path + else if not (Accuracy.areClose Accuracy.veryHigh l r) then + error path + | DDateTime l, DDateTime r -> + // Two dates can be the same millisecond and not be equal if they don't + // have the same number of ticks. For testing, we shall consider them + // equal if they print the same string. + check path (string l) (string r) | DList(lType, ls), DList(rType, rs) -> checkValueType ("Type" :: path) lType rType @@ -861,21 +861,21 @@ module Expect = // Keep for exhaustiveness checking | DUnit, _ | DBool _, _ - // | DInt8 _, _ - // | DUInt8 _, _ - // | DInt16 _, _ - // | DUInt16 _, _ - // | DInt32 _, _ - // | DUInt32 _, _ + | DInt8 _, _ + | DUInt8 _, _ + | DInt16 _, _ + | DUInt16 _, _ + | DInt32 _, _ + | DUInt32 _, _ | DInt64 _, _ - // | DUInt64 _, _ - // | DInt128 _, _ - // | DUInt128 _, _ - // | DFloat _, _ - // | DChar _, _ + | DUInt64 _, _ + | DInt128 _, _ + | DUInt128 _, _ + | DFloat _, _ + | DChar _, _ | DString _, _ - // | DDateTime _, _ - // | DUuid _, _ + | DDateTime _, _ + | DUuid _, _ | DList _, _ // | DTuple _, _ // | DDict _, _ @@ -937,21 +937,21 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = // Keep for exhaustiveness checking | DUnit | DBool _ - // | DInt8 _ - // | DUInt8 _ - // | DInt16 _ - // | DUInt16 _ - // | DInt32 _ - // | DUInt32 _ + | DInt8 _ + | DUInt8 _ + | DInt16 _ + | DUInt16 _ + | DInt32 _ + | DUInt32 _ | DInt64 _ - // | DUInt64 _ - // | DInt128 _ - // | DUInt128 _ - // | DFloat _ - // | DChar _ + | DUInt64 _ + | DInt128 _ + | DUInt128 _ + | DFloat _ + | DChar _ | DString _ // TODO: should actually traverse in interpolations - // | DUuid _ - // | DDateTime _ + | DUuid _ + | DDateTime _ | DFnVal _ // | DDB _ -> f dv diff --git a/scripts/build/compile b/scripts/build/compile index 7b176e471f..61db03c3c8 100755 --- a/scripts/build/compile +++ b/scripts/build/compile @@ -15,6 +15,7 @@ optimize = in_ci fsharp_thing_to_build = "fsdark.sln" # sometimes it's handy to only build a specific project fsharp_thing_to_build = "tests/Tests" +#fsharp_thing_to_build = "src/LibExecution" # Make io unbuffered def flush(fn): From 545ee99518849eb71da7e51c4039b205ef48f794 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 31 Jul 2024 15:50:32 -0400 Subject: [PATCH 05/60] no-op commentary/thinking --- ...Interpreter copy.fs => Interpreter.Old.fs} | 28 ------------------- backend/src/LibExecution/Interpreter.fs | 22 ++++++++++++--- 2 files changed, 18 insertions(+), 32 deletions(-) rename backend/src/LibExecution/{Interpreter copy.fs => Interpreter.Old.fs} (97%) diff --git a/backend/src/LibExecution/Interpreter copy.fs b/backend/src/LibExecution/Interpreter.Old.fs similarity index 97% rename from backend/src/LibExecution/Interpreter copy.fs rename to backend/src/LibExecution/Interpreter.Old.fs index e0068e425d..ce9f6ae9b8 100644 --- a/backend/src/LibExecution/Interpreter copy.fs +++ b/backend/src/LibExecution/Interpreter.Old.fs @@ -347,25 +347,6 @@ let rec eval (state : ExecutionState) (e : Instructions) : DvalTask = uply { match e with - | EUnit _ -> return DUnit - - | EBool(_, b) -> return DBool b - - // | EInt8(_, i) -> return DInt8 i - // | EUInt8(_, i) -> return DUInt8 i - // | EInt16(_, i) -> return DInt16 i - // | EUInt16(_, i) -> return DUInt16 i - // | EInt32(_, i) -> return DInt32 i - // | EUInt32(_, i) -> return DUInt32 i - | EInt64(_, i) -> return DInt64 i - // | EUInt64(_, i) -> return DUInt64 i - // | EInt128(_, i) -> return DInt128 i - // | EUInt128(_, i) -> return DUInt128 i - - // | EFloat(_, value) -> return DFloat value - - // | EChar(_, s) -> return DChar s - | EString(_, [ StringText s ]) -> // We expect strings to be normalized during parsing return DString(s) @@ -413,21 +394,12 @@ let rec eval (state : ExecutionState) (e : Instructions) : DvalTask = // return! eval { state with symbolTable = newSymtable } body - // | EList(_, exprs) -> - // let! results = Ply.List.mapSequentially (eval state) exprs - // return TypeChecker.DvalCreator.list callStack VT.unknown results - // | ETuple(_, first, second, theRest) -> // let! firstResult = eval state first // let! secondResult = eval state second // let! otherResults = Ply.List.mapSequentially (eval state) theRest // return DTuple(firstResult, secondResult, otherResults) - // | EVariable(_, name) -> - // match Map.find name state.symbolTable with - // | None -> return errStr callStack $"There is no variable named: {name}" - // | Some other -> return other - // | ERecord(_, typeName, fields) -> // let types = ExecutionState.availableTypes state diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index c99cd38ac8..3f2018173e 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -50,8 +50,14 @@ let rec execute // later, `x` | GetVar(loadTo, varName) -> - let value = Map.find varName vmState.variables |> Option.defaultValue DUnit // TODO + let value = + Map.find varName vmState.variables + // TODO: handle missing variable + //return errStr callStack $"There is no variable named: {name}" + |> Option.defaultValue DUnit + vmState.registers[loadTo] <- value + return! execute state vmState instructions resultReg (counter + 1) @@ -70,6 +76,11 @@ let rec execute match vmState.registers[listReg] with | DList(vt, list) -> // TODO: type checking of item-add; adjust vt + + // Had: + // let! results = Ply.List.mapSequentially (eval state) exprs + // return TypeChecker.DvalCreator.list callStack VT.unknown results + let itemToAdd = vmState.registers[itemToAddReg] vmState.registers[listReg] <- DList(vt, list @ [ itemToAdd ]) return! execute state vmState instructions resultReg (counter + 1) @@ -224,7 +235,8 @@ and execFn return result } - | PackageFunction(_id, _body) -> + | PackageFunction(_id, _instructionsWithContext) -> + //let _registersNeeded, instructions, resultReg = _instructionsWithContext // // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? // // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) // let executionPoint = ExecutionPoint.Function(FQFnName.Package id) @@ -235,7 +247,9 @@ and execFn // // { state with // // tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } - // eval state body + // and how can we pass the args in? + // maybe fns need some LoadVal instructions frontloaded or something? hmm. + //eval state instructions resultReg Ply DUnit // TODO match! TypeChecker.checkFunctionReturnType types typeSymbolTable fn result with @@ -245,7 +259,7 @@ and execFn -let rec eval +and eval (state : ExecutionState) (instructions : Instructions) (resultReg : Register) From 1b3c04510aeba91fc28dfe470a5b8e469bbde1a8 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 1 Aug 2024 16:22:23 -0400 Subject: [PATCH 06/60] handle EString in new interpreter --- backend/src/LibExecution/Execution.fs | 5 +- backend/src/LibExecution/Interpreter.fs | 14 +++- backend/src/LibExecution/ProgramTypes.fs | 12 ++-- .../ProgramTypesToRuntimeTypes.fs | 54 ++++++++++----- backend/src/LibExecution/RuntimeTypes.fs | 10 +-- backend/tests/Tests/Interpreter.Tests.fs | 50 ++++++++------ backend/tests/Tests/PT2RT.Tests.fs | 68 ++++++++++++++++--- 7 files changed, 151 insertions(+), 62 deletions(-) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 81efb70d55..5467857b74 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -44,8 +44,7 @@ let createState let executeExpr (state : RT.ExecutionState) (inputVars : RT.Symtable) - (instructions : RT.Instructions) - (resultReg : RT.Register) + (instructionsWithContext : RT.InstructionsWithContext) : Task = task { try @@ -53,7 +52,7 @@ let executeExpr let state = //{ state with symbolTable = Interpreter.withGlobals state inputVars } { state with symbolTable = inputVars } - let! result = Interpreter.eval state instructions resultReg + let! result = Interpreter.eval state instructionsWithContext return Ok result with RT.RuntimeErrorException(source, rte) -> return Error(source, rte) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 3f2018173e..dbc48e4824 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -86,6 +86,13 @@ let rec execute return! execute state vmState instructions resultReg (counter + 1) | _ -> return DString "TODO can't operate list-add to a non-list" + | AppendString(targetReg, sourceReg) -> + match vmState.registers[targetReg], vmState.registers[sourceReg] with + | DString target, DString source -> + vmState.registers[targetReg] <- DString(target + source) + return! execute state vmState instructions resultReg (counter + 1) + | _, _ -> return DString "Error: Invalid string-append attempt" + | Fail _rte -> return DUnit // TODO } @@ -261,11 +268,12 @@ and execFn and eval (state : ExecutionState) - (instructions : Instructions) - (resultReg : Register) + (instructionsWithContext : InstructionsWithContext) : Ply = + let registersNeeded, instructions, resultReg = instructionsWithContext + let vmState = - { registers = Array.zeroCreate 256 // Or some other appropriate size + { registers = Array.zeroCreate registersNeeded variables = Map.empty callStack = [] } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index a2070328ed..846b878e75 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -201,7 +201,7 @@ type TypeReference = | TFloat | TChar -//| TString + | TString | TUuid | TDateTime @@ -250,7 +250,7 @@ type Expr = /// A character is an Extended Grapheme Cluster (hence why we use a string). This /// is equivalent to one screen-visible "character" in Unicode. | EChar of id * string - //| EString of id * List + | EString of id * List // // -- Flow control -- @@ -350,9 +350,9 @@ type Expr = //and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } -// and StringSegment = -// | StringText of string -// | StringInterpolation of Expr +and StringSegment = + | StringText of string + | StringInterpolation of Expr // and PipeExpr = // | EPipeVariable of id * string * List // value is an fn taking one or more arguments @@ -386,7 +386,7 @@ module Expr = | EInt128(id, _) | EUInt128(id, _) | EChar(id, _) - //| EString(id, _) + | EString(id, _) | EFloat(id, _, _, _) // | EConstant(id, _) | ELet(id, _, _, _) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index ac1ca71a07..b62d04cb30 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -93,12 +93,12 @@ module TypeReference = | PT.TFloat -> RT.TFloat | PT.TChar -> RT.TChar -//| PT.TString -> RT.TString + | PT.TString -> RT.TString | PT.TList inner -> RT.TList(toRT inner) -// | PT.TTuple(first, second, theRest) -> -// RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) -// | PT.TDict typ -> RT.TDict(toRT typ) + // | PT.TTuple(first, second, theRest) -> + // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) + // | PT.TDict typ -> RT.TDict(toRT typ) | PT.TDateTime -> RT.TDateTime | PT.TUuid -> RT.TUuid @@ -150,7 +150,7 @@ module LetPattern = // List.fold (fun (rc, instrs) pat -> compileLetPattern rc pat (valueReg + 2) instrs) (regCounter, instrs) rest | PT.LPVariable(_id, varName) -> - (regCounter + 1, instrs @ [ RT.SetVar(varName, valueReg) ]) + (regCounter, instrs @ [ RT.SetVar(varName, valueReg) ]) @@ -186,7 +186,34 @@ module LetPattern = module Expr = - let rec toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = + // CLEANUP clearly not the most efficient to do this, but probably fine for now + let rec compileString + (rc : int) + (segments : List) + : (int * RT.Instructions * RT.Register) = + let stringReg = rc + let init = (rc + 1, [ RT.LoadVal(stringReg, RT.DString "") ], stringReg) + + segments + |> List.fold + (fun (rc, instrs, _) segment -> + match segment with + | PT.StringText text -> + let textReg = rc + let newRc = rc + 1 + (newRc, + instrs + @ [ RT.LoadVal(textReg, RT.DString text) + RT.AppendString(stringReg, textReg) ], + stringReg) + | PT.StringInterpolation expr -> + let (newRc, exprInstrs, exprReg) = toRT rc expr + (newRc, + instrs @ exprInstrs @ [ RT.AppendString(stringReg, exprReg) ], + stringReg)) + init + + and toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = match e with | PT.EUnit _id -> (rc + 1, [ RT.LoadVal(rc, RT.DUnit) ], rc) @@ -210,6 +237,7 @@ module Expr = | PT.EChar(_id, c) -> (rc + 1, [ RT.LoadVal(rc, RT.DChar c) ], rc) + | PT.EString(_id, segments) -> compileString rc segments | PT.EList(_id, items) -> let listReg = rc @@ -234,18 +262,9 @@ module Expr = // let x = 1 | PT.ELet(_id, pat, expr, body) -> - // I should debug and breakpoint here to watch stuff. - - // eval the expr before we attempt to deconstruct with the LP let (regCounter, exprInstrs, exprReg) = toRT rc expr - - // deconstruct the expr per the pat - // TODO: do we need a resultReg thing here? hmm. - let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg [] // why is this an empty list? - - // finally, get the instructions for the body + let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg [] let (regCounter, bodyInstrs, bodyExprReg) = toRT regCounter body - (regCounter, exprInstrs @ patInstrs @ bodyInstrs, bodyExprReg) @@ -254,6 +273,9 @@ module Expr = (rc + 1, [ RT.GetVar(reg, varName) ], reg) + + + | PT.EFnName(_, Ok name) -> let reg = rc (rc + 1, [ RT.LoadVal(reg, RT.DFnVal(RT.NamedFn(FQFnName.toRT name))) ], reg) diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index e2c693dedd..48b0813e8e 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -481,8 +481,7 @@ and TypeReference = | TChar | TString | TUuid - | TDateTime - -> true + | TDateTime -> true | TList t -> isConcrete t // | TTuple(t1, t2, ts) -> @@ -530,6 +529,8 @@ and Instruction = /// (always an empty list of unknown type, to ensure type safety) | AddItemToList of listRegister : Register * itemToAdd : Register + | AppendString of targetReg : Register * sourceReg : Register + /// Return whatever's in the noted register /// (usually relevant only for branching logic like `if`, `match`) | Return of from : Register @@ -547,9 +548,6 @@ and InstructionsWithContext = // // superfluous information removed. // and Expr = -// // | EFloat of id * double - -// // | EChar of id * string // | EString of id * List // // // flow control @@ -559,8 +557,6 @@ and InstructionsWithContext = // // | EOr of id * lhs : Expr * rhs : Expr // // // declaring and referencing vars -// // | ELet of id * LetPattern * Expr * Expr -// // | EVariable of id * string // // | EFieldAccess of id * Expr * string // // calling fns and other things diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 7bc0c318e4..a3bde1f888 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -13,46 +13,58 @@ module E = Tests.ProgramTypesToRuntimeTypes.Expressions let eval pt = uply { - let _registersNeeded, instructions, resultReg = PT2RT.Expr.toRT 0 pt + let instructionsWithContext = PT2RT.Expr.toRT 0 pt let! executionState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false - return! LibExecution.Interpreter.eval executionState instructions resultReg + return! LibExecution.Interpreter.eval executionState instructionsWithContext } let onePlusTwo = testTask "1+2" { let! actual = eval E.onePlusTwo |> Ply.toTask - return Expect.equal actual (RT.DInt64 3L) "" + let expected = RT.DInt64 3L + return Expect.equal actual expected "" } let boolList = testTask "[true; false; true]" { let! actual = eval E.boolList |> Ply.toTask - - return - Expect.equal - actual - (RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ])) - "" + let expected = + RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ]) + return Expect.equal actual expected "" } let boolListList = testTask "[[true; false]; [false; true]]" { let! actual = eval E.boolListList |> Ply.toTask + let expected = + RT.DList( + VT.unknown, + [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] + ) + return Expect.equal actual expected "" + } + +let simpleString = + testTask "[\"hello\"]" { + let! actual = eval E.simpleString |> Ply.toTask + let expected = RT.DString "hello" + return Expect.equal actual expected "" + } - return - Expect.equal - actual - (RT.DList( - VT.unknown, - [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) - RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] - )) - "" +let stringWithInterpolation = + testTask "[let x = \"world\" in $\"hello {x}\"]" { + let! actual = eval E.stringWithInterpolation |> Ply.toTask + let expected = RT.DString "hello, world" + return Expect.equal actual expected "" } -let tests = testList "Interpreter" [ onePlusTwo; boolList ] +let tests = + testList + "Interpreter" + [ onePlusTwo; boolList; simpleString; stringWithInterpolation ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index c2d09fb7b9..0d0a3931f1 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -47,6 +47,19 @@ module Expressions = PT.EList(gid (), [ PT.EBool(gid (), false); PT.EBool(gid (), true) ]) ] ) + let simpleString : PT.Expr = PT.EString(gid (), [ PT.StringText("hello") ]) + + let stringWithInterpolation : PT.Expr = + PT.ELet( + gid (), + PT.LPVariable(gid (), "x"), + PT.EString(gid (), [ PT.StringText ", world" ]), + PT.EString( + gid (), + [ PT.StringText "hello"; PT.StringInterpolation(PT.EVariable(gid (), "x")) ] + ) + ) + module E = Expressions @@ -79,18 +92,15 @@ let onePlusTwo = } let defineAndUseVar = - testTask "let x = true in x" { + testTask "let x = true\n x" { let actual = PT2RT.Expr.toRT 0 E.defineAndUseVar - // TODO: re-evaluate if the 3 and 2 here cound be 2 and 1 - // PT2RT uses a register to pass the pass the 'result' of the LP deconstruction - //, and maybe we could reduce that? let expected = - (3, + (2, [ RT.LoadVal(0, RT.DBool true) RT.SetVar("x", 0) // where the 'true' is stored - RT.GetVar(2, "x") ], - 2) + RT.GetVar(1, "x") ], + 1) return Expect.equal actual expected "" } @@ -146,5 +156,47 @@ let boolListList = return Expect.equal actual expected "" } +let simpleString = + testTask "[\"hello\"]" { + let actual = PT2RT.Expr.toRT 0 E.simpleString + + let expected = + (2, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString "hello") + RT.AppendString(0, 1) ], + 0) + + return Expect.equal actual expected "" + } + +let stringWithInterpolation = + testTask "[let x = \"world\"\n$\"hello {x}\"]" { + let actual = PT2RT.Expr.toRT 0 E.stringWithInterpolation + + let expected = + (5, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString ", world") + RT.AppendString(0, 1) + RT.SetVar("x", 0) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "hello") + RT.AppendString(2, 3) + RT.GetVar(4, "x") + RT.AppendString(2, 4) ], + 2) + + return Expect.equal actual expected "" + } + let tests = - testList "PT2RT" [ one; onePlusTwo; defineAndUseVar; boolList; boolListList ] + testList + "PT2RT" + [ one + onePlusTwo + defineAndUseVar + boolList + boolListList + simpleString + stringWithInterpolation ] From af8a95bffff771399888c7add4f0695c000303a6 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 2 Aug 2024 10:25:32 -0400 Subject: [PATCH 07/60] handle EDict --- backend/src/LibExecution/DvalReprDeveloper.fs | 27 +++--- backend/src/LibExecution/Interpreter.fs | 9 ++ backend/src/LibExecution/ProgramTypes.fs | 4 +- .../ProgramTypesToRuntimeTypes.fs | 15 +++ backend/src/LibExecution/RuntimeTypes.fs | 95 +++++++++--------- backend/src/LibExecution/TypeChecker.fs | 25 ++--- backend/tests/TestUtils/PTShortcuts.fs | 97 +++++++++++++++++++ backend/tests/TestUtils/TestUtils.fs | 43 ++++---- backend/tests/Tests/Interpreter.Tests.fs | 36 ++++++- backend/tests/Tests/PT2RT.Tests.fs | 74 +++++++++++++- 10 files changed, 331 insertions(+), 94 deletions(-) create mode 100644 backend/tests/TestUtils/PTShortcuts.fs diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index 03cd6de507..4b62b2c73b 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -29,10 +29,10 @@ let rec typeName (t : TypeReference) : string = | TUuid -> "Uuid" | TList nested -> $"List<{typeName nested}>" + | TDict nested -> $"Dict<{typeName nested}>" // | TTuple(n1, n2, rest) -> // let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " // $"({nested})" - // | TDict nested -> $"Dict<{typeName nested}>" | TFn _ -> "Function" @@ -78,8 +78,7 @@ let rec private knownTypeName (vt : KnownType) : string = | KTUuid -> "Uuid" | KTList typ -> $"List<{valueTypeName typ}>" - // | KTDict typ -> $"Dict<{valueTypeName typ}>" - // | KTDB typ -> $"Datastore<{valueTypeName typ}>" + | KTDict typ -> $"Dict<{valueTypeName typ}>" | KTFn(argTypes, retType) -> (NEList.toList argTypes) @ [ retType ] @@ -104,6 +103,8 @@ let rec private knownTypeName (vt : KnownType) : string = // FQTypeName.toString name + typeArgsPortion +// | KTDB typ -> $"Datastore<{valueTypeName typ}>" + and private valueTypeName (typ : ValueType) : string = match typ with | ValueType.Known typ -> knownTypeName typ @@ -182,17 +183,17 @@ let toRepr (dv : Dval) : string = // $"({inl}{long}{nl})" - // | DDict(_valueTypeTODO, o) -> - // if Map.isEmpty o then - // "{}" - // else - // let strs = - // o - // |> Map.toList - // |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) + | DDict(_valueTypeTODO, o) -> + if Map.isEmpty o then + "{}" + else + let strs = + o + |> Map.toList + |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) - // let elems = String.concat $",{inl}" strs - // "{" + $"{inl}{elems}{nl}" + "}" + let elems = String.concat $",{inl}" strs + "{" + $"{inl}{elems}{nl}" + "}" // | DRecord(_, typeName, _typeArgsTODO, fields) -> // let fields = diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index dbc48e4824..c1b32a790d 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -86,6 +86,15 @@ let rec execute return! execute state vmState instructions resultReg (counter + 1) | _ -> return DString "TODO can't operate list-add to a non-list" + | AddDictEntry(dictReg, key, valueReg) -> + match vmState.registers[dictReg] with + | DDict(vt, entries) -> + // TODO: type checking of key and value; adjust vt + let value = vmState.registers[valueReg] + vmState.registers[dictReg] <- DDict(vt, Map.add key value entries) + return! execute state vmState instructions resultReg (counter + 1) + | _ -> return DString "TODO can't operate dict-add to a non-dict" + | AppendString(targetReg, sourceReg) -> match vmState.registers[targetReg], vmState.registers[sourceReg] with | DString target, DString source -> diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 846b878e75..03a10b67cf 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -293,7 +293,7 @@ type Expr = // -- Basic structures -- | EList of id * List - // | EDict of id * List + | EDict of id * List // | ETuple of id * Expr * Expr * List @@ -398,7 +398,7 @@ module Expr = | EVariable(id, _) | EApply(id, _, _, _) | EList(id, _) - // | EDict(id, _) + | EDict(id, _) // | ETuple(id, _, _, _) // | EPipe(id, _, _) // | ERecord(id, _, _) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index b62d04cb30..c47a3c1dc1 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -254,6 +254,21 @@ module Expr = (regCounter, instrs, listReg) + | PT.EDict(_id, items) -> + let dictReg = rc + let init = (rc + 1, [ RT.LoadVal(dictReg, RT.DDict(VT.unknown, Map.empty)) ]) + + let (regCounter, instrs) = + items + |> List.fold + (fun (rc, instrs) (key, value) -> + let (newRc, valueInstrs, valueReg) = toRT rc value + (newRc, + instrs @ valueInstrs @ [ RT.AddDictEntry(dictReg, key, valueReg) ])) + init + + (regCounter, instrs, dictReg) + // | PT.ETuple(_id, first, second, theRest) -> // let tupleReg = rc // //TODO handle VT diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 48b0813e8e..b3ad00d72e 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -192,20 +192,20 @@ type KnownType = /// `[z1, z2]` is allowed now but might not be allowed later | KTFn of args : NEList * ret : ValueType -// /// At time of writing, all DBs are of a specific type, and DBs may only be -// /// referenced directly, but we expect to eventually allow references to DBs -// /// where the type may be unknown -// /// List.head ([]: List>) // KTDB (Unknown) -// | KTDB of ValueType + // /// At time of writing, all DBs are of a specific type, and DBs may only be + // /// referenced directly, but we expect to eventually allow references to DBs + // /// where the type may be unknown + // /// List.head ([]: List>) // KTDB (Unknown) + // | KTDB of ValueType -// /// let n = None // type args: [Unknown] -// /// let s = Some(5) // type args: [Known KTInt64] -// /// let o = Ok (5) // type args: [Known KTInt64, Unknown] -// /// let e = Error ("str") // type args: [Unknown, Known KTString] -// | KTCustomType of FQTypeName.FQTypeName * typeArgs : List + // /// let n = None // type args: [Unknown] + // /// let s = Some(5) // type args: [Known KTInt64] + // /// let o = Ok (5) // type args: [Known KTInt64, Unknown] + // /// let e = Error ("str") // type args: [Unknown, Known KTString] + // | KTCustomType of FQTypeName.FQTypeName * typeArgs : List -// /// let myDict = {} // KTDict Unknown -// | KTDict of ValueType + /// let myDict = {} // KTDict Unknown + | KTDict of ValueType /// Represents the actual type of a Dval /// @@ -244,7 +244,7 @@ module ValueType = let uuid = known KTUuid let list (inner : ValueType) : ValueType = known (KTList inner) - // let dict (inner : ValueType) : ValueType = known (KTDict inner) + let dict (inner : ValueType) : ValueType = known (KTDict inner) // let tuple // (first : ValueType) // (second : ValueType) @@ -282,7 +282,7 @@ module ValueType = | KTDateTime -> "DateTime" | KTList inner -> $"List<{toString inner}>" - // | KTDict inner -> $"Dict<{toString inner}>" + | KTDict inner -> $"Dict<{toString inner}>" // | KTTuple(first, second, theRest) -> // first :: second :: theRest // |> List.map toString @@ -331,7 +331,7 @@ module ValueType = | KTDateTime, KTDateTime -> KTDateTime |> Ok | KTList left, KTList right -> r left right |> Result.map KTList - // | KTDict left, KTDict right -> r left right |> Result.map KTDict + | KTDict left, KTDict right -> r left right |> Result.map KTDict // | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> // let firstMerged = r l1 r1 // let secondMerged = r l2 r2 @@ -455,7 +455,7 @@ and TypeReference = // | TCustomType of // NameResolution * // typeArgs : List - // | TDict of TypeReference // CLEANUP add key type + | TDict of TypeReference // CLEANUP add key type member this.isFn() : bool = match this with @@ -487,9 +487,9 @@ and TypeReference = // | TTuple(t1, t2, ts) -> // isConcrete t1 && isConcrete t2 && List.forall isConcrete ts | TFn(ts, t) -> NEList.forall isConcrete ts && isConcrete t - // | TDB t -> isConcrete t - // | TCustomType(_, ts) -> List.forall isConcrete ts - // | TDict t -> isConcrete t + // | TDB t -> isConcrete t + // | TCustomType(_, ts) -> List.forall isConcrete ts + | TDict t -> isConcrete t //| TVariable _-> false @@ -505,13 +505,8 @@ and Instruction = /// Push a ("constant") value into a register | LoadVal of loadTo : Register * Dval - /// Apply some args (and maybe type args) to something - /// (a named function, or lambda, etc) - | Apply of - putResultIn : Register * - thingToApply : Register * - typeArgs : List * - args : NEList + | AppendString of targetReg : Register * sourceReg : Register + /// Loads the value of a register into a variable | SetVar of varName : string * loadFrom : Register @@ -519,9 +514,11 @@ and Instruction = /// Stores the value of a variable to a register | GetVar of loadTo : Register * varName : string + // | Jump of jumpTo: Register // | JumpIfFalse of condition: Register * jumpTo: Register + /// Add an item to an existing list /// , and type-check to make sure it matches the ValueType of that list /// @@ -529,7 +526,22 @@ and Instruction = /// (always an empty list of unknown type, to ensure type safety) | AddItemToList of listRegister : Register * itemToAdd : Register - | AppendString of targetReg : Register * sourceReg : Register + /// Add an item to an existing dict + /// , and type-check to make sure it matches the ValueType of that dict + /// + /// Note: dicts are _created_ with `LoadVal` + /// (always an empty dict of unknown type, to ensure type safety) + | AddDictEntry of dictRegister : Register * key : string * entryToAdd : Register + + + /// Apply some args (and maybe type args) to something + /// (a named function, or lambda, etc) + | Apply of + putResultIn : Register * + thingToApply : Register * + typeArgs : List * + args : NEList + /// Return whatever's in the noted register /// (usually relevant only for branching logic like `if`, `match`) @@ -548,7 +560,6 @@ and InstructionsWithContext = // // superfluous information removed. // and Expr = -// | EString of id * List // // // flow control // // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option @@ -566,7 +577,6 @@ and InstructionsWithContext = // // // structures // // | ETuple of id * Expr * Expr * List -// // | EDict of id * List // // // working with custom types // // | EConstant of id * FQConstantName.FQConstantName @@ -582,9 +592,6 @@ and InstructionsWithContext = // // and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } -// and StringSegment = -// | StringText of string -// | StringInterpolation of Expr and DvalMap = Map @@ -637,11 +644,11 @@ and [] Dval = // Compound types | DList of ValueType * List // | DTuple of first : Dval * second : Dval * theRest : List - // | DDict of - // // This is the type of the _values_, not the keys. Once users can specify the - // // key type, we likely will need to add a `keyType: ValueType` field here. - // valueType : ValueType * - // entries : DvalMap + | DDict of + // This is the type of the _values_, not the keys. Once users can specify the + // key type, we likely will need to add a `keyType: ValueType` field here. + valueType : ValueType * + entries : DvalMap // // custom types // | DRecord of @@ -987,7 +994,7 @@ module Dval = // pairs |> List.all (fun (v, subtype) -> r subtype v) | DList(_vtTODO, l), TList t -> List.all (r t) l - // | DDict(_vtTODO, m), TDict t -> Map.all (r t) m + | DDict(_vtTODO, m), TDict t -> Map.all (r t) m // | DFnVal(Lambda l), TFn(parameters, _) -> // NEList.length parameters = NEList.length l.parameters @@ -1026,7 +1033,7 @@ module Dval = // | DDB _, _ | DList _, _ // | DTuple _, _ - // | DDict _, _ + | DDict _, _ // | DRecord _, _ | DFnVal _, _ //| DEnum _, _ @@ -1056,7 +1063,7 @@ module Dval = | DUuid _ -> ValueType.Known KTUuid | DList(t, _) -> ValueType.Known(KTList t) - // | DDict(t, _) -> ValueType.Known(KTDict t) + | DDict(t, _) -> ValueType.Known(KTDict t) // | DTuple(first, second, theRest) -> // ValueType.Known( // KTTuple(toValueType first, toValueType second, List.map toValueType theRest) @@ -1089,10 +1096,10 @@ module Dval = | DList(_, l) -> Some l | _ -> None - // let asDict (dv : Dval) : Option> = - // match dv with - // | DDict(_, d) -> Some d - // | _ -> None + let asDict (dv : Dval) : Option> = + match dv with + | DDict(_, d) -> Some d + | _ -> None // let asTuple2 (dv : Dval) : Option = // match dv with diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index 96fc7c1fce..ea5d02b4df 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -284,7 +284,6 @@ let rec unify | TDateTime, DDateTime _ -> return Ok() | TUuid, DUuid _ -> return Ok() - // | TDB _, DDB _ -> return Ok() // TODO: check DB type | TList expected, DList(actual, _dvs) -> match! valueTypeUnifies tst expected actual with | false -> @@ -296,17 +295,17 @@ let rec unify | true -> return! Ply() - // | TDict _expected, DDict(_actual, _entries) -> - // // VTTODO uncomment this - // // match! valueTypeUnifies tst expected actual with - // // | false -> - // // return - // // ValueNotExpectedType(value, expected, context) - // // |> Error.toRuntimeError - // // |> Error + | TDict _expected, DDict(_actual, _entries) -> + // VTTODO uncomment this + // match! valueTypeUnifies tst expected actual with + // | false -> + // return + // ValueNotExpectedType(value, expected, context) + // |> Error.toRuntimeError + // |> Error - // // | true -> return! Ply() - // return Ok() + // | true -> return! Ply() + return Ok() | TFn(_argTypes, _returnType), DFnVal _fnVal -> return Ok() // TYPESTODO check lambdas and fnVals // | TTuple(t1, t2, tRest), DTuple(v1, v2, vRest) -> @@ -421,6 +420,8 @@ let rec unify // return err // | _, _ -> return err + // | TDB _, DDB _ -> return Ok() // TODO: check DB type + // See https://github.com/darklang/dark/issues/4239#issuecomment-1175182695 // TODO: exhaustiveness check | TUnit, _ @@ -445,7 +446,7 @@ let rec unify | TString, _ | TList _, _ | TDateTime, _ - // | TDict _, _ + | TDict _, _ | TFn _, _ | TUuid, _ | TChar, _ diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs new file mode 100644 index 0000000000..50dddd992a --- /dev/null +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -0,0 +1,97 @@ +/// Collection of helpful "shortcut" functions to create Dark values quickly +module TestUtils.RTShortcuts + +open Prelude +open LibExecution.RuntimeTypes + +module PT = LibExecution.ProgramTypes +module PT2RT = LibExecution.ProgramTypesToRuntimeTypes + +// let eUnit () : Expr = EUnit(gid ()) + +// let eBool (b : bool) : Expr = EBool(gid (), b) + +// let eInt8 (i : int8) : Expr = EInt8(gid (), i) +// let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) +// let eInt16 (i : int16) : Expr = EInt16(gid (), i) +// let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) +// let eInt32 (i : int32) : Expr = EInt32(gid (), i) +// let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) +// let eInt64 (i : int64) : Expr = EInt64(gid (), i) +// let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) +// let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) +// let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) + +// let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = +// EFloat(gid (), makeFloat sign whole fraction) + +//let eChar (c : string) : Expr = EChar(gid (), c) +// let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) + + + + +// let eList (elems : Expr list) : Expr = EList(gid (), elems) + +// let eVar (name : string) : Expr = EVariable(gid (), name) + +// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = +// EFieldAccess(gid (), expr, fieldName) + +// let eLambda (pats : List) (body : Expr) : Expr = +// let pats = NEList.ofListUnsafe "eLambda" [] pats +// ELambda(gid (), pats, body) + +// let eEnum +// (typeName : FQTypeName.FQTypeName) +// (name : string) +// (args : Expr list) +// : Expr = +// EEnum(gid (), typeName, name, args) + + +// let eBuiltinFnName (name : string) (version : int) : Expr = +// PT.FQFnName.fqBuiltIn name version +// |> PT2RT.FQFnName.toRT +// |> fun x -> EFnName(gid (), x) + + +// let eFn' +// (function_ : string) +// (version : int) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eFn'" [] args +// EApply(gid (), (eBuiltinFnName function_ version), typeArgs, args) + +// let eFn +// (function_ : string) +// (version : int) +// (typeArgs : List) +// (args : List) +// : Expr = +// eFn' function_ version typeArgs args + + +// let eApply +// (target : Expr) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eApply" [] args +// EApply(gid (), target, typeArgs, args) + +// let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = +// ETuple(gid (), first, second, theRest) + + +// let customTypeRecord (fields : List) : TypeDeclaration.T = +// let fields = +// fields +// |> List.map (fun (name, typ) -> +// { name = name; typ = typ } : TypeDeclaration.RecordField) +// match fields with +// | [] -> Exception.raiseInternal "userRecord must have at least one field" [] +// | hd :: rest -> +// { typeParams = []; definition = TypeDeclaration.Record(NEList.ofList hd rest) } diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 13e5087165..c9e1ba49f3 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -386,8 +386,9 @@ module Expect = | DString str -> str.IsNormalized() | DList(_, items) -> List.all r items - // | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) - // | DDict(_, entries) -> entries |> Map.values |> List.all r + // | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) + | DDict(_, entries) -> entries |> Map.values |> List.all r + // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all r // | DEnum(_, _, _, _, fields) -> fields |> List.all r @@ -783,26 +784,26 @@ module Expect = // check ("Length" :: path) (List.length theRestL) (List.length theRestR) // List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR - // | DDict(lType, ls), DDict(rType, rs) -> - // check ("Length" :: path) (Map.count ls) (Map.count rs) + | DDict(lType, ls), DDict(rType, rs) -> + check ("Length" :: path) (Map.count ls) (Map.count rs) - // checkValueType ("Type" :: path) lType rType + checkValueType ("Type" :: path) lType rType - // // check keys from ls are in both, check matching values - // Map.iterWithIndex - // (fun key v1 -> - // match Map.find key rs with - // | Some v2 -> de (key :: path) v1 v2 - // | None -> check (key :: path) ls rs) - // ls + // check keys from ls are in both, check matching values + Map.iterWithIndex + (fun key v1 -> + match Map.find key rs with + | Some v2 -> de (key :: path) v1 v2 + | None -> check (key :: path) ls rs) + ls - // // check keys from rs are in both - // Map.iterWithIndex - // (fun key _ -> - // match Map.find key rs with - // | Some _ -> () // already checked - // | None -> check (key :: path) ls rs) - // rs + // check keys from rs are in both + Map.iterWithIndex + (fun key _ -> + match Map.find key rs with + | Some _ -> () // already checked + | None -> check (key :: path) ls rs) + rs // | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> @@ -878,7 +879,7 @@ module Expect = | DUuid _, _ | DList _, _ // | DTuple _, _ - // | DDict _, _ + | DDict _, _ // | DRecord _, _ // | DEnum _, _ | DFnVal _, _ @@ -926,7 +927,7 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = let f dv = state <- f dv :: state let rec visit dv : unit = match dv with - // | DDict(_, entries) -> Map.values entries |> List.map visit |> ignore> + | DDict(_, entries) -> Map.values entries |> List.map visit |> ignore> // | DRecord(_, _, _, fields) -> // Map.values fields |> List.map visit |> ignore> // | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index a3bde1f888..daf6b38ef2 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -63,8 +63,42 @@ let stringWithInterpolation = return Expect.equal actual expected "" } +let dictEmpty = + testTask "Dict {}" { + let! actual = eval E.dictEmpty |> Ply.toTask + let expected = RT.DDict(VT.unknown, Map.empty) + return Expect.equal actual expected "" + } +let dictSimple = + testTask "Dict { t: true}" { + let! actual = eval E.dictSimple |> Ply.toTask + let expected = RT.DDict(VT.unknown, Map [ "key", RT.DBool true ]) + return Expect.equal actual expected "" + } +let dictMultEntries = + testTask "Dict {t: true; f: false}" { + let! actual = eval E.dictMultEntries |> Ply.toTask + let expected = + RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ]) + return Expect.equal actual expected "" + } +let dictDupeKey = + testTask "Dict {t: true; f: false; t: false}" { + let! actual = eval E.dictDupeKey |> Ply.toTask + let expected = + RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ]) + return Expect.equal actual expected "" + } + let tests = testList "Interpreter" - [ onePlusTwo; boolList; simpleString; stringWithInterpolation ] + [ onePlusTwo + boolList + simpleString + stringWithInterpolation + dictEmpty + dictSimple + dictMultEntries + dictDupeKey ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 0d0a3931f1..5265f045ec 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -60,6 +60,18 @@ module Expressions = ) ) + let dictEmpty : PT.Expr = PT.EDict(gid (), []) + let dictSimple : PT.Expr = PT.EDict(gid (), [ "key", PT.EBool(gid (), true) ]) + let dictMultEntries : PT.Expr = + PT.EDict(gid (), [ "t", PT.EBool(gid (), true); "f", PT.EBool(gid (), false) ]) + let dictDupeKey : PT.Expr = + PT.EDict( + gid (), + [ "t", PT.EBool(gid (), true) + "f", PT.EBool(gid (), false) + "t", PT.EBool(gid (), false) ] + ) + module E = Expressions @@ -190,6 +202,62 @@ let stringWithInterpolation = return Expect.equal actual expected "" } + +let dictEmpty = + testTask "Dict {}" { + let actual = PT2RT.Expr.toRT 0 E.dictEmpty + + let expected = (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) + + return Expect.equal actual expected "" + } +let dictSimple = + testTask "Dict { t: true}" { + let actual = PT2RT.Expr.toRT 0 E.dictSimple + + let expected = + (2, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "key", 1) ], + 0) + + return Expect.equal actual expected "" + } +let dictMultEntries = + testTask "Dict {t: true; f: false}" { + let actual = PT2RT.Expr.toRT 0 E.dictMultEntries + + let expected = + (3, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) ], + 0) + + return Expect.equal actual expected "" + } +let dictDupeKey = + testTask "Dict {t: true; f: false; t: true}" { + let actual = PT2RT.Expr.toRT 0 E.dictDupeKey + + let expected = + (4, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) + RT.LoadVal(3, RT.DBool false) + RT.AddDictEntry(0, "t", 3) ], + 0) + + return Expect.equal actual expected "" + } + + let tests = testList "PT2RT" @@ -199,4 +267,8 @@ let tests = boolList boolListList simpleString - stringWithInterpolation ] + stringWithInterpolation + dictEmpty + dictSimple + dictMultEntries + dictDupeKey ] From 37f8f58e81556c70ea583f7794ae4cef2ce55771 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 5 Aug 2024 21:22:11 -0400 Subject: [PATCH 08/60] implement EIf in new interpreter --- backend/src/LibExecution/Interpreter.fs | 17 ++++ backend/src/LibExecution/ProgramTypes.fs | 12 +-- .../ProgramTypesToRuntimeTypes.fs | 54 +++++++++++- backend/src/LibExecution/RuntimeTypes.fs | 14 +++- backend/tests/TestUtils/PTShortcuts.fs | 57 ++++++------- backend/tests/TestUtils/TestUtils.fsproj | 1 + backend/tests/Tests/Interpreter.Tests.fs | 26 +++++- backend/tests/Tests/PT2RT.Tests.fs | 84 ++++++++++++++++++- 8 files changed, 224 insertions(+), 41 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index c1b32a790d..1a32ead39c 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -102,6 +102,23 @@ let rec execute return! execute state vmState instructions resultReg (counter + 1) | _, _ -> return DString "Error: Invalid string-append attempt" + + | JumpByIfFalse(jumpBy, condReg) -> + match vmState.registers[condReg] with + | DBool false -> + return! execute state vmState instructions resultReg (counter + jumpBy + 1) + | DBool true -> + return! execute state vmState instructions resultReg (counter + 1) + | _ -> return DString "Error: Jump condition must be a boolean" + + | JumpBy jumpBy -> + return! execute state vmState instructions resultReg (counter + jumpBy + 1) + + | CopyVal(copyTo, copyFrom) -> + vmState.registers[copyTo] <- vmState.registers[copyFrom] + return! execute state vmState instructions resultReg (counter + 1) + + | Fail _rte -> return DUnit // TODO } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 03a10b67cf..2583199699 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -207,8 +207,8 @@ type TypeReference = | TDateTime | TList of TypeReference -// | TTuple of TypeReference * TypeReference * List -// | TDict of TypeReference + // | TTuple of TypeReference * TypeReference * List + | TDict of TypeReference //| TFn of arguments : NEList * ret : TypeReference @@ -253,9 +253,9 @@ type Expr = | EString of id * List - // // -- Flow control -- - // /// `if cond then thenExpr else elseExpr` - // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option + // -- Flow control -- + /// `if cond then thenExpr else elseExpr` + | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List @@ -390,7 +390,7 @@ module Expr = | EFloat(id, _, _, _) // | EConstant(id, _) | ELet(id, _, _, _) - // | EIf(id, _, _, _) + | EIf(id, _, _, _) //| EInfix(id, _, _, _) // | ELambda(id, _, _) | EFnName(id, _) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index c47a3c1dc1..ed76d05842 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -98,7 +98,7 @@ module TypeReference = | PT.TList inner -> RT.TList(toRT inner) // | PT.TTuple(first, second, theRest) -> // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) - // | PT.TDict typ -> RT.TDict(toRT typ) + | PT.TDict typ -> RT.TDict(toRT typ) | PT.TDateTime -> RT.TDateTime | PT.TUuid -> RT.TUuid @@ -288,7 +288,57 @@ module Expr = (rc + 1, [ RT.GetVar(reg, varName) ], reg) - + | PT.EIf(_id, cond, thenExpr, elseExpr) -> + // We need a consistent result register, + // so we'll create this, and copy to it at the end of each branch + let resultReg, rc = rc, rc + 1 + + let (rcAfterCond, condInstrs, condReg) = toRT rc cond + let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, condReg) ] + let rcAfterCondJump = rcAfterCond // + 1 // to compensate for the jump instruction + + let (rcAfterThen, thenInstrs, thenResultReg) = toRT rcAfterCondJump thenExpr + let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenResultReg) ] + + match elseExpr with + | None -> + let instrs = + [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit + @ condInstrs + @ jumpIfCondFalse ( + // goto the first instruction past the `if` + // (the 1 is for the copy instruction) + List.length thenInstrs + 1 + ) + @ thenInstrs + @ copyThenToResultInstr + + (rcAfterThen, instrs, resultReg) + + | Some elseExpr -> + let (rcAfterElse, elseInstrs, elseResultReg) = toRT rcAfterThen elseExpr + let copyToResultInstr = [ RT.CopyVal(resultReg, elseResultReg) ] + + let instrs = + // cond -- if cond `false`, jump to start of 'else' block + condInstrs + @ jumpIfCondFalse ( + // goto the first instruction past the `if` + // (first 1 is for the copy instruction) + // (second 1 is for the jump instruction) + List.length thenInstrs + 1 + 1 + ) + + // then + @ thenInstrs + @ copyThenToResultInstr + @ [ RT.JumpBy(List.length elseInstrs + 1) ] + + // else + @ elseInstrs + @ copyToResultInstr + + (rcAfterElse, instrs, resultReg) | PT.EFnName(_, Ok name) -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index b3ad00d72e..4f6d339284 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -427,6 +427,10 @@ module ValueType = // ------------ // Instructions ("bytecode") // ------------ + +[] +type register + type NameResolution<'a> = Result<'a, RuntimeError> and TypeReference = @@ -495,7 +499,7 @@ and TypeReference = isConcrete this -and Register = int // TODO: unit of measure +and Register = int // // TODO: unit of measure // TODO: consider if each of these should include the Expr ID that they came from // @@ -533,6 +537,14 @@ and Instruction = /// (always an empty dict of unknown type, to ensure type safety) | AddDictEntry of dictRegister : Register * key : string * entryToAdd : Register + | CopyVal of copyTo : Register * copyFrom : Register + + /// Go n instructions forward, if the value in the register is false + | JumpByIfFalse of instrsToJump : int * conditionReg : Register + + /// Go n instructions forward, unconditionally + | JumpBy of instrsToJump : int + /// Apply some args (and maybe type args) to something /// (a named function, or lambda, etc) diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 50dddd992a..8c3c03caab 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -1,39 +1,36 @@ /// Collection of helpful "shortcut" functions to create Dark values quickly -module TestUtils.RTShortcuts +module TestUtils.PTShortcuts open Prelude -open LibExecution.RuntimeTypes +open LibExecution.ProgramTypes -module PT = LibExecution.ProgramTypes -module PT2RT = LibExecution.ProgramTypesToRuntimeTypes +let eUnit () : Expr = EUnit(gid ()) -// let eUnit () : Expr = EUnit(gid ()) +let eBool (b : bool) : Expr = EBool(gid (), b) -// let eBool (b : bool) : Expr = EBool(gid (), b) +let eInt8 (i : int8) : Expr = EInt8(gid (), i) +let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) +let eInt16 (i : int16) : Expr = EInt16(gid (), i) +let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) +let eInt32 (i : int32) : Expr = EInt32(gid (), i) +let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) +let eInt64 (i : int64) : Expr = EInt64(gid (), i) +let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) +let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) +let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) -// let eInt8 (i : int8) : Expr = EInt8(gid (), i) -// let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) -// let eInt16 (i : int16) : Expr = EInt16(gid (), i) -// let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) -// let eInt32 (i : int32) : Expr = EInt32(gid (), i) -// let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) -// let eInt64 (i : int64) : Expr = EInt64(gid (), i) -// let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) -// let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) -// let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) +let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = + EFloat(gid (), sign, whole, fraction) -// let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = -// EFloat(gid (), makeFloat sign whole fraction) +let eChar (c : string) : Expr = EChar(gid (), c) +let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) -//let eChar (c : string) : Expr = EChar(gid (), c) -// let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) +let eList (elems : Expr list) : Expr = EList(gid (), elems) -// let eList (elems : Expr list) : Expr = EList(gid (), elems) - -// let eVar (name : string) : Expr = EVariable(gid (), name) +let eVar (name : string) : Expr = EVariable(gid (), name) // let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // EFieldAccess(gid (), expr, fieldName) @@ -74,13 +71,13 @@ module PT2RT = LibExecution.ProgramTypesToRuntimeTypes // eFn' function_ version typeArgs args -// let eApply -// (target : Expr) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eApply" [] args -// EApply(gid (), target, typeArgs, args) +let eApply + (target : Expr) + (typeArgs : List) + (args : List) + : Expr = + let args = NEList.ofListUnsafe "eApply" [] args + EApply(gid (), target, typeArgs, args) // let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = // ETuple(gid (), first, second, theRest) diff --git a/backend/tests/TestUtils/TestUtils.fsproj b/backend/tests/TestUtils/TestUtils.fsproj index eec3a2c940..16a5ca730f 100644 --- a/backend/tests/TestUtils/TestUtils.fsproj +++ b/backend/tests/TestUtils/TestUtils.fsproj @@ -14,6 +14,7 @@ + diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index daf6b38ef2..754f039ccc 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -91,6 +91,27 @@ let dictDupeKey = } +let ifGotoThenBranch = + testTask "if true then 1 else 2" { + let! actual = eval E.ifGotoThenBranch |> Ply.toTask + let expected = RT.DInt64 1L + return Expect.equal actual expected "" + } + +let ifGotoElseBranch = + testTask "if false then 1 else 2" { + let! actual = eval E.ifGotoElseBranch |> Ply.toTask + let expected = RT.DInt64 2L + return Expect.equal actual expected "" + } +let ifElseMissing = + testTask "if false then 1" { + let! actual = eval E.ifElseMissing |> Ply.toTask + let expected = RT.DUnit + return Expect.equal actual expected "" + } + + let tests = testList "Interpreter" @@ -101,4 +122,7 @@ let tests = dictEmpty dictSimple dictMultEntries - dictDupeKey ] + dictDupeKey + ifGotoThenBranch + ifGotoElseBranch + ifElseMissing ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 5265f045ec..da01618cd3 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -72,6 +72,23 @@ module Expressions = "t", PT.EBool(gid (), false) ] ) + let ifGotoThenBranch : PT.Expr = + PT.EIf( + gid (), + PT.EBool(gid (), true), + PT.EInt64(gid (), 1), + Some(PT.EInt64(gid (), 2)) + ) + let ifGotoElseBranch : PT.Expr = + PT.EIf( + gid (), + PT.EBool(gid (), false), + PT.EInt64(gid (), 1), + Some(PT.EInt64(gid (), 2)) + ) + let ifElseMissing : PT.Expr = + PT.EIf(gid (), PT.EBool(gid (), false), PT.EInt64(gid (), 1), None) + module E = Expressions @@ -257,6 +274,68 @@ let dictDupeKey = return Expect.equal actual expected "" } +let ifGotoThenBranch = + testTask "if true then 1 else 2" { + let actual = PT2RT.Expr.toRT 0 E.ifGotoThenBranch + + let expected = + (4, + [ // cond + RT.LoadVal(1, RT.DBool true) + RT.JumpByIfFalse(3, 1) + + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 + + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) + + return Expect.equal actual expected "" + } + +let ifGotoElseBranch = + testTask "if false then 1 else 2" { + let actual = PT2RT.Expr.toRT 0 E.ifGotoElseBranch + + let expected = + (4, + [ // cond + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(3, 1) + + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 + + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) + + return Expect.equal actual expected "" + } + +let ifElseMissing = + testTask "if false then 1" { + let actual = PT2RT.Expr.toRT 0 E.ifElseMissing + + let expected = + (3, + [ RT.LoadVal(0, RT.DUnit) + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(2, 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) ], + 0) + + return Expect.equal actual expected "" + } + let tests = testList @@ -271,4 +350,7 @@ let tests = dictEmpty dictSimple dictMultEntries - dictDupeKey ] + dictDupeKey + ifGotoThenBranch + ifGotoElseBranch + ifElseMissing ] From aae717aede28fbe0fc3a69284a270c880976dd4a Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 5 Aug 2024 21:46:44 -0400 Subject: [PATCH 09/60] tidy PT2RT --- backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index ed76d05842..9dda6424c5 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -295,9 +295,8 @@ module Expr = let (rcAfterCond, condInstrs, condReg) = toRT rc cond let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, condReg) ] - let rcAfterCondJump = rcAfterCond // + 1 // to compensate for the jump instruction - let (rcAfterThen, thenInstrs, thenResultReg) = toRT rcAfterCondJump thenExpr + let (rcAfterThen, thenInstrs, thenResultReg) = toRT rcAfterCond thenExpr let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenResultReg) ] match elseExpr with From 30ce4303dad2df28399653fc21ed7d454de2464d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 6 Aug 2024 09:47:16 -0400 Subject: [PATCH 10/60] support tuples in new interpreter --- backend/src/LibExecution/DvalReprDeveloper.fs | 41 ++-- backend/src/LibExecution/Interpreter.fs | 8 + backend/src/LibExecution/ProgramTypes.fs | 6 +- .../ProgramTypesToRuntimeTypes.fs | 81 +++----- backend/src/LibExecution/RuntimeTypes.fs | 192 +++++++++--------- backend/src/LibExecution/TypeChecker.fs | 96 +++++---- backend/tests/TestUtils/TestUtils.fs | 23 ++- backend/tests/Tests/Interpreter.Tests.fs | 38 +++- backend/tests/Tests/PT2RT.Tests.fs | 83 +++++++- 9 files changed, 341 insertions(+), 227 deletions(-) diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index 4b62b2c73b..bf45127442 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -30,9 +30,9 @@ let rec typeName (t : TypeReference) : string = | TList nested -> $"List<{typeName nested}>" | TDict nested -> $"Dict<{typeName nested}>" - // | TTuple(n1, n2, rest) -> - // let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " - // $"({nested})" + | TTuple(n1, n2, rest) -> + let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " + $"({nested})" | TFn _ -> "Function" @@ -79,17 +79,11 @@ let rec private knownTypeName (vt : KnownType) : string = | KTList typ -> $"List<{valueTypeName typ}>" | KTDict typ -> $"Dict<{valueTypeName typ}>" - - | KTFn(argTypes, retType) -> - (NEList.toList argTypes) @ [ retType ] + | KTTuple(t1, t2, trest) -> + t1 :: t2 :: trest |> List.map valueTypeName - |> String.concat " -> " - -// | KTTuple(t1, t2, trest) -> -// t1 :: t2 :: trest -// |> List.map valueTypeName -// |> String.concat ", " -// |> fun s -> $"({s})" + |> String.concat ", " + |> fun s -> $"({s})" // | KTCustomType(name, typeArgs) -> // let typeArgsPortion = @@ -103,6 +97,11 @@ let rec private knownTypeName (vt : KnownType) : string = // FQTypeName.toString name + typeArgsPortion +// | KTFn(argTypes, retType) -> +// (NEList.toList argTypes) @ [ retType ] +// |> List.map valueTypeName +// |> String.concat " -> " + // | KTDB typ -> $"Datastore<{valueTypeName typ}>" and private valueTypeName (typ : ValueType) : string = @@ -172,15 +171,15 @@ let toRepr (dv : Dval) : string = let elems = String.concat ", " (List.map (toRepr_ indent) l) $"[{inl}{elems}{nl}]" - // | DTuple(first, second, theRest) -> - // let l = [ first; second ] @ theRest - // let short = String.concat ", " (List.map (toRepr_ indent) l) + | DTuple(first, second, theRest) -> + let l = [ first; second ] @ theRest + let short = String.concat ", " (List.map (toRepr_ indent) l) - // if String.length short <= 80 then - // $"({short})" - // else - // let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l) - // $"({inl}{long}{nl})" + if String.length short <= 80 then + $"({short})" + else + let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l) + $"({inl}{long}{nl})" | DDict(_valueTypeTODO, o) -> diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 1a32ead39c..f8c7e7e86c 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -86,6 +86,13 @@ let rec execute return! execute state vmState instructions resultReg (counter + 1) | _ -> return DString "TODO can't operate list-add to a non-list" + | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> + let first = vmState.registers[firstReg] + let second = vmState.registers[secondReg] + let theRest = theRestRegs |> List.map (fun r -> vmState.registers[r]) + vmState.registers[tupleReg] <- DTuple(first, second, theRest) + return! execute state vmState instructions resultReg (counter + 1) + | AddDictEntry(dictReg, key, valueReg) -> match vmState.registers[dictReg] with | DDict(vt, entries) -> @@ -95,6 +102,7 @@ let rec execute return! execute state vmState instructions resultReg (counter + 1) | _ -> return DString "TODO can't operate dict-add to a non-dict" + | AppendString(targetReg, sourceReg) -> match vmState.registers[targetReg], vmState.registers[sourceReg] with | DString target, DString source -> diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 2583199699..79314949f5 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -207,7 +207,7 @@ type TypeReference = | TDateTime | TList of TypeReference - // | TTuple of TypeReference * TypeReference * List + | TTuple of TypeReference * TypeReference * List | TDict of TypeReference //| TFn of arguments : NEList * ret : TypeReference @@ -294,7 +294,7 @@ type Expr = // -- Basic structures -- | EList of id * List | EDict of id * List - // | ETuple of id * Expr * Expr * List + | ETuple of id * Expr * Expr * List // -- "Applying" args to things, such as fns and lambdas -- @@ -399,7 +399,7 @@ module Expr = | EApply(id, _, _, _) | EList(id, _) | EDict(id, _) - // | ETuple(id, _, _, _) + | ETuple(id, _, _, _) // | EPipe(id, _, _) // | ERecord(id, _, _) // | ERecordUpdate(id, _, _) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 9dda6424c5..483de562b2 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -14,7 +14,6 @@ module PT = ProgramTypes // let fromRT (p : RT.FQTypeName.Package) : PT.FQTypeName.Package = p - // let toRT (fqtn : PT.FQTypeName.FQTypeName) : RT.FQTypeName.FQTypeName = // match fqtn with // | PT.FQTypeName.Package p -> RT.FQTypeName.Package(Package.toRT p) @@ -37,7 +36,6 @@ module PT = ProgramTypes // let fromRT (c : RT.FQConstantName.Package) : PT.FQConstantName.Package = c - // let toRT // (name : PT.FQConstantName.FQConstantName) // : RT.FQConstantName.FQConstantName = @@ -96,8 +94,8 @@ module TypeReference = | PT.TString -> RT.TString | PT.TList inner -> RT.TList(toRT inner) - // | PT.TTuple(first, second, theRest) -> - // RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) + | PT.TTuple(first, second, theRest) -> + RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) | PT.TDict typ -> RT.TDict(toRT typ) | PT.TDateTime -> RT.TDateTime @@ -269,10 +267,30 @@ module Expr = (regCounter, instrs, dictReg) - // | PT.ETuple(_id, first, second, theRest) -> - // let tupleReg = rc - // //TODO handle VT - // let init = (rc + 1, [ RT.LoadVal(tupleReg, RT.DTuple(VT.unknown, VT.unknown, [])) ]) + | PT.ETuple(_id, first, second, theRest) -> + // save the 'first' register for the result + let tupleReg, rc = rc, rc + 1 + + let (rcAfterFirst, firstInstrs, firstReg) = toRT rc first + let (rcAfterSecond, secondInstrs, secondReg) = toRT rcAfterFirst second + let (rcAfterAll, _rcsAfterTheRest, theRestInstrs, theRestRegs) = + theRest + |> List.fold + (fun (rc, rcs, instrs, resultRegs) item -> + let (rcAfterItem, itemInstrs, itemResultReg) = toRT rc item + (rcAfterItem, + rcs @ [ rcAfterItem ], + instrs @ itemInstrs, + resultRegs @ [ itemResultReg ])) + (rcAfterSecond, [], [], []) + + let instrs = + firstInstrs + @ secondInstrs + @ theRestInstrs + @ [ RT.CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) ] + + (rcAfterAll, instrs, tupleReg) // let x = 1 @@ -385,36 +403,6 @@ module Expr = // let rec toRT (e : PT.Expr) : RT.Instructions = // match e with -// | PT.EUnit id -> -// //RT.EUnit id -// [ RT.LoadVar(id, RT.DUnit) ] - -// | PT.EBool(id, b) -> -// //RT.EBool(id, b) -// [ RT.LoadVar(id, RT.DBool b) ] - -// // | PT.EInt8(id, num) -> RT.EInt8(id, num) -// // | PT.EUInt8(id, num) -> RT.EUInt8(id, num) -// // | PT.EInt16(id, num) -> RT.EInt16(id, num) -// // | PT.EUInt16(id, num) -> RT.EUInt16(id, num) -// // | PT.EInt32(id, num) -> RT.EInt32(id, num) -// // | PT.EUInt32(id, num) -> RT.EUInt32(id, num) -// | PT.EInt64(id, num) -> -// //RT.EInt64(id, num) -// [ RT.LoadVar(id, RT.DInt64 num) ] -// // | PT.EUInt64(id, num) -> RT.EUInt64(id, num) -// // | PT.EInt128(id, num) -> RT.EInt128(id, num) -// // | PT.EUInt128(id, num) -> RT.EUInt128(id, num) - -// // | PT.EFloat(id, sign, whole, fraction) -> -// // let whole = if whole = "" then "0" else whole -// // let fraction = if fraction = "" then "0" else fraction -// // RT.EFloat(id, makeFloat sign whole fraction) - -// // | PT.EChar(id, char) -> RT.EChar(id, char) -// //| PT.EString(id, segments) -> RT.EString(id, List.map stringSegmentToRT segments) - - // // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) // // | PT.EConstant(id, Error err) -> // // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) @@ -458,17 +446,6 @@ module Expr = // // | PT.ELambda(id, pats, body) -> // // RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) -// // | PT.ELet(id, pattern, rhs, body) -> -// // RT.ELet(id, LetPattern.toRT pattern, toRT rhs, toRT body) - -// // | PT.EIf(id, cond, thenExpr, elseExpr) -> -// // RT.EIf(id, toRT cond, toRT thenExpr, elseExpr |> Option.map toRT) - -// // | PT.EList(id, exprs) -> RT.EList(id, List.map toRT exprs) - -// // | PT.ETuple(id, first, second, theRest) -> -// // RT.ETuple(id, toRT first, toRT second, List.map toRT theRest) - // // | PT.ERecord(id, Ok typeName, fields) -> // // match fields with // // | [] -> @@ -582,12 +559,6 @@ module Expr = // // RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) -// and stringSegmentToRT (segment : PT.StringSegment) : RT.StringSegment = -// match segment with -// | PT.StringText text -> RT.StringText text -// | PT.StringInterpolation expr -> RT.StringInterpolation(toRT expr) - - // module Const = // let rec toRT (c : PT.Const) : RT.Const = // match c with diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 4f6d339284..a56dd34a71 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -168,29 +168,29 @@ type KnownType = /// let intList = [1] // KTList (ValueType.Known KTInt64) | KTList of ValueType - // /// Intuitively, since Dvals generate KnownTypes, you would think that we can - // /// use KnownTypes in a KTTuple. - // /// - // /// However, we sometimes construct a KTTuple to repesent the type of a Tuple - // /// which doesn't exist. For example, in `List.zip [] []`, we create the result - // /// from the types of the two lists, which themselves might be (and likely are) - // /// `Unknown`. - // | KTTuple of ValueType * ValueType * List - - /// let f = (fun x -> x) // KTFn([Unknown], Unknown) - /// let intF = (fun (x: Int) -> x) // KTFn([Known KTInt64], Unknown) - /// - /// Note that we could theoretically know some return types by analyzing the - /// code or type signatures of functions. We don't do this yet as it's - /// complicated. When we do decide to do this, some incorrect programs may stop - /// functioning (see example). Our goal is for correctly typed functions to - /// stay working so this might be ok. + /// Intuitively, since Dvals generate KnownTypes, you would think that we can + /// use KnownTypes in a KTTuple. /// - /// For example: - /// let z1 = (fun x -> 5) - /// let z2 = (fun x -> "str") - /// `[z1, z2]` is allowed now but might not be allowed later - | KTFn of args : NEList * ret : ValueType + /// However, we sometimes construct a KTTuple to repesent the type of a Tuple + /// which doesn't exist. For example, in `List.zip [] []`, we create the result + /// from the types of the two lists, which themselves might be (and likely are) + /// `Unknown`. + | KTTuple of ValueType * ValueType * List + + // /// let f = (fun x -> x) // KTFn([Unknown], Unknown) + // /// let intF = (fun (x: Int) -> x) // KTFn([Known KTInt64], Unknown) + // /// + // /// Note that we could theoretically know some return types by analyzing the + // /// code or type signatures of functions. We don't do this yet as it's + // /// complicated. When we do decide to do this, some incorrect programs may stop + // /// functioning (see example). Our goal is for correctly typed functions to + // /// stay working so this might be ok. + // /// + // /// For example: + // /// let z1 = (fun x -> 5) + // /// let z2 = (fun x -> "str") + // /// `[z1, z2]` is allowed now but might not be allowed later + // | KTFn of args : NEList * ret : ValueType // /// At time of writing, all DBs are of a specific type, and DBs may only be // /// referenced directly, but we expect to eventually allow references to DBs @@ -245,12 +245,12 @@ module ValueType = let list (inner : ValueType) : ValueType = known (KTList inner) let dict (inner : ValueType) : ValueType = known (KTDict inner) - // let tuple - // (first : ValueType) - // (second : ValueType) - // (theRest : List) - // : ValueType = - // KTTuple(first, second, theRest) |> known + let tuple + (first : ValueType) + (second : ValueType) + (theRest : List) + : ValueType = + KTTuple(first, second, theRest) |> known // let customType // (typeName : FQTypeName.FQTypeName) @@ -283,25 +283,26 @@ module ValueType = | KTList inner -> $"List<{toString inner}>" | KTDict inner -> $"Dict<{toString inner}>" - // | KTTuple(first, second, theRest) -> - // first :: second :: theRest - // |> List.map toString - // |> String.concat " * " - // |> fun inner -> $"({inner})" - // | KTCustomType(typeName, typeArgs) -> - // let typeArgsPart = - // match typeArgs with - // | [] -> "" - // | _ -> - // typeArgs - // |> List.map toString - // |> String.concat ", " - // |> fun inner -> $"<{inner}>" - - // $"{FQTypeName.toString typeName}{typeArgsPart}" - - | KTFn(args, ret) -> - NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " + | KTTuple(first, second, theRest) -> + first :: second :: theRest + |> List.map toString + |> String.concat " * " + |> fun inner -> $"({inner})" + + // | KTCustomType(typeName, typeArgs) -> + // let typeArgsPart = + // match typeArgs with + // | [] -> "" + // | _ -> + // typeArgs + // |> List.map toString + // |> String.concat ", " + // |> fun inner -> $"<{inner}>" + + // $"{FQTypeName.toString typeName}{typeArgsPart}" + + // | KTFn(args, ret) -> + // NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " //| KTDB inner -> $"DB<{toString inner}>" @@ -332,14 +333,14 @@ module ValueType = | KTList left, KTList right -> r left right |> Result.map KTList | KTDict left, KTDict right -> r left right |> Result.map KTDict - // | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> - // let firstMerged = r l1 r1 - // let secondMerged = r l2 r2 - // let restMerged = List.map2 r ls rs |> Result.collect + | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> + let firstMerged = r l1 r1 + let secondMerged = r l2 r2 + let restMerged = List.map2 r ls rs |> Result.collect - // match firstMerged, secondMerged, restMerged with - // | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) - // | _ -> Error() + match firstMerged, secondMerged, restMerged with + | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) + | _ -> Error() // | KTCustomType(lName, lArgs), KTCustomType(rName, rArgs) -> // if lName <> rName then @@ -351,13 +352,13 @@ module ValueType = // |> Result.collect // |> Result.map (fun args -> KTCustomType(lName, args)) - | KTFn(lArgs, lRet), KTFn(rArgs, rRet) -> - let argsMerged = NEList.map2 r lArgs rArgs |> Result.collectNE - let retMerged = r lRet rRet + // | KTFn(lArgs, lRet), KTFn(rArgs, rRet) -> + // let argsMerged = NEList.map2 r lArgs rArgs |> Result.collectNE + // let retMerged = r lRet rRet - match argsMerged, retMerged with - | Ok args, Ok ret -> Ok(KTFn(args, ret)) - | _ -> Error() + // match argsMerged, retMerged with + // | Ok args, Ok ret -> Ok(KTFn(args, ret)) + // | _ -> Error() | _ -> Error() @@ -452,7 +453,7 @@ and TypeReference = | TUuid | TDateTime | TList of TypeReference - // | TTuple of TypeReference * TypeReference * List + | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference // | TDB of TypeReference // | TVariable of string @@ -488,8 +489,8 @@ and TypeReference = | TDateTime -> true | TList t -> isConcrete t - // | TTuple(t1, t2, ts) -> - // isConcrete t1 && isConcrete t2 && List.forall isConcrete ts + | TTuple(t1, t2, ts) -> + isConcrete t1 && isConcrete t2 && List.forall isConcrete ts | TFn(ts, t) -> NEList.forall isConcrete ts && isConcrete t // | TDB t -> isConcrete t // | TCustomType(_, ts) -> List.forall isConcrete ts @@ -528,8 +529,17 @@ and Instruction = /// /// Note: lists are _created_ with `LoadVal` /// (always an empty list of unknown type, to ensure type safety) + /// + /// TODO consider removing in favor of a bulk `CreateList` instruction. + /// Not sure what we're getting from this. | AddItemToList of listRegister : Register * itemToAdd : Register + | CreateTuple of + createTo : Register * + first : Register * + second : Register * + theRest : List + /// Add an item to an existing dict /// , and type-check to make sure it matches the ValueType of that dict /// @@ -574,7 +584,6 @@ and InstructionsWithContext = // // // flow control -// // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option // // | EMatch of id * Expr * NEList // // | EAnd of id * lhs : Expr * rhs : Expr // // | EOr of id * lhs : Expr * rhs : Expr @@ -583,13 +592,9 @@ and InstructionsWithContext = // // | EFieldAccess of id * Expr * string // // calling fns and other things -// | EFnName of id * FQFnName.FQFnName // | EApply of id * Expr * typeArgs : List * args : NEList // //| ELambda of id * pats : NEList * body : Expr -// // // structures -// // | ETuple of id * Expr * Expr * List - // // // working with custom types // // | EConstant of id * FQConstantName.FQConstantName // // | ERecord of id * FQTypeName.FQTypeName * NEList @@ -655,7 +660,7 @@ and [] Dval = // Compound types | DList of ValueType * List - // | DTuple of first : Dval * second : Dval * theRest : List + | DTuple of first : Dval * second : Dval * theRest : List | DDict of // This is the type of the _values_, not the keys. Once users can specify the // key type, we likely will need to add a `keyType: ValueType` field here. @@ -998,17 +1003,15 @@ module Dval = | DDateTime _, TDateTime | DUuid _, TUuid - // | DDB _, TDB _ -> true - // | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> - // let pairs = - // [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes - // pairs |> List.all (fun (v, subtype) -> r subtype v) | DList(_vtTODO, l), TList t -> List.all (r t) l + | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> + let pairs = + [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes + + pairs |> List.all (fun (v, subtype) -> r subtype v) | DDict(_vtTODO, m), TDict t -> Map.all (r t) m - // | DFnVal(Lambda l), TFn(parameters, _) -> - // NEList.length parameters = NEList.length l.parameters // | DRecord(typeName, _, _typeArgsTODO, _fields), // TCustomType(Ok typeName', _typeArgs) -> @@ -1024,6 +1027,11 @@ module Dval = // // against the typeArgs in the DEnum - their zipped values should merge OK // typeName = typeName' + // | DFnVal(Lambda l), TFn(parameters, _) -> + // NEList.length parameters = NEList.length l.parameters + + // | DDB _, TDB _ + // exhaustiveness checking | DUnit, _ | DBool _, _ @@ -1038,17 +1046,17 @@ module Dval = | DInt128 _, _ | DUInt128 _, _ | DFloat _, _ + | DChar _, _ | DString _, _ | DDateTime _, _ | DUuid _, _ - | DChar _, _ - // | DDB _, _ | DList _, _ - // | DTuple _, _ + | DTuple _, _ | DDict _, _ // | DRecord _, _ - | DFnVal _, _ //| DEnum _, _ + | DFnVal _, _ + // | DDB _, _ -> false @@ -1076,10 +1084,10 @@ module Dval = | DList(t, _) -> ValueType.Known(KTList t) | DDict(t, _) -> ValueType.Known(KTDict t) - // | DTuple(first, second, theRest) -> - // ValueType.Known( - // KTTuple(toValueType first, toValueType second, List.map toValueType theRest) - // ) + | DTuple(first, second, theRest) -> + ValueType.Known( + KTTuple(toValueType first, toValueType second, List.map toValueType theRest) + ) // | DRecord(typeName, _, typeArgs, _) -> // KTCustomType(typeName, typeArgs) |> ValueType.Known @@ -1113,15 +1121,15 @@ module Dval = | DDict(_, d) -> Some d | _ -> None - // let asTuple2 (dv : Dval) : Option = - // match dv with - // | DTuple(first, second, _) -> Some(first, second) - // | _ -> None + let asTuple2 (dv : Dval) : Option = + match dv with + | DTuple(first, second, _) -> Some(first, second) + | _ -> None - // let asTuple3 (dv : Dval) : Option = - // match dv with - // | DTuple(first, second, [ third ]) -> Some(first, second, third) - // | _ -> None + let asTuple3 (dv : Dval) : Option = + match dv with + | DTuple(first, second, [ third ]) -> Some(first, second, third) + | _ -> None let asString (dv : Dval) : Option = match dv with diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index ea5d02b4df..c969ac2a66 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -152,23 +152,23 @@ let raiseFnValResultNotExpectedType let rec valueTypeUnifies - (_tst : TypeSymbolTable) + (tst : TypeSymbolTable) (expected : TypeReference) (actual : ValueType) : Ply = - // let r = valueTypeUnifies tst - - // let rMult (expected : List) (actual : List) : Ply = - // if List.length expected <> List.length actual then - // Ply false - // else - // List.zip expected actual - // |> Ply.List.foldSequentially - // (fun acc (e, a) -> - // match acc with - // | false -> Ply acc - // | true -> r e a) - // true + let r = valueTypeUnifies tst + + let rMult (expected : List) (actual : List) : Ply = + if List.length expected <> List.length actual then + Ply false + else + List.zip expected actual + |> Ply.List.foldSequentially + (fun acc (e, a) -> + match acc with + | false -> Ply acc + | true -> r e a) + true uply { match expected, actual with @@ -177,31 +177,34 @@ let rec valueTypeUnifies | TUnit, ValueType.Known KTUnit -> return true | TBool, ValueType.Known KTBool -> return true - // | TInt8, ValueType.Known KTInt8 -> return true - // | TUInt8, ValueType.Known KTUInt8 -> return true - // | TInt16, ValueType.Known KTInt16 -> return true - // | TUInt16, ValueType.Known KTUInt16 -> return true - // | TInt32, ValueType.Known KTInt32 -> return true - // | TUInt32, ValueType.Known KTUInt32 -> return true + | TInt8, ValueType.Known KTInt8 -> return true + | TUInt8, ValueType.Known KTUInt8 -> return true + | TInt16, ValueType.Known KTInt16 -> return true + | TUInt16, ValueType.Known KTUInt16 -> return true + | TInt32, ValueType.Known KTInt32 -> return true + | TUInt32, ValueType.Known KTUInt32 -> return true | TInt64, ValueType.Known KTInt64 -> return true - // | TUInt64, ValueType.Known KTUInt64 -> return true - // | TInt128, ValueType.Known KTInt128 -> return true - // | TUInt128, ValueType.Known KTUInt128 -> return true - // | TFloat, ValueType.Known KTFloat -> return true - // | TChar, ValueType.Known KTChar -> return true + | TUInt64, ValueType.Known KTUInt64 -> return true + | TInt128, ValueType.Known KTInt128 -> return true + | TUInt128, ValueType.Known KTUInt128 -> return true + + | TFloat, ValueType.Known KTFloat -> return true + + | TChar, ValueType.Known KTChar -> return true | TString, ValueType.Known KTString -> return true + // | TUuid, ValueType.Known KTUuid -> return true // | TDateTime, ValueType.Known KTDateTime -> return true - // | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV + | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV - // | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV + | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV - // | TTuple(tFirst, tSecond, tRest), - // ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> - // let expected = tFirst :: tSecond :: tRest - // let actual = vFirst :: vSecond :: vRest - // return! rMult expected actual + | TTuple(tFirst, tSecond, tRest), + ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> + let expected = tFirst :: tSecond :: tRest + let actual = vFirst :: vSecond :: vRest + return! rMult expected actual // | TCustomType(Error err, _), _ -> // return @@ -219,13 +222,13 @@ let rec valueTypeUnifies // //return! rMult typeArgsT typeArgsV // return true - | TFn(_argTypes, _returnType), ValueType.Known(KTFn(_vArgs, _vRet)) -> - // TODO: follow up here when type args are properly passed around and handled + // | TFn(_argTypes, _returnType), ValueType.Known(KTFn(_vArgs, _vRet)) -> + // // TODO: follow up here when type args are properly passed around and handled - // let expected = returnType :: (NEList.toList argTypes) - // let actual = vRet :: (NEList.toList vArgs) - // return! rMult expected actual - return true + // // let expected = returnType :: (NEList.toList argTypes) + // // let actual = vRet :: (NEList.toList vArgs) + // // return! rMult expected actual + // return true //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV @@ -440,16 +443,21 @@ let rec unify | TFloat, _ - // | TTuple _, _ - // | TCustomType _, _ - // | TVariable _, _ + | TChar, _ | TString, _ - | TList _, _ + | TDateTime, _ + | TUuid, _ + + | TList _, _ | TDict _, _ + | TTuple _, _ + + // | TCustomType _, _ + + // | TVariable _, _ + | TFn _, _ - | TUuid, _ - | TChar, _ // | TDB _, _ -> return diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index c9e1ba49f3..bdd525beb1 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -386,7 +386,7 @@ module Expect = | DString str -> str.IsNormalized() | DList(_, items) -> List.all r items - // | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) + | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) | DDict(_, entries) -> entries |> Map.values |> List.all r // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all r @@ -764,6 +764,7 @@ module Expect = error path else if not (Accuracy.areClose Accuracy.veryHigh l r) then error path + | DDateTime l, DDateTime r -> // Two dates can be the same millisecond and not be equal if they don't // have the same number of ticks. For testing, we shall consider them @@ -776,13 +777,13 @@ module Expect = check ("Length" :: path) (List.length ls) (List.length rs) List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs - // | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> - // de path firstL firstR + | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> + de path firstL firstR - // de path secondL secondR + de path secondL secondR - // check ("Length" :: path) (List.length theRestL) (List.length theRestR) - // List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR + check ("Length" :: path) (List.length theRestL) (List.length theRestR) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR | DDict(lType, ls), DDict(rType, rs) -> check ("Length" :: path) (Map.count ls) (Map.count rs) @@ -878,7 +879,7 @@ module Expect = | DDateTime _, _ | DUuid _, _ | DList _, _ - // | DTuple _, _ + | DTuple _, _ | DDict _, _ // | DRecord _, _ // | DEnum _, _ @@ -927,13 +928,15 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = let f dv = state <- f dv :: state let rec visit dv : unit = match dv with + | DList(_, items) -> List.map visit items |> ignore> | DDict(_, entries) -> Map.values entries |> List.map visit |> ignore> + | DTuple(first, second, theRest) -> + List.map visit ([ first; second ] @ theRest) |> ignore> + // | DRecord(_, _, _, fields) -> // Map.values fields |> List.map visit |> ignore> + // | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> - | DList(_, items) -> List.map visit items |> ignore> - // | DTuple(first, second, theRest) -> - // List.map visit ([ first; second ] @ theRest) |> ignore> // Keep for exhaustiveness checking | DUnit diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 754f039ccc..ba145473aa 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -111,6 +111,39 @@ let ifElseMissing = return Expect.equal actual expected "" } +let tuple2 = + testTask "(false, true)" { + let! actual = eval E.tuple2 |> Ply.toTask + let expected = RT.DTuple(RT.DBool false, RT.DBool true, []) + return Expect.equal actual expected "" + } + +let tuple3 = + testTask "(false, true, false)" { + let! actual = eval E.tuple3 |> Ply.toTask + let expected = RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ]) + return Expect.equal actual expected "" + } + +let tupleNested = + testTask "((false, true), true, (true, false)))" { + let! actual = eval E.tupleNested |> Ply.toTask + let expected = + RT.DTuple( + RT.DTuple(RT.DBool false, RT.DBool true, []), + RT.DBool true, + [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] + ) + return Expect.equal actual expected "" + } + +// let TODO = +// testTask "TODO" { +// let! actual = eval E.TODO |> Ply.toTask +// let expected = RT.DUnit +// return Expect.equal actual expected "" +// } + let tests = testList @@ -125,4 +158,7 @@ let tests = dictDupeKey ifGotoThenBranch ifGotoElseBranch - ifElseMissing ] + ifElseMissing + tuple2 + tuple3 + tupleNested ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index da01618cd3..6982fda49a 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -89,6 +89,28 @@ module Expressions = let ifElseMissing : PT.Expr = PT.EIf(gid (), PT.EBool(gid (), false), PT.EInt64(gid (), 1), None) + /// (false, true) + let tuple2 : PT.Expr = + PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []) + + /// (false, true, false) + let tuple3 : PT.Expr = + PT.ETuple( + gid (), + PT.EBool(gid (), false), + PT.EBool(gid (), true), + [ PT.EBool(gid (), false) ] + ) + + /// ((false, true), true, (true, false)) + let tupleNested : PT.Expr = + PT.ETuple( + gid (), + PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []), + PT.EBool(gid (), true), + [ PT.ETuple(gid (), PT.EBool(gid (), true), PT.EBool(gid (), false), []) ] + ) + module E = Expressions @@ -336,6 +358,62 @@ let ifElseMissing = return Expect.equal actual expected "" } +let tuple2 = + testTask "(false, true)" { + let actual = PT2RT.Expr.toRT 0 E.tuple2 + + let expected = + (3, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.CreateTuple(0, 1, 2, []) ], + 0) + + return Expect.equal actual expected "" + } + +let tuple3 = + testTask "(false, true, false)" { + let actual = PT2RT.Expr.toRT 0 E.tuple3 + + let expected = + (4, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateTuple(0, 1, 2, [ 3 ]) ], + 0) + + return Expect.equal actual expected "" + } + +let tupleNested = + testTask "((false, true), true, (true, false))" { + let actual = PT2RT.Expr.toRT 0 E.tupleNested + + let expected = + (8, + [ // 0 "reserved" for outer tuple + + // first inner tuple (1 "reserved") + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateTuple(1, 2, 3, []) + + // middle value + RT.LoadVal(4, RT.DBool true) + + // second inner tuple (5 "reserved") + RT.LoadVal(6, RT.DBool true) + RT.LoadVal(7, RT.DBool false) + RT.CreateTuple(5, 6, 7, []) + + // wrap all in outer tuple + RT.CreateTuple(0, 1, 4, [ 5 ]) ], + 0) + + return Expect.equal actual expected "" + } let tests = testList @@ -353,4 +431,7 @@ let tests = dictDupeKey ifGotoThenBranch ifGotoElseBranch - ifElseMissing ] + ifElseMissing + tuple2 + tuple3 + tupleNested ] From 56c0d85b9f4acde9ce00e43e31f88cfd45931e21 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 7 Aug 2024 14:49:19 -0400 Subject: [PATCH 11/60] Pre-work towards package fn calls in new interpreter --- ...ramTypes-PackageFn-PackageFn_function.json | 2 +- ...n-ProgramTypes-Toplevel-T_httphandler.json | 2 +- ...ion-ProgramTypes-Toplevel-T-_complete.json | 8 +- backend/src/BuiltinExecution/Libs/Int64.fs | 2 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 5 +- .../ProgramTypesToSerializedTypes.fs | 6 +- .../LibBinarySerialization/SerializedTypes.fs | 2 +- backend/src/LibCloud/SqlCompiler.fs | 22 +-- backend/src/LibCloud/UserDB.fs | 14 +- backend/src/LibExecution/Execution.fs | 33 +++-- backend/src/LibExecution/Interpreter.Old.fs | 2 +- backend/src/LibExecution/Interpreter.fs | 132 ++++++++---------- backend/src/LibExecution/ProgramTypes.fs | 21 +-- .../LibExecution/ProgramTypesToDarkTypes.fs | 8 +- .../ProgramTypesToRuntimeTypes.fs | 10 +- backend/src/LibExecution/RuntimeTypes.fs | 79 +++++++---- backend/src/LibExecution/RuntimeTypesAst.fs | 10 +- .../LibExecution/RuntimeTypesToDarkTypes.fs | 8 +- .../ExternalTypesToProgramTypes.fs | 4 +- .../LibPackageManager/JsonDeserialization.fs | 4 +- backend/src/LibPackageManager/Types.fs | 2 +- backend/src/LibParser/FSharpToWrittenTypes.fs | 4 +- backend/src/LibParser/WrittenTypes.fs | 2 +- .../LibParser/WrittenTypesToProgramTypes.fs | 4 +- .../testfiles/data/sample-gettingstarted.json | 24 ++-- backend/tests/TestUtils/PTShortcuts.fs | 2 +- backend/tests/TestUtils/RTShortcuts.fs | 2 +- backend/tests/TestUtils/TestUtils.fs | 4 +- backend/tests/Tests/Interpreter.Tests.fs | 4 +- backend/tests/Tests/PT2RT.Tests.fs | 3 +- .../tests/Tests/Serialization.TestValues.fs | 4 +- .../darklang/languageTools/parser/expr.dark | 2 +- .../darklang/languageTools/programTypes.dark | 4 +- .../darklang/languageTools/runtimeTypes.dark | 2 +- .../languageTools/semanticTokens.dark | 2 +- .../darklang/languageTools/writtenTypes.dark | 2 +- .../writtenTypesToProgramTypes.dark | 4 +- .../darklang/prettyPrinter/programTypes.dark | 4 +- 38 files changed, 239 insertions(+), 210 deletions(-) diff --git a/backend/serialization/vanilla_LibExecution-ProgramTypes-PackageFn-PackageFn_function.json b/backend/serialization/vanilla_LibExecution-ProgramTypes-PackageFn-PackageFn_function.json index 2a058881ac..a671b2cbbb 100644 --- a/backend/serialization/vanilla_LibExecution-ProgramTypes-PackageFn-PackageFn_function.json +++ b/backend/serialization/vanilla_LibExecution-ProgramTypes-PackageFn-PackageFn_function.json @@ -489,7 +489,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ diff --git a/backend/serialization/vanilla_LibExecution-ProgramTypes-Toplevel-T_httphandler.json b/backend/serialization/vanilla_LibExecution-ProgramTypes-Toplevel-T_httphandler.json index 65fd7f2b57..28514a57bc 100644 --- a/backend/serialization/vanilla_LibExecution-ProgramTypes-Toplevel-T_httphandler.json +++ b/backend/serialization/vanilla_LibExecution-ProgramTypes-Toplevel-T_httphandler.json @@ -482,7 +482,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ diff --git a/backend/serialization/vanilla_Microsoft-FSharp-Collections-FSharpList-1-LibExecution-ProgramTypes-Toplevel-T-_complete.json b/backend/serialization/vanilla_Microsoft-FSharp-Collections-FSharpList-1-LibExecution-ProgramTypes-Toplevel-T-_complete.json index 8d5e56429f..be4d35f8e2 100644 --- a/backend/serialization/vanilla_Microsoft-FSharp-Collections-FSharpList-1-LibExecution-ProgramTypes-Toplevel-T-_complete.json +++ b/backend/serialization/vanilla_Microsoft-FSharp-Collections-FSharpList-1-LibExecution-ProgramTypes-Toplevel-T-_complete.json @@ -483,7 +483,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ @@ -1956,7 +1956,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ @@ -3432,7 +3432,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ @@ -4905,7 +4905,7 @@ ] }, { - "EFieldAccess": [ + "ERecordFieldAccess": [ 123, { "EVariable": [ diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 454ac21325..8bea7b896e 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -156,7 +156,7 @@ let fns : List = description = "Adds two integers together" fn = (function - | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a + b)) + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a + b)) | _ -> incorrectArgs ()) //sqlSpec = SqlBinOp "+" previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 12fcfa4fb5..3a4aee18eb 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -136,7 +136,8 @@ and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = NEList.length pats1 = NEList.length pats2 && NEList.forall2 (fun p1 p2 -> equalsLetPattern p1 p2) pats1 pats2 && equalsExpr body1 body2 - | EFieldAccess(_, target1, fieldName1), EFieldAccess(_, target2, fieldName2) -> + | ERecordFieldAccess(_, target1, fieldName1), + ERecordFieldAccess(_, target2, fieldName2) -> equalsExpr target1 target2 && fieldName1 = fieldName2 | EVariable(_, name1), EVariable(_, name2) -> name1 = name2 | EApply(_, name1, typeArgs1, args1), EApply(_, name2, typeArgs2, args2) -> @@ -218,7 +219,7 @@ and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = | ELet _, _ | EIf _, _ | ELambda _, _ - | EFieldAccess _, _ + | ERecordFieldAccess _, _ | EVariable _, _ | EApply _, _ | EFnName _, _ diff --git a/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs b/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs index 213e25f8ca..483191a7a1 100644 --- a/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs +++ b/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs @@ -363,7 +363,8 @@ module Expr = | PT.EConstant(id, name) -> ST.EConstant(id, NameResolution.toST FQConstantName.toST name) | PT.EVariable(id, var) -> ST.EVariable(id, var) - | PT.EFieldAccess(id, obj, fieldname) -> ST.EFieldAccess(id, toST obj, fieldname) + | PT.ERecordFieldAccess(id, obj, fieldname) -> + ST.ERecordFieldAccess(id, toST obj, fieldname) | PT.EApply(id, fn, typeArgs, args) -> ST.EApply( id, @@ -467,7 +468,8 @@ module Expr = | ST.EConstant(id, name) -> PT.EConstant(id, NameResolution.toPT FQConstantName.toPT name) | ST.EVariable(id, var) -> PT.EVariable(id, var) - | ST.EFieldAccess(id, obj, fieldname) -> PT.EFieldAccess(id, toPT obj, fieldname) + | ST.ERecordFieldAccess(id, obj, fieldname) -> + PT.ERecordFieldAccess(id, toPT obj, fieldname) | ST.EApply(id, fn, typeArgs, args) -> PT.EApply( id, diff --git a/backend/src/LibBinarySerialization/SerializedTypes.fs b/backend/src/LibBinarySerialization/SerializedTypes.fs index 460ba570be..c863afc572 100644 --- a/backend/src/LibBinarySerialization/SerializedTypes.fs +++ b/backend/src/LibBinarySerialization/SerializedTypes.fs @@ -238,7 +238,7 @@ type Expr = | ELet of id * LetPattern * Expr * Expr | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option | ELambda of id * pats : NEList * body : Expr - | EFieldAccess of id * Expr * string + | ERecordFieldAccess of id * Expr * string | EVariable of id * string | EApply of id * Expr * typeArgs : List * args : NEList | EList of id * List diff --git a/backend/src/LibCloud/SqlCompiler.fs b/backend/src/LibCloud/SqlCompiler.fs index 2c2b4d7d5c..5714bffeef 100644 --- a/backend/src/LibCloud/SqlCompiler.fs +++ b/backend/src/LibCloud/SqlCompiler.fs @@ -331,10 +331,10 @@ let rec inline' | None -> // the variable might be in the symtable, so put it back to fill in later Ply expr - | EFieldAccess(id, expr, fieldname) -> + | ERecordFieldAccess(id, expr, fieldname) -> uply { let! newexpr = inline' fns paramName symtable expr - return EFieldAccess(id, newexpr, fieldname) + return ERecordFieldAccess(id, newexpr, fieldname) } | expr -> Ply expr @@ -693,7 +693,7 @@ let rec lambdaToSql return $"(@{name})", [ name, Sql.jsonb v ], typ - | EFieldAccess(_, subExpr, fieldName) -> + | ERecordFieldAccess(_, subExpr, fieldName) -> // This is the core part of the query compiler - being able to query fields // of the DB rows. // @@ -723,7 +723,7 @@ let rec lambdaToSql : (Option * NEList) = match subExpr with | EVariable(_, v) -> (Some v, pathSoFar) - | EFieldAccess(_, subExpr, childFieldName) -> + | ERecordFieldAccess(_, subExpr, childFieldName) -> getPath (NEList.push childFieldName pathSoFar) subExpr | _ -> error $"Invalid field access pattern: {subExpr}" @@ -953,9 +953,9 @@ let partiallyEvaluate // interpreter instead of in the DB. Anything immutable should be good, // including literals and variables with known values (so not `paramName`) match expr with - | EFieldAccess(_, EVariable(_, name), _) when name <> paramName -> + | ERecordFieldAccess(_, EVariable(_, name), _) when name <> paramName -> return! exec expr - | EFieldAccess(_, ERecord _, _) -> + | ERecordFieldAccess(_, ERecord _, _) -> // inlining can create these situations return! exec expr | EAnd(_, EBool _, EBool _) @@ -1017,7 +1017,7 @@ let partiallyEvaluate | ELet _ | EIf _ | ELambda _ - | EFieldAccess _ + | ERecordFieldAccess _ | EVariable _ | EList _ | ETuple _ @@ -1077,9 +1077,9 @@ let partiallyEvaluate | None -> return None } return EIf(id, cond, ifExpr, elseExpr) - | EFieldAccess(id, expr, fieldname) -> + | ERecordFieldAccess(id, expr, fieldname) -> let! expr = r expr - return EFieldAccess(id, expr, fieldname) + return ERecordFieldAccess(id, expr, fieldname) | ELambda(id, names, expr) -> let! expr = r expr return ELambda(id, names, expr) @@ -1180,8 +1180,8 @@ let compileLambda : Ply> = uply { try - let fns = ExecutionState.availableFunctions state - let types = ExecutionState.availableTypes state + let fns = ExecutionState.fns state + let types = ExecutionState.types state let constants = ExecutionState.availableConstants state let! symtable, body = diff --git a/backend/src/LibCloud/UserDB.fs b/backend/src/LibCloud/UserDB.fs index f37fa7234e..a050c34bba 100644 --- a/backend/src/LibCloud/UserDB.fs +++ b/backend/src/LibCloud/UserDB.fs @@ -58,7 +58,7 @@ let rec set uply { let id = System.Guid.NewGuid() - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state // CLEANUP: the caller should do this type check instead, but we haven't // implemented nested types in the DB yet let context = LibExecution.TypeChecker.DBSchemaType(db.name, db.typ) @@ -103,7 +103,7 @@ and getOption (key : string) : Ply> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! result = Sql.query @@ -135,7 +135,7 @@ and getMany (keys : string list) : Ply> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! result = Sql.query @@ -168,7 +168,7 @@ and getManyWithKeys (keys : string list) : Ply> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! result = Sql.query @@ -200,7 +200,7 @@ and getManyWithKeys let getAll (state : RT.ExecutionState) (db : RT.DB.T) : Ply> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! result = Sql.query @@ -271,7 +271,7 @@ let query (b : RT.LambdaImpl) : Ply, RT.RuntimeError>> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! query = doQuery state db b "key, data" match query with @@ -299,7 +299,7 @@ let queryValues (b : RT.LambdaImpl) : Ply, RT.RuntimeError>> = uply { - let types = RT.ExecutionState.availableTypes state + let types = RT.ExecutionState.types state let! query = doQuery state db b "data" match query with diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 5467857b74..023494aded 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -33,32 +33,40 @@ let createState test = noTestContext reportException = reportException notify = notify - builtins = builtins program = program - packageManager = packageManager - symbolTable = Map.empty - typeSymbolTable = Map.empty } + types = { typeSymbolTable = Map.empty } + fns = { builtIn = builtins.fns; package = packageManager.getFn } } let executeExpr - (state : RT.ExecutionState) + (exeState : RT.ExecutionState) (inputVars : RT.Symtable) (instructionsWithContext : RT.InstructionsWithContext) : Task = task { + let registersNeeded, instructions, resultReg = instructionsWithContext try try - let state = + let vmState : RT.VMState = + { instructions = List.toArray instructions + registers = Array.zeroCreate registersNeeded + resultReg = resultReg + + symbolTable = inputVars + typeSymbolTable = Map.empty } + + let vmState = //{ state with symbolTable = Interpreter.withGlobals state inputVars } - { state with symbolTable = inputVars } - let! result = Interpreter.eval state instructionsWithContext + { vmState with symbolTable = inputVars } + + let! result = Interpreter.eval exeState vmState return Ok result with RT.RuntimeErrorException(source, rte) -> return Error(source, rte) finally // Does nothing in non-tests - state.test.postTestExecutionHook state.test + exeState.test.postTestExecutionHook exeState.test } @@ -75,7 +83,12 @@ let executeFunction { state with tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } let! result = - Interpreter.call state (RT.DFnVal(RT.NamedFn name)) typeArgs args + Interpreter.call + state + RT.VMState.empty + (RT.DFnVal(RT.NamedFn name)) + typeArgs + args return Ok result with RT.RuntimeErrorException(source, rte) -> return Error(source, rte) diff --git a/backend/src/LibExecution/Interpreter.Old.fs b/backend/src/LibExecution/Interpreter.Old.fs index ce9f6ae9b8..9f22bdab2a 100644 --- a/backend/src/LibExecution/Interpreter.Old.fs +++ b/backend/src/LibExecution/Interpreter.Old.fs @@ -531,7 +531,7 @@ let rec eval (state : ExecutionState) (e : Instructions) : DvalTask = $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" - // | EFieldAccess(_, e, fieldName) -> + // | ERecordFieldAccess(_, e, fieldName) -> // let! obj = eval state e // if fieldName = "" then diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index f8c7e7e86c..5641e4ba40 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -7,12 +7,7 @@ open FSharp.Control.Tasks.Affine.Unsafe open Prelude open RuntimeTypes -type Registers = Dval array -type VMState = - { registers : Registers - variables : Map - callStack : List } /// TODO: don't pass ExecutionState around so much? /// The parts that change, (e.g. `st` and `tst`) should probably all be part of VMState @@ -20,57 +15,57 @@ type VMState = /// Maybe rename ExecutionState to something else /// , like ExecutionContext or Execution let rec execute - (state : ExecutionState) + (exeState : ExecutionState) (vmState : VMState) - (instructions : Instructions) - (resultReg : Register) (counter : int) : Ply = uply { + let instructions = vmState.instructions if counter >= instructions.Length then // is this OK? - return vmState.registers[resultReg] + return vmState.registers[vmState.resultReg] else let instruction = instructions[counter] match instruction with - | Return reg -> return vmState.registers[reg] - // `1L` -> next register | LoadVal(reg, value) -> vmState.registers[reg] <- value - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) // `let x = 1` | SetVar(varName, loadFrom) -> let value = vmState.registers[loadFrom] let vmState = - { vmState with variables = Map.add varName value vmState.variables } - return! execute state vmState instructions resultReg (counter + 1) + { vmState with symbolTable = Map.add varName value vmState.symbolTable } + return! execute exeState vmState (counter + 1) // later, `x` | GetVar(loadTo, varName) -> let value = - Map.find varName vmState.variables + Map.find varName vmState.symbolTable // TODO: handle missing variable //return errStr callStack $"There is no variable named: {name}" |> Option.defaultValue DUnit vmState.registers[loadTo] <- value - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) - // `add (increment 1L) (3L)` and store results in `resultReg` + // `add (increment 1L) (3L)` and store results in `putResultIn` // At this point, the 'increment' has already been evaluated. // But maybe that's something we should change, (CLEANUP) // so that we don't execute things until they're needed - | Apply(resultReg, thingToCallReg, typeArgs, argRegs) -> + | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> + // should we instead pass in register indices? probably... let args = argRegs |> NEList.map (fun r -> vmState.registers[r]) let thingToCall = vmState.registers[thingToCallReg] - let! result = call state thingToCall typeArgs args - vmState.registers[resultReg] <- result - return! execute state vmState instructions resultReg (counter + 1) + let! result = call exeState vmState thingToCall typeArgs args + + vmState.registers[putResultIn] <- result + + return! execute exeState vmState (counter + 1) | AddItemToList(listReg, itemToAddReg) -> match vmState.registers[listReg] with @@ -83,7 +78,7 @@ let rec execute let itemToAdd = vmState.registers[itemToAddReg] vmState.registers[listReg] <- DList(vt, list @ [ itemToAdd ]) - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) | _ -> return DString "TODO can't operate list-add to a non-list" | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> @@ -91,7 +86,7 @@ let rec execute let second = vmState.registers[secondReg] let theRest = theRestRegs |> List.map (fun r -> vmState.registers[r]) vmState.registers[tupleReg] <- DTuple(first, second, theRest) - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) | AddDictEntry(dictReg, key, valueReg) -> match vmState.registers[dictReg] with @@ -99,7 +94,7 @@ let rec execute // TODO: type checking of key and value; adjust vt let value = vmState.registers[valueReg] vmState.registers[dictReg] <- DDict(vt, Map.add key value entries) - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) | _ -> return DString "TODO can't operate dict-add to a non-dict" @@ -107,24 +102,21 @@ let rec execute match vmState.registers[targetReg], vmState.registers[sourceReg] with | DString target, DString source -> vmState.registers[targetReg] <- DString(target + source) - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) | _, _ -> return DString "Error: Invalid string-append attempt" | JumpByIfFalse(jumpBy, condReg) -> match vmState.registers[condReg] with - | DBool false -> - return! execute state vmState instructions resultReg (counter + jumpBy + 1) - | DBool true -> - return! execute state vmState instructions resultReg (counter + 1) + | DBool false -> return! execute exeState vmState (counter + jumpBy + 1) + | DBool true -> return! execute exeState vmState (counter + 1) | _ -> return DString "Error: Jump condition must be a boolean" - | JumpBy jumpBy -> - return! execute state vmState instructions resultReg (counter + jumpBy + 1) + | JumpBy jumpBy -> return! execute exeState vmState (counter + jumpBy + 1) | CopyVal(copyTo, copyFrom) -> vmState.registers[copyTo] <- vmState.registers[copyFrom] - return! execute state vmState instructions resultReg (counter + 1) + return! execute exeState vmState (counter + 1) | Fail _rte -> return DUnit // TODO @@ -132,7 +124,8 @@ let rec execute and call - (state : ExecutionState) + (exeState : ExecutionState) + (vmState : VMState) (thingToCall : Dval) (typeArgs : List) (args : NEList) @@ -143,11 +136,11 @@ and call let! fn = match fnName with | FQFnName.Builtin std -> - Map.find std state.builtins.fns |> Option.map builtInFnToFn |> Ply + Map.find std exeState.fns.builtIn |> Option.map builtInFnToFn |> Ply | FQFnName.Package pkg -> uply { - let! fn = state.packageManager.getFn pkg + let! fn = exeState.fns.package pkg return Option.map packageFnToFn fn } @@ -170,7 +163,7 @@ and call // actualArgs // )) - let state = + let vmState = let boundArgs = NEList.map2 (fun (p : Param) actual -> (p.name, actual)) @@ -178,23 +171,23 @@ and call args |> NEList.toList |> Map - { state with - symbolTable = Map.mergeFavoringRight state.symbolTable boundArgs } + { vmState with + symbolTable = Map.mergeFavoringRight vmState.symbolTable boundArgs } - let state = + let vmState = let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map - { state with + { vmState with typeSymbolTable = - Map.mergeFavoringRight state.typeSymbolTable newlyBoundTypeArgs } + Map.mergeFavoringRight vmState.typeSymbolTable newlyBoundTypeArgs } - return! execFn state fnName fn typeArgs args + return! execFn exeState vmState fnName fn typeArgs args | None -> // Functions which aren't available in the runtime (for whatever reason) // may have results available in traces. (use case: inspecting a cloud-run trace locally) let fnResult = - state.tracing.loadFnResult - (state.tracing.callStack.lastCalled, fnName) + exeState.tracing.loadFnResult + (exeState.tracing.callStack.lastCalled, fnName) args match fnResult with @@ -202,7 +195,7 @@ and call | None -> return raiseRTE - state.tracing.callStack + exeState.tracing.callStack (RuntimeError.oldError $"Function {FQFnName.toString fnName} is not found") @@ -212,64 +205,63 @@ and call } and execFn - (state : ExecutionState) + (exeState : ExecutionState) + (vmState : VMState) (fnDesc : FQFnName.FQFnName) (fn : Fn) (typeArgs : List) (args : NEList) : DvalTask = uply { - let types = ExecutionState.availableTypes state - let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map let typeSymbolTable = - Map.mergeFavoringRight state.typeSymbolTable typeArgsResolvedInFn + Map.mergeFavoringRight vmState.typeSymbolTable typeArgsResolvedInFn - match! TypeChecker.checkFunctionCall types typeSymbolTable fn args with - | Error rte -> return raiseRTE state.tracing.callStack rte + match! TypeChecker.checkFunctionCall exeState.types typeSymbolTable fn args with + | Error rte -> return raiseRTE exeState.tracing.callStack rte | Ok() -> let! result = match fn.fn with | BuiltInFunction f -> let executionPoint = ExecutionPoint.Function fn.name - state.tracing.traceExecutionPoint executionPoint + exeState.tracing.traceExecutionPoint executionPoint - let state = - { state with tracing.callStack.lastCalled = (executionPoint, None) } + let exeState = + { exeState with tracing.callStack.lastCalled = (executionPoint, None) } uply { let! result = uply { try - return! f (state, typeArgs, NEList.toList args) + return! f (exeState, vmState, typeArgs, NEList.toList args) with e -> match e with | RuntimeErrorException(None, rte) -> // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack // So we catch the exception here and add the callStack to it so it's handy in error-reporting - return raiseRTE state.tracing.callStack rte + return raiseRTE exeState.tracing.callStack rte | RuntimeErrorException _ -> return Exception.reraise e | e -> let context : Metadata = [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] - state.reportException state context e + exeState.reportException exeState context e // These are arbitrary errors, and could include sensitive // information, so best not to show it to the user. If we'd // like to show it to the user, we should catch it where it happens // and give them a known safe error via a RuntimeError return raiseRTE - state.tracing.callStack + exeState.tracing.callStack (RuntimeError.oldError "Unknown error") } if fn.previewable <> Pure then // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath - state.tracing.storeFnResult - (state.tracing.callStack.lastCalled, fnDesc) + exeState.tracing.storeFnResult + (exeState.tracing.callStack.lastCalled, fnDesc) args result @@ -293,22 +285,14 @@ and execFn //eval state instructions resultReg Ply DUnit // TODO - match! TypeChecker.checkFunctionReturnType types typeSymbolTable fn result with - | Error rte -> return raiseRTE state.tracing.callStack rte + match! + TypeChecker.checkFunctionReturnType exeState.types typeSymbolTable fn result + with + | Error rte -> return raiseRTE exeState.tracing.callStack rte | Ok() -> return result } -and eval - (state : ExecutionState) - (instructionsWithContext : InstructionsWithContext) - : Ply = - let registersNeeded, instructions, resultReg = instructionsWithContext - - let vmState = - { registers = Array.zeroCreate registersNeeded - variables = Map.empty - callStack = [] } - - execute state vmState instructions resultReg 0 +and eval (exeState : ExecutionState) (vmState : VMState) : Ply = + execute exeState vmState 0 diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 79314949f5..5dace51f7e 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -287,8 +287,6 @@ type Expr = | EVariable of id * string - // // Access a field of some expression (e.g. `someExpr.fieldName`) - // | EFieldAccess of id * Expr * string // -- Basic structures -- @@ -317,20 +315,22 @@ type Expr = // // -- References to custom types and data -- -// | EConstant of -// id * -// // TODO: this reference should be by-hash -// NameResolution -// // See NameResolution comment above +// /// Construct a record +// /// `SomeRecord { field1: value; field2: value }` // | ERecord of // id * // // TODO: this reference should be by-hash // typeName : NameResolution * // // User is allowed type `Name {}` even if that's an error // fields : List + // | ERecordUpdate of id * record : Expr * updates : NEList +// /// Access a field of some record (e.g. `someExpr.fieldName`) +// | ERecordFieldAccess of id * record: Expr * fieldName: string + + // // Enums include `Some`, `None`, `Error`, `Ok`, as well // // as user-defined enums. // // @@ -347,6 +347,11 @@ type Expr = // caseName : string * // fields : List +// | EConstant of +// id * +// // TODO: this reference should be by-hash +// NameResolution + //and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } @@ -394,7 +399,7 @@ module Expr = //| EInfix(id, _, _, _) // | ELambda(id, _, _) | EFnName(id, _) - // | EFieldAccess(id, _, _) + // | ERecordFieldAccess(id, _, _) | EVariable(id, _) | EApply(id, _, _, _) | EList(id, _) diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index 73fdbb068c..c478f79d2c 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -673,8 +673,8 @@ module Expr = | PT.ELet(id, lp, expr, body) -> "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - | PT.EFieldAccess(id, expr, fieldName) -> - "EFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] + | PT.ERecordFieldAccess(id, expr, fieldName) -> + "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] | PT.EVariable(id, varName) -> "EVariable", [ DInt64(int64 id); DString varName ] @@ -839,8 +839,8 @@ module Expr = | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> PT.ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - | DEnum(_, _, [], "EFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> - PT.EFieldAccess(uint64 id, fromDT expr, fieldName) + | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> + PT.ERecordFieldAccess(uint64 id, fromDT expr, fieldName) | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> PT.EVariable(uint64 id, varName) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 483de562b2..d105c378ed 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -387,18 +387,16 @@ module Expr = (newRc, instrs @ newInstrs, argResultRegs @ [ argResultReg ])) init - let resultReg = regCounter + let putResultIn = regCounter let callInstr = RT.Apply( - resultReg, + putResultIn, thingToApplyReg, List.map TypeReference.toRT typeArgs, NEList.ofListUnsafe "" [] argRegs ) - (resultReg + 1, - thingToApplyInstrs @ argInstrs @ [ callInstr; RT.Return resultReg ], - resultReg) + (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) // let rec toRT (e : PT.Expr) : RT.Instructions = @@ -409,7 +407,7 @@ module Expr = // // | PT.EVariable(id, var) -> RT.EVariable(id, var) -// // | PT.EFieldAccess(id, obj, fieldname) -> RT.EFieldAccess(id, toRT obj, fieldname) +// // | PT.ERecordFieldAccess(id, obj, fieldname) -> RT.ERecordFieldAccess(id, toRT obj, fieldname) // | PT.EApply(id, fnName, typeArgs, args) -> // // RT.EApply( diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index a56dd34a71..8ea2bc432e 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -564,11 +564,6 @@ and Instruction = typeArgs : List * args : NEList - - /// Return whatever's in the noted register - /// (usually relevant only for branching logic like `if`, `match`) - | Return of from : Register - /// Fail if this is hit (basically "raise an exception") | Fail of RuntimeError @@ -589,7 +584,7 @@ and InstructionsWithContext = // // | EOr of id * lhs : Expr * rhs : Expr // // // declaring and referencing vars -// // | EFieldAccess of id * Expr * string +// // | ERecordFieldAccess of id * Expr * string // // calling fns and other things // | EApply of id * Expr * typeArgs : List * args : NEList @@ -912,7 +907,7 @@ type Deprecation<'name> = // // | EConstant(id, _) // // | EVariable(id, _) -// // | EFieldAccess(id, _, _) +// // | ERecordFieldAccess(id, _, _) // // | ELambda(id, _, _) // // | ELet(id, _, _, _) // // | EIf(id, _, _, _) @@ -1405,8 +1400,9 @@ and Fn = } and BuiltInFnSig = - // state * typeArgs * fnArgs -> result - (ExecutionState * List * List) -> DvalTask + // exeState * vmState * typeArgs * fnArgs -> result + // CLEANUP this is sort of a _lot_ to pass into every builtin fn call - reduce? + (ExecutionState * VMState * List * List) -> DvalTask and FnImpl = | BuiltInFunction of BuiltInFnSig @@ -1426,6 +1422,7 @@ and LoadFnResult = FunctionRecord -> NEList -> Option NEList -> Dval -> unit /// Every part of a user's program +/// CLEANUP rename to 'app'? and Program = { canvasID : CanvasID internalFnsAllowed : bool @@ -1512,7 +1509,6 @@ and Notifier = ExecutionState -> string -> Metadata -> unit /// All state used while running a program and ExecutionState = { // -- Set consistently across a runtime -- - builtins : Builtins tracing : Tracing test : TestContext @@ -1533,16 +1529,45 @@ and ExecutionState = // -- Can change over time during execution -- // (probably move these things to VMState) - // Maybe replace this and `builtins` with availTypes, availConsts, availFns? - // We're doing some ExecutionState -> (those) mappings at runtime on occasion, - // probably a lot more than we need - packageManager : PackageManager + // // Maybe replace this and `builtins` with availTypes, availConsts, availFns? + // // We're doing some ExecutionState -> (those) mappings at runtime on occasion, + // // probably a lot more than we need + // packageManager : PackageManager + // builtins : Builtins + + types : Types + fns : Functions + //availableConstants: Constants - // Is anything actually referencing this right now? - symbolTable : Symtable - typeSymbolTable : TypeSymbolTable } +and Registers = Dval array + +and VMState = + { instructions : Instruction array + registers : Registers + resultReg : Register + + symbolTable : Symtable + typeSymbolTable : TypeSymbolTable } + + static member empty = + { instructions = Array.empty + registers = Array.empty + resultReg = 0 + + symbolTable = Map.empty + typeSymbolTable = Map.empty } + + static member fromInstructions(instructions : InstructionsWithContext) : VMState = + let registersNeeded, instructions, resultReg = instructions + { instructions = List.toArray instructions + registers = Array.zeroCreate registersNeeded + resultReg = resultReg + + symbolTable = Map.empty + typeSymbolTable = Map.empty } + and Types = { typeSymbolTable : TypeSymbolTable //package : FQTypeName.Package -> Ply> @@ -1558,18 +1583,18 @@ and Functions = -module ExecutionState = - let availableTypes (state : ExecutionState) : Types = - { typeSymbolTable = state.typeSymbolTable - //package = state.packageManager.getType - } +// module ExecutionState = +// let availableTypes (state : ExecutionState) : Types = +// { typeSymbolTable = state.typeSymbolTable +// //package = state.packageManager.getType +// } - // let availableConstants (state : ExecutionState) : Constants = - // { builtIn = state.builtins.constants - // package = state.packageManager.getConstant } +// let availableConstants (state : ExecutionState) : Constants = +// { builtIn = state.builtins.constants +// package = state.packageManager.getConstant } - let availableFunctions (state : ExecutionState) : Functions = - { builtIn = state.builtins.fns; package = state.packageManager.getFn } +// let availableFunctions (state : ExecutionState) : Functions = +// { builtIn = state.builtins.fns; package = state.packageManager.getFn } diff --git a/backend/src/LibExecution/RuntimeTypesAst.fs b/backend/src/LibExecution/RuntimeTypesAst.fs index 943d2378c8..98a0014b84 100644 --- a/backend/src/LibExecution/RuntimeTypesAst.fs +++ b/backend/src/LibExecution/RuntimeTypesAst.fs @@ -109,7 +109,8 @@ let rec preTraversal | ELet(id, pat, rhs, next) -> ELet(id, preTraversalLetPattern pat, f rhs, f next) | EIf(id, cond, ifexpr, elseexpr) -> EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | EFieldAccess(id, expr, fieldname) -> EFieldAccess(id, f expr, fieldname) + | ERecordFieldAccess(id, expr, fieldname) -> + ERecordFieldAccess(id, f expr, fieldname) | EApply(id, name, typeArgs, args) -> EApply(id, f name, List.map preTraversalTypeRef typeArgs, NEList.map f args) | EFnName(id, name) -> EFnName(id, fqfnFn name) @@ -248,7 +249,8 @@ let rec postTraversal | ELet(id, pat, rhs, next) -> ELet(id, postTraversalLetPattern pat, f rhs, f next) | EIf(id, cond, ifexpr, elseexpr) -> EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | EFieldAccess(id, expr, fieldname) -> EFieldAccess(id, f expr, fieldname) + | ERecordFieldAccess(id, expr, fieldname) -> + ERecordFieldAccess(id, f expr, fieldname) | EApply(id, name, typeArgs, args) -> EApply(id, f name, List.map postTraversalTypeRef typeArgs, NEList.map f args) | EFnName(id, name) -> EFnName(id, fqfnFn name) @@ -554,10 +556,10 @@ let rec postTraversalAsync let! fields = Ply.List.mapSequentially r fields return EEnum(id, typeName, caseName, fields) } - | EFieldAccess(id, expr, fieldname) -> + | ERecordFieldAccess(id, expr, fieldname) -> uply { let! expr = r expr - return EFieldAccess(id, expr, fieldname) + return ERecordFieldAccess(id, expr, fieldname) } diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs index 1432cb7df2..59f46be9f3 100644 --- a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs +++ b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs @@ -459,8 +459,8 @@ module Expr = | ELet(id, lp, expr, body) -> "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - | EFieldAccess(id, expr, fieldName) -> - "EFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] + | ERecordFieldAccess(id, expr, fieldName) -> + "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] | EVariable(id, varName) -> "EVariable", [ DInt64(int64 id); DString varName ] @@ -605,8 +605,8 @@ module Expr = | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - | DEnum(_, _, [], "EFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> - EFieldAccess(uint64 id, fromDT expr, fieldName) + | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> + ERecordFieldAccess(uint64 id, fromDT expr, fieldName) | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> EVariable(uint64 id, varName) diff --git a/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs b/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs index 166158e401..d72ef2aacf 100644 --- a/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs +++ b/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs @@ -216,8 +216,8 @@ module Expr = | EPT.EConstant(id, name) -> PT.EConstant(id, NameResolution.toPT ConstantName.toPT name) | EPT.EVariable(id, var) -> PT.EVariable(id, var) - | EPT.EFieldAccess(id, obj, fieldname) -> - PT.EFieldAccess(id, toPT obj, fieldname) + | EPT.ERecordFieldAccess(id, obj, fieldname) -> + PT.ERecordFieldAccess(id, toPT obj, fieldname) | EPT.EApply(id, name, typeArgs, args) -> PT.EApply( id, diff --git a/backend/src/LibPackageManager/JsonDeserialization.fs b/backend/src/LibPackageManager/JsonDeserialization.fs index 056c9c5e24..b1cbfce43b 100644 --- a/backend/src/LibPackageManager/JsonDeserialization.fs +++ b/backend/src/LibPackageManager/JsonDeserialization.fs @@ -475,12 +475,12 @@ module ProgramTypes = (fun ctx -> decoder ctx) (fun ctx -> decoder ctx) (fun id pattern value body -> DU.ELet(id, pattern, value, body))) - ("EFieldAccess", + ("ERecordFieldAccess", Decoders.enum3Fields ID.decoder (fun ctx -> decoder ctx) Decoders.string - (fun id expr fieldName -> DU.EFieldAccess(id, expr, fieldName))) + (fun id expr fieldName -> DU.ERecordFieldAccess(id, expr, fieldName))) ("EVariable", Decoders.enum2Fields ID.decoder Decoders.string (fun id name -> DU.EVariable(id, name))) diff --git a/backend/src/LibPackageManager/Types.fs b/backend/src/LibPackageManager/Types.fs index 704b127109..cb9eda4937 100644 --- a/backend/src/LibPackageManager/Types.fs +++ b/backend/src/LibPackageManager/Types.fs @@ -187,7 +187,7 @@ module ProgramTypes = fields : List | ELet of ID * LetPattern * Expr * Expr - | EFieldAccess of ID * Expr * string + | ERecordFieldAccess of ID * Expr * string | EVariable of ID * string | EIf of ID * cond : Expr * thenExpr : Expr * elseExpr : Option diff --git a/backend/src/LibParser/FSharpToWrittenTypes.fs b/backend/src/LibParser/FSharpToWrittenTypes.fs index a9eaeb3dc6..84736bef21 100644 --- a/backend/src/LibParser/FSharpToWrittenTypes.fs +++ b/backend/src/LibParser/FSharpToWrittenTypes.fs @@ -502,7 +502,7 @@ module Expr = | var :: fields -> List.fold (fun acc (field : Ident) -> - WT.EFieldAccess(id, acc, nameOrBlank field.idText)) + WT.ERecordFieldAccess(id, acc, nameOrBlank field.idText)) (WT.EVariable(gid (), var.idText)) fields @@ -510,7 +510,7 @@ module Expr = | SynExpr.DotGet(expr, _, SynLongIdent(fields, _, _), _) -> List.fold (fun acc (field : Ident) -> - WT.EFieldAccess(id, acc, nameOrBlank field.idText)) + WT.ERecordFieldAccess(id, acc, nameOrBlank field.idText)) (c expr) fields diff --git a/backend/src/LibParser/WrittenTypes.fs b/backend/src/LibParser/WrittenTypes.fs index 65181672df..ec81589fda 100644 --- a/backend/src/LibParser/WrittenTypes.fs +++ b/backend/src/LibParser/WrittenTypes.fs @@ -172,7 +172,7 @@ type Expr = | ELet of id * LetPattern * Expr * Expr | EVariable of id * string - | EFieldAccess of id * Expr * string + | ERecordFieldAccess of id * Expr * string | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option // CLEANUP: why is this not an NEList? diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index 79b472ff06..d96278be83 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -189,9 +189,9 @@ module Expr = match constant with | Ok _ as name -> return PT.EConstant(id, name) | Error _ -> return PT.EVariable(id, var) - | WT.EFieldAccess(id, obj, fieldname) -> + | WT.ERecordFieldAccess(id, obj, fieldname) -> let! obj = toPT obj - return PT.EFieldAccess(id, obj, fieldname) + return PT.ERecordFieldAccess(id, obj, fieldname) | WT.EApply(id, (WT.EFnName(_, name)), [], { head = WT.EPlaceHolder }) -> // There are no arguments, so this could be a function name or a constant let! fnName = diff --git a/backend/testfiles/data/sample-gettingstarted.json b/backend/testfiles/data/sample-gettingstarted.json index 30d350cda5..776a9833f6 100644 --- a/backend/testfiles/data/sample-gettingstarted.json +++ b/backend/testfiles/data/sample-gettingstarted.json @@ -508,7 +508,7 @@ 714315755, "", [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -544,7 +544,7 @@ 714315755, "b", [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -580,7 +580,7 @@ 714315755, "bo", [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -616,7 +616,7 @@ 714315755, "bod", [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -652,7 +652,7 @@ 714315755, "body", [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -684,7 +684,7 @@ { "tlid": 666433085, "ast": [ - "EFieldAccess", + "ERecordFieldAccess", 1130637733, [ "EVariable", @@ -979,7 +979,7 @@ 564987523, "", [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", @@ -1015,7 +1015,7 @@ 564987523, "b", [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", @@ -1051,7 +1051,7 @@ 564987523, "bo", [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", @@ -1087,7 +1087,7 @@ 564987523, "bod", [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", @@ -1123,7 +1123,7 @@ 564987523, "body", [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", @@ -1155,7 +1155,7 @@ { "tlid": 262224779, "ast": [ - "EFieldAccess", + "ERecordFieldAccess", 2115087762, [ "EVariable", diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 8c3c03caab..e85ac0d049 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -33,7 +33,7 @@ let eList (elems : Expr list) : Expr = EList(gid (), elems) let eVar (name : string) : Expr = EVariable(gid (), name) // let eFieldAccess (expr : Expr) (fieldName : string) : Expr = -// EFieldAccess(gid (), expr, fieldName) +// ERecordFieldAccess(gid (), expr, fieldName) // let eLambda (pats : List) (body : Expr) : Expr = // let pats = NEList.ofListUnsafe "eLambda" [] pats diff --git a/backend/tests/TestUtils/RTShortcuts.fs b/backend/tests/TestUtils/RTShortcuts.fs index 50dddd992a..5347f34198 100644 --- a/backend/tests/TestUtils/RTShortcuts.fs +++ b/backend/tests/TestUtils/RTShortcuts.fs @@ -36,7 +36,7 @@ module PT2RT = LibExecution.ProgramTypesToRuntimeTypes // let eVar (name : string) : Expr = EVariable(gid (), name) // let eFieldAccess (expr : Expr) (fieldName : string) : Expr = -// EFieldAccess(gid (), expr, fieldName) +// ERecordFieldAccess(gid (), expr, fieldName) // let eLambda (pats : List) (body : Expr) : Expr = // let pats = NEList.ofListUnsafe "eLambda" [] pats diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index bdd525beb1..d659fcc53d 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -635,7 +635,7 @@ module Expect = // // fields // // fields' - // // | EFieldAccess(_, e, f), EFieldAccess(_, e', f') -> + // // | ERecordFieldAccess(_, e, f), ERecordFieldAccess(_, e', f') -> // // eq (f :: path) e e' // // check path f f' @@ -711,7 +711,7 @@ module Expect = // // | ERecord _, _ // // | ERecordUpdate _, _ // // | EDict _, _ - // // | EFieldAccess _, _ + // // | ERecordFieldAccess _, _ // // | EEnum _, _ // // | ELambda _, _ // // | EMatch _, _ diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index ba145473aa..359ea5fec0 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -13,12 +13,12 @@ module E = Tests.ProgramTypesToRuntimeTypes.Expressions let eval pt = uply { - let instructionsWithContext = PT2RT.Expr.toRT 0 pt + let vmState = PT2RT.Expr.toRT 0 pt |> RT.VMState.fromInstructions let! executionState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false - return! LibExecution.Interpreter.eval executionState instructionsWithContext + return! LibExecution.Interpreter.eval executionState vmState } diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 6982fda49a..a5b7c4432e 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -135,8 +135,7 @@ let onePlusTwo = ) RT.LoadVal(1, RT.DInt64 1L) RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) - RT.Return(3) ], + RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], 3) return Expect.equal actual expected "" diff --git a/backend/tests/Tests/Serialization.TestValues.fs b/backend/tests/Tests/Serialization.TestValues.fs index b09a5fec96..efb1c24979 100644 --- a/backend/tests/Tests/Serialization.TestValues.fs +++ b/backend/tests/Tests/Serialization.TestValues.fs @@ -130,7 +130,7 @@ module RuntimeTypes = ), RT.EUnit(id) ) - RT.EFieldAccess(id, RT.EUnit(id), "field") + RT.ERecordFieldAccess(id, RT.EUnit(id), "field") RT.EVariable(id, "var4") RT.EApply(id, RT.EUnit(id), typeReferences, NEList.singleton (RT.EUnit(id))) RT.EApply( @@ -376,7 +376,7 @@ module ProgramTypes = PT.EInfix( id, PT.InfixFnCall(PT.ArithmeticPlus), - PT.EFieldAccess(id, PT.EVariable(id, "x"), "y"), + PT.ERecordFieldAccess(id, PT.EVariable(id, "x"), "y"), PT.EApply( id, PT.EFnName( diff --git a/packages/darklang/languageTools/parser/expr.dark b/packages/darklang/languageTools/parser/expr.dark index 81fc9fb0f4..e5b64dbf70 100644 --- a/packages/darklang/languageTools/parser/expr.dark +++ b/packages/darklang/languageTools/parser/expr.dark @@ -487,7 +487,7 @@ module Darklang = match expr, symbolDotNode, fieldName with | Ok expr, Ok symbolDot, Ok field -> - (WrittenTypes.Expr.EFieldAccess( + (WrittenTypes.Expr.ERecordFieldAccess( node.range, expr, (field.range, nameOrBlank field.text), diff --git a/packages/darklang/languageTools/programTypes.dark b/packages/darklang/languageTools/programTypes.dark index f1900ca956..b948bc794e 100644 --- a/packages/darklang/languageTools/programTypes.dark +++ b/packages/darklang/languageTools/programTypes.dark @@ -241,7 +241,7 @@ module Darklang = // declaring and accessing variables | ELet of ID * LetPattern * Expr * Expr - | EFieldAccess of ID * Expr * String + | ERecordFieldAccess of ID * Expr * String | EVariable of ID * String | EConstant of ID * NameResolution @@ -293,7 +293,7 @@ module Darklang = | EIf(id, _, _, _) -> id | EInfix(id, _, _, _) -> id | ELambda(id, _, _) -> id - | EFieldAccess(id, _, _) -> id + | ERecordFieldAccess(id, _, _) -> id | EVariable(id, _) -> id | EApply(id, _, _, _) -> id | EList(id, _) -> id diff --git a/packages/darklang/languageTools/runtimeTypes.dark b/packages/darklang/languageTools/runtimeTypes.dark index 502d4ab0ec..f4da64bccf 100644 --- a/packages/darklang/languageTools/runtimeTypes.dark +++ b/packages/darklang/languageTools/runtimeTypes.dark @@ -81,7 +81,7 @@ module Darklang = thenExpr: Expr * elseExpr: Stdlib.Option.Option | ELambda of ID * List * Expr - | EFieldAccess of ID * Expr * String + | ERecordFieldAccess of ID * Expr * String | EVariable of ID * String | EApply of ID * Expr * typeArgs: List * args: List | EFnName of ID * FQFnName.FQFnName diff --git a/packages/darklang/languageTools/semanticTokens.dark b/packages/darklang/languageTools/semanticTokens.dark index 1561ef93a4..98f50cc355 100644 --- a/packages/darklang/languageTools/semanticTokens.dark +++ b/packages/darklang/languageTools/semanticTokens.dark @@ -939,7 +939,7 @@ module Darklang = | EConstantOrFn(range, id) -> QualifiedConstOrFnIdentifier.tokenize id // person.name - | EFieldAccess(_range, expr, (r, fieldName), symbolDot) -> + | ERecordFieldAccess(_range, expr, (r, fieldName), symbolDot) -> [ // person Expr.tokenize expr // . diff --git a/packages/darklang/languageTools/writtenTypes.dark b/packages/darklang/languageTools/writtenTypes.dark index 56ec1fdeda..3ff39f1c0e 100644 --- a/packages/darklang/languageTools/writtenTypes.dark +++ b/packages/darklang/languageTools/writtenTypes.dark @@ -292,7 +292,7 @@ module Darklang = | EVariable of Range * String - | EFieldAccess of + | ERecordFieldAccess of Range * Expr * fieldName: (Range * String) * diff --git a/packages/darklang/languageTools/writtenTypesToProgramTypes.dark b/packages/darklang/languageTools/writtenTypesToProgramTypes.dark index 0fa803aa9c..19e0b704d9 100644 --- a/packages/darklang/languageTools/writtenTypesToProgramTypes.dark +++ b/packages/darklang/languageTools/writtenTypesToProgramTypes.dark @@ -507,8 +507,8 @@ module Darklang = // CLEANUP: Rethink this solution. It was added to allow failure during the first pass of parsing, where names aren't yet resolved ProgramTypes.Expr.EVariable (gid ()) id.constantOrFn.name - | EFieldAccess(_, expr, (_, fieldName), _) -> - ProgramTypes.Expr.EFieldAccess( + | ERecordFieldAccess(_, expr, (_, fieldName), _) -> + ProgramTypes.Expr.ERecordFieldAccess( gid (), toPT onMissing pm owner currentModule expr, fieldName diff --git a/packages/darklang/prettyPrinter/programTypes.dark b/packages/darklang/prettyPrinter/programTypes.dark index 402913ee35..b553c73a77 100644 --- a/packages/darklang/prettyPrinter/programTypes.dark +++ b/packages/darklang/prettyPrinter/programTypes.dark @@ -584,13 +584,13 @@ module Darklang = $"let {patternPart} =\n{PrettyPrinter.indent rhsPart}\n{bodyPart}" - | EFieldAccess(_id, expr, fieldName) -> + | ERecordFieldAccess(_id, expr, fieldName) -> let exprPart = PrettyPrinter.ProgramTypes.expr expr // TODO: only sometimes need to wrap exprPart in parens match expr with | EVariable(_, _) -> $"{exprPart}.{fieldName}" - | EFieldAccess(_, _, _) -> $"{exprPart}.{fieldName}" + | ERecordFieldAccess(_, _, _) -> $"{exprPart}.{fieldName}" | _ -> $"({exprPart}).{fieldName}" | EVariable(_id, name) -> name From c2f3f6eb3518b09946960990e742c6807df5076d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 12 Aug 2024 18:49:26 -0400 Subject: [PATCH 12/60] Handle LPTuple in new interpreter --- backend/src/LibExecution/Interpreter.fs | 13 +++ backend/src/LibExecution/ProgramTypes.fs | 10 +-- .../ProgramTypesToRuntimeTypes.fs | 42 ++++++--- backend/src/LibExecution/RuntimeTypes.fs | 9 +- backend/tests/Tests/Interpreter.Tests.fs | 22 +++++ backend/tests/Tests/PT2RT.Tests.fs | 85 ++++++++++++++++++- 6 files changed, 154 insertions(+), 27 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 5641e4ba40..c42081d34a 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -14,6 +14,8 @@ open RuntimeTypes /// /// Maybe rename ExecutionState to something else /// , like ExecutionContext or Execution +/// +/// TODO potentially make this a loop instead of recursive let rec execute (exeState : ExecutionState) (vmState : VMState) @@ -118,6 +120,17 @@ let rec execute vmState.registers[copyTo] <- vmState.registers[copyFrom] return! execute exeState vmState (counter + 1) + | ExtractTupleItems(extractFrom, firstReg, secondReg, restRegs) -> + match vmState.registers[extractFrom] with + | DTuple(first, second, rest) -> + vmState.registers[firstReg] <- first + vmState.registers[secondReg] <- second + + List.zip restRegs rest + |> List.iter (fun (reg, value) -> vmState.registers[reg] <- value) + + return! execute exeState vmState (counter + 1) + | _ -> return DString "Error: Expected a tuple for decomposition" | Fail _rte -> return DUnit // TODO } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 5dace51f7e..cec0dffedd 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -117,11 +117,11 @@ type NameResolution<'a> = Result<'a, NameResolutionError.Error> type LetPattern = | LPUnit of id - // | LPTuple of - // id * - // first : LetPattern * - // second : LetPattern * - // theRest : List + | LPTuple of + id * + first : LetPattern * + second : LetPattern * + theRest : List | LPVariable of id * name : string // /// Used for pattern matching in a match statement diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index d105c378ed..a36f01d3c1 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -131,24 +131,38 @@ module TypeReference = module LetPattern = let rec toRT - (regCounter : int) - (p : PT.LetPattern) - (valueReg : RT.Register) - (instrs : RT.Instructions) + (rc : int) + (pat : PT.LetPattern) + (rhsReg : RT.Register) // what we're binding to : (int * RT.Instructions) = - match p with + match pat with // No binding needed for unit pattern // (would also be the case if we have a `_ignore` pattern later) - | PT.LPUnit _ -> (regCounter, instrs) + | PT.LPUnit _ -> (rc, []) + + | PT.LPTuple(_id, first, second, theRest) -> + // reserve the first two registers + let firstReg, secondReg, rc = rc, rc + 1, rc + 2 + + let (rcAfterFirst, firstInstrs) = toRT rc first firstReg + let (rcAfterSecond, secondInstrs) = toRT rcAfterFirst second secondReg + + let (finalRc, restInstrs, restRegs) = + theRest + |> List.fold + (fun (currentRc, instrs, regs) restPattern -> + let restReg = currentRc + let (rcAfterPat, patternInstrs) = + toRT (currentRc + 1) restPattern restReg + (rcAfterPat, instrs @ patternInstrs, regs @ [ restReg ])) + (rcAfterSecond, [], []) + + let extractInstructions = + [ RT.ExtractTupleItems(rhsReg, firstReg, secondReg, restRegs) ] - // | LPTuple(_id, first, second, rest) -> - // // Destructure the tuple value into registers and compile sub-patterns - // let (regCounter, instrs) = compileLetPattern regCounter first valueReg instructions - // let (regCounter, instrs) = compileLetPattern regCounter second (valueReg + 1) instrs - // List.fold (fun (rc, instrs) pat -> compileLetPattern rc pat (valueReg + 2) instrs) (regCounter, instrs) rest + (finalRc, extractInstructions @ firstInstrs @ secondInstrs @ restInstrs) - | PT.LPVariable(_id, varName) -> - (regCounter, instrs @ [ RT.SetVar(varName, valueReg) ]) + | PT.LPVariable(_id, varName) -> (rc, [ RT.SetVar(varName, rhsReg) ]) @@ -296,7 +310,7 @@ module Expr = // let x = 1 | PT.ELet(_id, pat, expr, body) -> let (regCounter, exprInstrs, exprReg) = toRT rc expr - let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg [] + let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg let (regCounter, bodyInstrs, bodyExprReg) = toRT regCounter body (regCounter, exprInstrs @ patInstrs @ bodyInstrs, bodyExprReg) diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 8ea2bc432e..4ca2e07adf 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -520,10 +520,6 @@ and Instruction = | GetVar of loadTo : Register * varName : string - // | Jump of jumpTo: Register - // | JumpIfFalse of condition: Register * jumpTo: Register - - /// Add an item to an existing list /// , and type-check to make sure it matches the ValueType of that list /// @@ -555,6 +551,11 @@ and Instruction = /// Go n instructions forward, unconditionally | JumpBy of instrsToJump : int + | ExtractTupleItems of + extractFrom : Register * + firstReg : Register * + secondReg : Register * + restRegs : List /// Apply some args (and maybe type args) to something /// (a named function, or lambda, etc) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 359ea5fec0..2b9b0f2c33 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -48,6 +48,24 @@ let boolListList = ) return Expect.equal actual expected "" } +let letSimple = + testTask "let x = true\nx" { + let! actual = eval E.letSimple |> Ply.toTask + let expected = RT.DBool true + return Expect.equal actual expected "" + } +let letTuple = + testTask "let (x, y) = (1, 2)\nx" { + let! actual = eval E.letTuple |> Ply.toTask + let expected = RT.DInt64 1L + return Expect.equal actual expected "" + } +let letTupleNested = + testTask "let (a, (b, c)) = (1, (2, 3))\nb" { + let! actual = eval E.letTupleNested |> Ply.toTask + let expected = RT.DInt64 2L + return Expect.equal actual expected "" + } let simpleString = testTask "[\"hello\"]" { @@ -150,6 +168,10 @@ let tests = "Interpreter" [ onePlusTwo boolList + boolListList + letSimple + letTuple + letTupleNested simpleString stringWithInterpolation dictEmpty diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index a5b7c4432e..99556edfec 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -26,13 +26,43 @@ module Expressions = // TODO: try to use undefined variable // TODO: lpunit - let defineAndUseVar : PT.Expr = + let letSimple : PT.Expr = PT.ELet( gid (), PT.LPVariable(gid (), "x"), PT.EBool(gid (), true), PT.EVariable(gid (), "x") ) + let letTuple : PT.Expr = + PT.ELet( + gid (), + PT.LPTuple(gid (), PT.LPVariable(gid (), "x"), PT.LPVariable(gid (), "y"), []), + PT.ETuple(gid (), PT.EInt64(gid (), 1), PT.EInt64(gid (), 2), []), + PT.EVariable(gid (), "x") + ) + /// `let (a, (b, c)) = (1, (2, 3)) in b` + let letTupleNested : PT.Expr = + PT.ELet( + gid (), + PT.LPTuple( + gid (), + PT.LPVariable(gid (), "a"), + PT.LPTuple( + gid (), + PT.LPVariable(gid (), "b"), + PT.LPVariable(gid (), "c"), + [] + ), + [] + ), + PT.ETuple( + gid (), + PT.EInt64(gid (), 1), + PT.ETuple(gid (), PT.EInt64(gid (), 2), PT.EInt64(gid (), 3), []), + [] + ), + PT.EVariable(gid (), "b") + ) let boolList : PT.Expr = PT.EList( @@ -141,9 +171,9 @@ let onePlusTwo = return Expect.equal actual expected "" } -let defineAndUseVar = +let letSimple = testTask "let x = true\n x" { - let actual = PT2RT.Expr.toRT 0 E.defineAndUseVar + let actual = PT2RT.Expr.toRT 0 E.letSimple let expected = (2, @@ -154,6 +184,51 @@ let defineAndUseVar = return Expect.equal actual expected "" } + +let letTuple = + testTask "let (x, y) = (1, 2)\nx" { + let actual = PT2RT.Expr.toRT 0 E.letTuple + + let expected = + (6, + [ // register 0 isn't exposed, but used to temporarily store the tuple + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + RT.ExtractTupleItems(0, 3, 4, []) + + RT.SetVar("x", 3) + RT.SetVar("y", 4) + + RT.GetVar(5, "x") ], + 5) + + return Expect.equal actual expected "" + } +let letTupleNested = + testTask "let (a, (b, c)) = (1, (2, 3)) in b" { + let actual = PT2RT.Expr.toRT 0 E.letTupleNested + + let expected = + (10, + [ // reserve 0 for outer tuple + RT.LoadVal(1, RT.DInt64 1L) + // reserve 2 for inner tuple + RT.LoadVal(3, RT.DInt64 2L) + RT.LoadVal(4, RT.DInt64 3L) + RT.CreateTuple(2, 3, 4, []) // create inner tuple + RT.CreateTuple(0, 1, 2, []) // create outer tuple + RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items + RT.SetVar("a", 5) + RT.ExtractTupleItems(6, 7, 8, []) + RT.SetVar("b", 7) + RT.SetVar("c", 8) + RT.GetVar(9, "b") ], + 9) + + return Expect.equal actual expected "" + } + let boolList = testTask "[true, false, true]" { let actual = PT2RT.Expr.toRT 0 E.boolList @@ -419,7 +494,9 @@ let tests = "PT2RT" [ one onePlusTwo - defineAndUseVar + letSimple + letTuple + letTupleNested boolList boolListList simpleString From ed141e76538f95ff66d3eb6f796c8b1549e6d094 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 15 Aug 2024 12:13:33 -0400 Subject: [PATCH 13/60] Handle match in new interpreter --- backend/src/BuiltinExecution/Builtin.fs | 3 +- .../BuiltinExecution/BuiltinExecution.fsproj | 2 +- backend/src/BuiltinExecution/Libs/Int64.fs | 69 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 760 +++++++------- backend/src/LibExecution/DvalReprDeveloper.fs | 28 +- backend/src/LibExecution/Interpreter.fs | 100 ++ backend/src/LibExecution/ProgramTypes.fs | 67 +- .../ProgramTypesToRuntimeTypes.fs | 204 +++- backend/src/LibExecution/RuntimeTypes.fs | 72 +- backend/src/LibExecution/TypeChecker.fs | 24 +- backend/src/Prelude/NEList.fs | 4 +- backend/tests/TestUtils/PTShortcuts.fs | 31 +- backend/tests/Tests/Interpreter.Tests.fs | 220 ++-- backend/tests/Tests/PT2RT.Tests.fs | 942 ++++++++++-------- tree-sitter-darklang/package-lock.json | 1 - 15 files changed, 1475 insertions(+), 1052 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 60393bd116..2bd9ffb11e 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -12,8 +12,7 @@ let fnRenames = let builtins : Builtins = Builtin.combine - [ - // Libs.NoModule.builtins + [ Libs.NoModule.builtins // Libs.Bool.builtins diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 030889865d..c079e05a3c 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -10,7 +10,7 @@ - + diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 8bea7b896e..5909d9a8f1 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -38,43 +38,42 @@ module PackageIDs = LibExecution.PackageIDs let fns : List = - [ - // { name = fn "int64Mod" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TInt64 - // description = - // "Returns the result of wrapping around so that {{0 <= res < b}}. + [ { name = fn "int64Mod" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TInt64 + description = + "Returns the result of wrapping around so that {{0 <= res < b}}. - // The modulus must be greater than 0. + The modulus must be greater than 0. - // Use if you want the remainder after division, which has - // a different behavior for negative numbers." - // fn = - // (function - // | state, _, [ DInt64 v; DInt64 m ] -> - // if m = 0L then - // IntRuntimeError.Error.ZeroModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else if m < 0L then - // IntRuntimeError.Error.NegativeModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - // let result = v % m - // let result = if result < 0L then m + result else result - // Ply(DInt64(result)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "%" - // previewable = Pure - // // TODO: Deprecate this when we can version infix operators - // // and when infix operators support Result return types - // // (https://github.com/darklang/dark/issues/4267) - // // The current function returns an RTE (it used to rollbar) on negative `b`. - // deprecated = NotDeprecated } + Use if you want the remainder after division, which has + a different behavior for negative numbers." + fn = + (function + | _state, _, _, [ DInt64 v; DInt64 m ] -> + // if m = 0L then + // IntRuntimeError.Error.ZeroModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else if m < 0L then + // IntRuntimeError.Error.NegativeModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + let result = v % m + let result = if result < 0L then m + result else result + Ply(DInt64(result)) + | _ -> incorrectArgs ()) + //sqlSpec = SqlBinOp "%" + previewable = Pure + // TODO: Deprecate this when we can version infix operators + // and when infix operators support Result return types + // (https://github.com/darklang/dark/issues/4267) + // The current function returns an RTE (it used to rollbar) on negative `b`. + deprecated = NotDeprecated } // See above for when to uncomment this diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 3a4aee18eb..08c8104167 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -12,314 +12,325 @@ module Dval = LibExecution.Dval let rec equals (a : Dval) (b : Dval) : bool = match a, b with - | DInt64 a, DInt64 b -> a = b - | DUInt64 a, DUInt64 b -> a = b + | DUnit, DUnit -> true + + | DBool a, DBool b -> a = b + | DInt8 a, DInt8 b -> a = b | DUInt8 a, DUInt8 b -> a = b | DInt16 a, DInt16 b -> a = b | DUInt16 a, DUInt16 b -> a = b | DInt32 a, DInt32 b -> a = b | DUInt32 a, DUInt32 b -> a = b + | DInt64 a, DInt64 b -> a = b + | DUInt64 a, DUInt64 b -> a = b | DInt128 a, DInt128 b -> a = b | DUInt128 a, DUInt128 b -> a = b + | DFloat a, DFloat b -> a = b - | DBool a, DBool b -> a = b - | DUnit, DUnit -> true - | DString a, DString b -> a = b + | DChar a, DChar b -> a = b + | DString a, DString b -> a = b + + | DDateTime a, DDateTime b -> a = b + + | DUuid a, DUuid b -> a = b + | DList(typA, a), DList(typB, b) -> Result.isOk (ValueType.merge typA typB) && a.Length = b.Length && List.forall2 equals a b + | DTuple(a1, a2, a3), DTuple(b1, b2, b3) -> if a3.Length <> b3.Length then // special case - this is a type error raiseUntargetedString "tuples must be the same length" else equals a1 b1 && equals a2 b2 && List.forall2 equals a3 b3 + | DDict(_vtTODO1, a), DDict(_vtTODO2, b) -> Map.count a = Map.count b && Map.forall (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) a - | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> - tn1 = tn2 // these should be the fully resolved type - && Map.count a = Map.count b - && Map.forall - (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) - a + + // | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> + // tn1 = tn2 // these should be the fully resolved type + // && Map.count a = Map.count b + // && Map.forall + // (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) + // a | DFnVal a, DFnVal b -> match a, b with - | Lambda a, Lambda b -> equalsLambdaImpl a b + // | Lambda a, Lambda b -> equalsLambdaImpl a b | NamedFn a, NamedFn b -> a = b - | Lambda _, _ - | NamedFn _, _ -> false - | DDateTime a, DDateTime b -> a = b - | DUuid a, DUuid b -> a = b - | DDB a, DDB b -> a = b - | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type - a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 equals a3 b3 + // | Lambda _, _ + //| NamedFn _, _ -> false + // | DDB a, DDB b -> a = b + // | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type + // a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 equals a3 b3 // exhaustiveness check - | DInt64 _, _ - | DUInt64 _, _ + | DUnit, _ + | DBool _, _ | DInt8 _, _ | DUInt8 _, _ | DInt16 _, _ | DUInt16 _, _ | DInt32 _, _ | DUInt32 _, _ + | DInt64 _, _ + | DUInt64 _, _ | DInt128 _, _ | DUInt128 _, _ | DFloat _, _ - | DBool _, _ - | DUnit, _ | DString _, _ | DChar _, _ | DList _, _ | DTuple _, _ | DDict _, _ - | DRecord _, _ + //| DRecord _, _ | DFnVal _, _ | DDateTime _, _ | DUuid _, _ - | DDB _, _ - | DEnum _, _ -> raiseUntargetedString "Both values must be the same type" - -and equalsLambdaImpl (impl1 : LambdaImpl) (impl2 : LambdaImpl) : bool = - // TODO what to do for TypeSymbolTable - NEList.length impl1.parameters = NEList.length impl2.parameters - && NEList.forall2 - (fun p1 p2 -> equalsLetPattern p1 p2) - impl1.parameters - impl2.parameters - && equalsSymtable impl1.symtable impl2.symtable - && equalsExpr impl1.body impl2.body - -and equalsSymtable (a : Symtable) (b : Symtable) : bool = - Map.count a = Map.count b - && Map.forall - (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) - a - -and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = - match expr1, expr2 with - | EInt64(_, int1), EInt64(_, int2) -> int1 = int2 - | EUInt64(_, int1), EUInt64(_, int2) -> int1 = int2 - | EInt8(_, int1), EInt8(_, int2) -> int1 = int2 - | EUInt8(_, int1), EUInt8(_, int2) -> int1 = int2 - | EInt16(_, int1), EInt16(_, int2) -> int1 = int2 - | EUInt16(_, int1), EUInt16(_, int2) -> int1 = int2 - | EInt32(_, int1), EInt32(_, int2) -> int1 = int2 - | EUInt32(_, int1), EUInt32(_, int2) -> int1 = int2 - | EInt128(_, int1), EInt128(_, int2) -> int1 = int2 - | EUInt128(_, int1), EUInt128(_, int2) -> int1 = int2 - | EBool(_, bool1), EBool(_, bool2) -> bool1 = bool2 - | EString(_, segments1), EString(_, segments2) -> - equalsStringSegments segments1 segments2 - | EChar(_, char1), EChar(_, char2) -> char1 = char2 - | EFloat(_, float1), EFloat(_, float2) -> float1 = float2 - | EUnit _, EUnit _ -> true - | EConstant(_, name1), EConstant(_, name2) -> name1 = name2 - | ELet(_, pattern1, expr1, body1), ELet(_, pattern2, expr2, body2) -> - equalsLetPattern pattern1 pattern2 - && equalsExpr expr1 expr2 - && equalsExpr body1 body2 - | EIf(_, cond1, then1, else1), EIf(_, cond2, then2, else2) -> - let equalsElseExpr else1 else2 = - match else1, else2 with - | Some else1, Some else2 -> equalsExpr else1 else2 - | None, None -> true - | _, _ -> false - equalsExpr cond1 cond2 && equalsExpr then1 then2 && equalsElseExpr else1 else2 - - | ELambda(_, pats1, body1), ELambda(_, pats2, body2) -> - NEList.length pats1 = NEList.length pats2 - && NEList.forall2 (fun p1 p2 -> equalsLetPattern p1 p2) pats1 pats2 - && equalsExpr body1 body2 - | ERecordFieldAccess(_, target1, fieldName1), - ERecordFieldAccess(_, target2, fieldName2) -> - equalsExpr target1 target2 && fieldName1 = fieldName2 - | EVariable(_, name1), EVariable(_, name2) -> name1 = name2 - | EApply(_, name1, typeArgs1, args1), EApply(_, name2, typeArgs2, args2) -> - equalsExpr name1 name2 - && List.forall2 (=) typeArgs1 typeArgs2 - && NEList.forall2 equalsExpr args1 args2 - | EFnName(_, name1), EFnName(_, name2) -> name1 = name2 - | EList(_, elems1), EList(_, elems2) -> - elems1.Length = elems2.Length && List.forall2 equalsExpr elems1 elems2 - | ETuple(_, elem1_1, elem2_1, elems1), ETuple(_, elem1_2, elem2_2, elems2) -> - equalsExpr elem1_1 elem1_2 - && equalsExpr elem2_1 elem2_2 - && elems1.Length = elems2.Length - && List.forall2 equalsExpr elems1 elems2 - | ERecord(_, typeName, fields1), ERecord(_, typeName', fields2) -> - typeName = typeName' - && NEList.length fields1 = NEList.length fields2 - && NEList.forall2 - (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) - fields1 - fields2 - | ERecordUpdate(_, record1, updates1), ERecordUpdate(_, record2, updates2) -> - record1 = record2 - && NEList.length updates1 = NEList.length updates2 - && NEList.forall2 - (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) - updates1 - updates2 - | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> - typeName = typeName' - && caseName = caseName' - && fields.Length = fields'.Length - && List.forall2 equalsExpr fields fields' - | EMatch(_, target1, cases1), EMatch(_, target2, cases2) -> - equalsExpr target1 target2 - && NEList.length cases1 = NEList.length cases2 - && NEList.forall2 - (fun case1 case2 -> - let equalsWhenCondition when1 when2 = - match when1, when2 with - | Some when1, Some when2 -> equalsExpr when1 when2 - | None, None -> true - | _, _ -> false - equalsMatchPattern case1.pat case2.pat - && equalsWhenCondition case1.whenCondition case2.whenCondition - && equalsExpr case1.rhs case2.rhs) - cases1 - cases2 - | EAnd(_, lhs1, rhs1), EAnd(_, lhs2, rhs2) -> - equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 - | EOr(_, lhs1, rhs1), EOr(_, lhs2, rhs2) -> - equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 - | EDict(_, fields1), EDict(_, fields2) -> - fields1.Length = fields2.Length - && List.forall2 - (fun (k1, v1) (k2, v2) -> k1 = k2 && equalsExpr v1 v2) - fields1 - fields2 - | EError(_, msg, exprs), EError(_, msg2, exprs2) -> - msg = msg2 && List.forall2 equalsExpr exprs exprs2 - - // exhaustiveness check - | EInt64 _, _ - | EUInt64 _, _ - | EInt8 _, _ - | EUInt8 _, _ - | EInt16 _, _ - | EUInt16 _, _ - | EInt32 _, _ - | EUInt32 _, _ - | EInt128 _, _ - | EUInt128 _, _ - | EBool _, _ - | EString _, _ - | EChar _, _ - | EFloat _, _ - | EUnit _, _ - | EConstant _, _ - | ELet _, _ - | EIf _, _ - | ELambda _, _ - | ERecordFieldAccess _, _ - | EVariable _, _ - | EApply _, _ - | EFnName _, _ - | EList _, _ - | ETuple _, _ - | ERecord _, _ - | ERecordUpdate _, _ - | EEnum _, _ - | EMatch _, _ - | EAnd _, _ - | EOr _, _ - | EDict _, _ - | EEnum _, _ - | EError _, _ -> false - - -and equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : bool = - match pattern1, pattern2 with - | LPVariable(_, name1), LPVariable(_, name2) -> name1 = name2 - | LPUnit _, LPUnit _ -> true - - | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> - let all = first :: second :: theRest - let all' = first' :: second' :: theRest' - all.Length = all'.Length && List.forall2 equalsLetPattern all all' - - | LPTuple _, _ - | LPUnit _, _ - | LPVariable _, _ -> false - -and equalsStringSegments - (segments1 : List) - (segments2 : List) - : bool = - segments1.Length = segments2.Length - && List.forall2 equalsStringSegment segments1 segments2 - -and equalsStringSegment - (segment1 : StringSegment) - (segment2 : StringSegment) - : bool = - match segment1, segment2 with - | StringText text1, StringText text2 -> text1 = text2 - | StringInterpolation expr1, StringInterpolation expr2 -> equalsExpr expr1 expr2 - // exhaustiveness check - | StringText _, _ - | StringInterpolation _, _ -> false - -and equalsMatchPattern (pattern1 : MatchPattern) (pattern2 : MatchPattern) : bool = - match pattern1, pattern2 with - | MPVariable(_, name1), MPVariable(_, name2) -> name1 = name2 - | MPEnum(_, tag1, args1), MPEnum(_, tag2, args2) -> - tag1 = tag2 - && args1.Length = args2.Length - && List.forall2 equalsMatchPattern args1 args2 - | MPInt64(_, int1), MPInt64(_, int2) -> int1 = int2 - | MPUInt64(_, int1), MPUInt64(_, int2) -> int1 = int2 - | MPInt8(_, int1), MPInt8(_, int2) -> int1 = int2 - | MPUInt8(_, int1), MPUInt8(_, int2) -> int1 = int2 - | MPInt16(_, int1), MPInt16(_, int2) -> int1 = int2 - | MPUInt16(_, int1), MPUInt16(_, int2) -> int1 = int2 - | MPInt32(_, int1), MPInt32(_, int2) -> int1 = int2 - | MPUInt32(_, int1), MPUInt32(_, int2) -> int1 = int2 - | MPInt128(_, int1), MPInt128(_, int2) -> int1 = int2 - | MPUInt128(_, int1), MPUInt128(_, int2) -> int1 = int2 - | MPBool(_, bool1), MPBool(_, bool2) -> bool1 = bool2 - | MPChar(_, char1), MPChar(_, char2) -> char1 = char2 - | MPString(_, str1), MPString(_, str2) -> str1 = str2 - | MPFloat(_, float1), MPFloat(_, float2) -> float1 = float2 - | MPUnit _, MPUnit _ -> true - | MPTuple(_, elem1_1, elem2_1, elems1), MPTuple(_, elem1_2, elem2_2, elems2) -> - equalsMatchPattern elem1_1 elem1_2 - && equalsMatchPattern elem2_1 elem2_2 - && elems1.Length = elems2.Length - && List.forall2 equalsMatchPattern elems1 elems2 - | MPList(_, elems1), MPList(_, elems2) -> - elems1.Length = elems2.Length && List.forall2 equalsMatchPattern elems1 elems2 - | MPListCons(_, head, tail), MPListCons(_, head', tail') -> - equalsMatchPattern head head' && equalsMatchPattern tail tail' - // exhaustiveness check - | MPVariable _, _ - | MPEnum _, _ - | MPInt64 _, _ - | MPUInt64 _, _ - | MPInt8 _, _ - | MPUInt8 _, _ - | MPInt16 _, _ - | MPUInt16 _, _ - | MPInt32 _, _ - | MPUInt32 _, _ - | MPInt128 _, _ - | MPUInt128 _, _ - | MPBool _, _ - | MPChar _, _ - | MPString _, _ - | MPFloat _, _ - | MPUnit _, _ - | MPTuple _, _ - | MPListCons _, _ - | MPList _, _ -> false + // | DDB _, _ + // | DEnum _, _ + -> raiseUntargetedString "Both values must be the same type" + +// and equalsLambdaImpl (impl1 : LambdaImpl) (impl2 : LambdaImpl) : bool = +// // TODO what to do for TypeSymbolTable +// NEList.length impl1.parameters = NEList.length impl2.parameters +// && NEList.forall2 +// (fun p1 p2 -> equalsLetPattern p1 p2) +// impl1.parameters +// impl2.parameters +// && equalsSymtable impl1.symtable impl2.symtable +// && equalsExpr impl1.body impl2.body + +// and equalsSymtable (a : Symtable) (b : Symtable) : bool = +// Map.count a = Map.count b +// && Map.forall +// (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) +// a + +// and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = +// match expr1, expr2 with +// | EInt64(_, int1), EInt64(_, int2) -> int1 = int2 +// | EUInt64(_, int1), EUInt64(_, int2) -> int1 = int2 +// | EInt8(_, int1), EInt8(_, int2) -> int1 = int2 +// | EUInt8(_, int1), EUInt8(_, int2) -> int1 = int2 +// | EInt16(_, int1), EInt16(_, int2) -> int1 = int2 +// | EUInt16(_, int1), EUInt16(_, int2) -> int1 = int2 +// | EInt32(_, int1), EInt32(_, int2) -> int1 = int2 +// | EUInt32(_, int1), EUInt32(_, int2) -> int1 = int2 +// | EInt128(_, int1), EInt128(_, int2) -> int1 = int2 +// | EUInt128(_, int1), EUInt128(_, int2) -> int1 = int2 +// | EBool(_, bool1), EBool(_, bool2) -> bool1 = bool2 +// | EString(_, segments1), EString(_, segments2) -> +// equalsStringSegments segments1 segments2 +// | EChar(_, char1), EChar(_, char2) -> char1 = char2 +// | EFloat(_, float1), EFloat(_, float2) -> float1 = float2 +// | EUnit _, EUnit _ -> true +// | EConstant(_, name1), EConstant(_, name2) -> name1 = name2 +// | ELet(_, pattern1, expr1, body1), ELet(_, pattern2, expr2, body2) -> +// equalsLetPattern pattern1 pattern2 +// && equalsExpr expr1 expr2 +// && equalsExpr body1 body2 +// | EIf(_, cond1, then1, else1), EIf(_, cond2, then2, else2) -> +// let equalsElseExpr else1 else2 = +// match else1, else2 with +// | Some else1, Some else2 -> equalsExpr else1 else2 +// | None, None -> true +// | _, _ -> false +// equalsExpr cond1 cond2 && equalsExpr then1 then2 && equalsElseExpr else1 else2 + +// // | ELambda(_, pats1, body1), ELambda(_, pats2, body2) -> +// // NEList.length pats1 = NEList.length pats2 +// // && NEList.forall2 (fun p1 p2 -> equalsLetPattern p1 p2) pats1 pats2 +// // && equalsExpr body1 body2 +// // | ERecordFieldAccess(_, target1, fieldName1), +// // ERecordFieldAccess(_, target2, fieldName2) -> +// // equalsExpr target1 target2 && fieldName1 = fieldName2 +// | EVariable(_, name1), EVariable(_, name2) -> name1 = name2 +// | EApply(_, name1, typeArgs1, args1), EApply(_, name2, typeArgs2, args2) -> +// equalsExpr name1 name2 +// && List.forall2 (=) typeArgs1 typeArgs2 +// && NEList.forall2 equalsExpr args1 args2 +// | EFnName(_, name1), EFnName(_, name2) -> name1 = name2 +// | EList(_, elems1), EList(_, elems2) -> +// elems1.Length = elems2.Length && List.forall2 equalsExpr elems1 elems2 +// | ETuple(_, elem1_1, elem2_1, elems1), ETuple(_, elem1_2, elem2_2, elems2) -> +// equalsExpr elem1_1 elem1_2 +// && equalsExpr elem2_1 elem2_2 +// && elems1.Length = elems2.Length +// && List.forall2 equalsExpr elems1 elems2 +// // | ERecord(_, typeName, fields1), ERecord(_, typeName', fields2) -> +// // typeName = typeName' +// // && NEList.length fields1 = NEList.length fields2 +// // && NEList.forall2 +// // (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) +// // fields1 +// // fields2 +// // | ERecordUpdate(_, record1, updates1), ERecordUpdate(_, record2, updates2) -> +// // record1 = record2 +// // && NEList.length updates1 = NEList.length updates2 +// // && NEList.forall2 +// // (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) +// // updates1 +// // updates2 +// // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> +// // typeName = typeName' +// // && caseName = caseName' +// // && fields.Length = fields'.Length +// // && List.forall2 equalsExpr fields fields' +// | EMatch(_, target1, cases1), EMatch(_, target2, cases2) -> +// equalsExpr target1 target2 +// && NEList.length cases1 = NEList.length cases2 +// && NEList.forall2 +// (fun case1 case2 -> +// let equalsWhenCondition when1 when2 = +// match when1, when2 with +// | Some when1, Some when2 -> equalsExpr when1 when2 +// | None, None -> true +// | _, _ -> false +// equalsMatchPattern case1.pat case2.pat +// && equalsWhenCondition case1.whenCondition case2.whenCondition +// && equalsExpr case1.rhs case2.rhs) +// cases1 +// cases2 +// | EAnd(_, lhs1, rhs1), EAnd(_, lhs2, rhs2) -> +// equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 +// | EOr(_, lhs1, rhs1), EOr(_, lhs2, rhs2) -> +// equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 +// | EDict(_, fields1), EDict(_, fields2) -> +// fields1.Length = fields2.Length +// && List.forall2 +// (fun (k1, v1) (k2, v2) -> k1 = k2 && equalsExpr v1 v2) +// fields1 +// fields2 +// | EError(_, msg, exprs), EError(_, msg2, exprs2) -> +// msg = msg2 && List.forall2 equalsExpr exprs exprs2 + +// // exhaustiveness check +// | EInt64 _, _ +// | EUInt64 _, _ +// | EInt8 _, _ +// | EUInt8 _, _ +// | EInt16 _, _ +// | EUInt16 _, _ +// | EInt32 _, _ +// | EUInt32 _, _ +// | EInt128 _, _ +// | EUInt128 _, _ +// | EBool _, _ +// | EString _, _ +// | EChar _, _ +// | EFloat _, _ +// | EUnit _, _ +// // | EConstant _, _ +// | ELet _, _ +// | EIf _, _ +// // | ELambda _, _ +// // | ERecordFieldAccess _, _ +// | EVariable _, _ +// | EApply _, _ +// | EFnName _, _ +// | EList _, _ +// | ETuple _, _ +// // | ERecord _, _ +// // | ERecordUpdate _, _ +// // | EEnum _, _ +// | EMatch _, _ +// | EAnd _, _ +// | EOr _, _ +// | EDict _, _ +// // | EEnum _, _ +// | EError _, _ -> false + + +// and equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : bool = +// match pattern1, pattern2 with +// | LPVariable(_, name1), LPVariable(_, name2) -> name1 = name2 +// | LPUnit _, LPUnit _ -> true + +// | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> +// let all = first :: second :: theRest +// let all' = first' :: second' :: theRest' +// all.Length = all'.Length && List.forall2 equalsLetPattern all all' + +// | LPTuple _, _ +// | LPUnit _, _ +// | LPVariable _, _ -> false + +// and equalsStringSegments +// (segments1 : List) +// (segments2 : List) +// : bool = +// segments1.Length = segments2.Length +// && List.forall2 equalsStringSegment segments1 segments2 + +// and equalsStringSegment +// (segment1 : StringSegment) +// (segment2 : StringSegment) +// : bool = +// match segment1, segment2 with +// | StringText text1, StringText text2 -> text1 = text2 +// | StringInterpolation expr1, StringInterpolation expr2 -> equalsExpr expr1 expr2 +// // exhaustiveness check +// | StringText _, _ +// | StringInterpolation _, _ -> false + +// and equalsMatchPattern (pattern1 : MatchPattern) (pattern2 : MatchPattern) : bool = +// match pattern1, pattern2 with +// | MPVariable(_, name1), MPVariable(_, name2) -> name1 = name2 +// // | MPEnum(_, tag1, args1), MPEnum(_, tag2, args2) -> +// // tag1 = tag2 +// // && args1.Length = args2.Length +// // && List.forall2 equalsMatchPattern args1 args2 +// | MPInt64(_, int1), MPInt64(_, int2) -> int1 = int2 +// | MPUInt64(_, int1), MPUInt64(_, int2) -> int1 = int2 +// | MPInt8(_, int1), MPInt8(_, int2) -> int1 = int2 +// | MPUInt8(_, int1), MPUInt8(_, int2) -> int1 = int2 +// | MPInt16(_, int1), MPInt16(_, int2) -> int1 = int2 +// | MPUInt16(_, int1), MPUInt16(_, int2) -> int1 = int2 +// | MPInt32(_, int1), MPInt32(_, int2) -> int1 = int2 +// | MPUInt32(_, int1), MPUInt32(_, int2) -> int1 = int2 +// | MPInt128(_, int1), MPInt128(_, int2) -> int1 = int2 +// | MPUInt128(_, int1), MPUInt128(_, int2) -> int1 = int2 +// | MPBool(_, bool1), MPBool(_, bool2) -> bool1 = bool2 +// | MPChar(_, char1), MPChar(_, char2) -> char1 = char2 +// | MPString(_, str1), MPString(_, str2) -> str1 = str2 +// | MPFloat(_, float1), MPFloat(_, float2) -> float1 = float2 +// | MPUnit _, MPUnit _ -> true +// | MPTuple(_, elem1_1, elem2_1, elems1), MPTuple(_, elem1_2, elem2_2, elems2) -> +// equalsMatchPattern elem1_1 elem1_2 +// && equalsMatchPattern elem2_1 elem2_2 +// && elems1.Length = elems2.Length +// && List.forall2 equalsMatchPattern elems1 elems2 +// | MPList(_, elems1), MPList(_, elems2) -> +// elems1.Length = elems2.Length && List.forall2 equalsMatchPattern elems1 elems2 +// | MPListCons(_, head, tail), MPListCons(_, head', tail') -> +// equalsMatchPattern head head' && equalsMatchPattern tail tail' +// // exhaustiveness check +// | MPVariable _, _ +// // | MPEnum _, _ +// | MPInt64 _, _ +// | MPUInt64 _, _ +// | MPInt8 _, _ +// | MPUInt8 _, _ +// | MPInt16 _, _ +// | MPUInt16 _, _ +// | MPInt32 _, _ +// | MPUInt32 _, _ +// | MPInt128 _, _ +// | MPUInt128 _, _ +// | MPBool _, _ +// | MPChar _, _ +// | MPString _, _ +// | MPFloat _, _ +// | MPUnit _, _ +// | MPTuple _, _ +// | MPListCons _, _ +// | MPList _, _ -> false let varA = TVariable "a" @@ -332,120 +343,121 @@ let fns : List = description = "Returns true if the two value are equal" fn = (function - | _, _, [ a; b ] -> equals a b |> DBool |> Ply + | _, _, _, [ a; b ] -> equals a b |> DBool |> Ply | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "=" - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "notEquals" 0 - typeParams = [] - parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] - returnType = TBool - description = "Returns true if the two value are not equal" - fn = - (function - | _, _, [ a; b ] -> equals a b |> not |> DBool |> Ply - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "<>" - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "unwrap" 0 - typeParams = [] - parameters = [ Param.make "value" (TVariable "optOrRes") "" ] - returnType = TVariable "a" - description = - "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" - fn = - (function - | _, _, [] -> incorrectArgs () - | _, _, [ dval ] -> - match dval with - - // success: extract `Some` out of an Option - | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when - id = PackageIDs.Type.Stdlib.option - -> - Ply value - - // success: extract `Ok` out of a Result - | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when - id = PackageIDs.Type.Stdlib.result - -> - Ply value - - // Error: expected Some, got None - | DEnum(FQTypeName.Package id, _, _, "None", []) when - id = PackageIDs.Type.Stdlib.option - -> - "expected Some, got None" |> RuntimeError.oldError |> raiseUntargetedRTE - - // Error: expected Ok, got Error - | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when - id = PackageIDs.Type.Stdlib.result - -> - $"expected Ok, got Error:\n{value |> DvalReprDeveloper.toRepr}" - |> RuntimeError.oldError - |> raiseUntargetedRTE - - - // Error: single dval, but not an Option or Result - | otherDval -> - $"Unwrap called with non-Option/non-Result {otherDval}" - |> RuntimeError.oldError - |> raiseUntargetedRTE - - | _, _, multipleArgs -> - $"unwrap called with multiple arguments: {multipleArgs}" - |> RuntimeError.oldError - |> raiseUntargetedRTE) - - sqlSpec = NotQueryable + //sqlSpec = SqlBinOp "=" previewable = Pure deprecated = NotDeprecated } - { name = fn "debug" 0 - typeParams = [] - parameters = - [ Param.make "label" TString "The label to be printed." - Param.make "value" (TVariable "a") "The value to be printed." ] - returnType = TUnit - description = "Prints the given to the standard output" - fn = - (function - | _, _, [ DString label; value ] -> - // TODO: call upon the Dark equivalent fn instead of rlying on DvalReprDeveloper - print $"DEBUG: {label} - {DvalReprDeveloper.toRepr value}" - Ply DUnit - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } - - - { name = fn "debugSymbolTable" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = TUnit - description = "Prints the current symbol table to the standard output" - fn = - (function - | state, _, [ DUnit ] -> - state.symbolTable - |> Map.toList - |> List.map (fun (key, dv) -> $"- {key}: {DvalReprDeveloper.toRepr dv}") - |> String.concat "\n" - |> fun lines -> print $"DEBUG: symTable\n{lines}" - - Ply DUnit - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } ] - - -let builtins = LibExecution.Builtin.make [] fns + // { name = fn "notEquals" 0 + // typeParams = [] + // parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] + // returnType = TBool + // description = "Returns true if the two value are not equal" + // fn = + // (function + // | _, _, [ a; b ] -> equals a b |> not |> DBool |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "<>" + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "unwrap" 0 + // typeParams = [] + // parameters = [ Param.make "value" (TVariable "optOrRes") "" ] + // returnType = TVariable "a" + // description = + // "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" + // fn = + // (function + // | _, _, [] -> incorrectArgs () + // | _, _, [ dval ] -> + // match dval with + + // // success: extract `Some` out of an Option + // | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when + // id = PackageIDs.Type.Stdlib.option + // -> + // Ply value + + // // success: extract `Ok` out of a Result + // | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when + // id = PackageIDs.Type.Stdlib.result + // -> + // Ply value + + // // Error: expected Some, got None + // | DEnum(FQTypeName.Package id, _, _, "None", []) when + // id = PackageIDs.Type.Stdlib.option + // -> + // "expected Some, got None" |> RuntimeError.oldError |> raiseUntargetedRTE + + // // Error: expected Ok, got Error + // | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when + // id = PackageIDs.Type.Stdlib.result + // -> + // $"expected Ok, got Error:\n{value |> DvalReprDeveloper.toRepr}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE + + + // // Error: single dval, but not an Option or Result + // | otherDval -> + // $"Unwrap called with non-Option/non-Result {otherDval}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE + + // | _, _, multipleArgs -> + // $"unwrap called with multiple arguments: {multipleArgs}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE) + + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "debug" 0 + // typeParams = [] + // parameters = + // [ Param.make "label" TString "The label to be printed." + // Param.make "value" (TVariable "a") "The value to be printed." ] + // returnType = TUnit + // description = "Prints the given to the standard output" + // fn = + // (function + // | _, _, [ DString label; value ] -> + // // TODO: call upon the Dark equivalent fn instead of rlying on DvalReprDeveloper + // print $"DEBUG: {label} - {DvalReprDeveloper.toRepr value}" + // Ply DUnit + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + + + // { name = fn "debugSymbolTable" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TUnit + // description = "Prints the current symbol table to the standard output" + // fn = + // (function + // | state, _, [ DUnit ] -> + // state.symbolTable + // |> Map.toList + // |> List.map (fun (key, dv) -> $"- {key}: {DvalReprDeveloper.toRepr dv}") + // |> String.concat "\n" + // |> fun lines -> print $"DEBUG: symTable\n{lines}" + + // Ply DUnit + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + ] + + +let builtins = LibExecution.Builtin.make fns diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index bf45127442..9107e735fa 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -36,20 +36,20 @@ let rec typeName (t : TypeReference) : string = | TFn _ -> "Function" -// | TCustomType(Error _nre, _) -> "(Error during function resolution)" -// | TCustomType(Ok t, typeArgs) -> -// let typeArgsPortion = -// match typeArgs with -// | [] -> "" -// | args -> -// args -// |> List.map (fun t -> typeName t) -// |> String.concat ", " -// |> fun betweenBrackets -> "<" + betweenBrackets + ">" -// FQTypeName.toString t + typeArgsPortion - -// | TDB _ -> "Datastore" -// | TVariable varname -> $"'{varname}" + // | TCustomType(Error _nre, _) -> "(Error during function resolution)" + // | TCustomType(Ok t, typeArgs) -> + // let typeArgsPortion = + // match typeArgs with + // | [] -> "" + // | args -> + // args + // |> List.map (fun t -> typeName t) + // |> String.concat ", " + // |> fun betweenBrackets -> "<" + betweenBrackets + ">" + // FQTypeName.toString t + typeArgsPortion + + // | TDB _ -> "Datastore" + | TVariable varname -> $"'{varname}" let rec private knownTypeName (vt : KnownType) : string = diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index c42081d34a..f91b038372 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -23,6 +23,7 @@ let rec execute : Ply = uply { let instructions = vmState.instructions + if counter >= instructions.Length then // is this OK? return vmState.registers[vmState.resultReg] @@ -62,6 +63,7 @@ let rec execute | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> // should we instead pass in register indices? probably... let args = argRegs |> NEList.map (fun r -> vmState.registers[r]) + //debuG "args" (NEList.length args) let thingToCall = vmState.registers[thingToCallReg] let! result = call exeState vmState thingToCall typeArgs args @@ -120,6 +122,103 @@ let rec execute vmState.registers[copyTo] <- vmState.registers[copyFrom] return! execute exeState vmState (counter + 1) + | MatchValue(valueReg, pat, failJump) -> + let rec matchPattern pat dv = + match pat, dv with + | MPVariable name, dv -> true, [ (name, dv) ] + + | MPUnit, DUnit -> true, [] + + | MPBool l, DBool r -> l = r, [] + + | MPInt8 l, DInt8 r -> l = r, [] + | MPUInt8 l, DUInt8 r -> l = r, [] + | MPInt16 l, DInt16 r -> l = r, [] + | MPUInt16 l, DUInt16 r -> l = r, [] + | MPInt32 l, DInt32 r -> l = r, [] + | MPUInt32 l, DUInt32 r -> l = r, [] + | MPInt64 l, DInt64 r -> l = r, [] + | MPUInt64 l, DUInt64 r -> l = r, [] + | MPInt128 l, DInt128 r -> l = r, [] + | MPUInt128 l, DUInt128 r -> l = r, [] + + | MPFloat l, DFloat r -> l = r, [] + + | MPChar l, DChar r -> l = r, [] + | MPString l, DString r -> l = r, [] + + | MPList pats, DList(_, items) -> + let rec matchList pats items = + match pats, items with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | pat :: otherPats, item :: items -> + let matches, vars = matchPattern pat item + if matches then + let matchesRest, varsRest = matchList otherPats items + if matchesRest then true, vars @ varsRest else false, [] + else + false, [] + matchList pats items + + | MPListCons(head, tail), DList(vt, items) -> + match items with + | [] -> false, [] + | headItem :: tailItems -> + let matchesHead, varsHead = matchPattern head headItem + if matchesHead then + let matchesTail, varsTail = matchPattern tail (DList(vt, tailItems)) + if matchesTail then true, varsHead @ varsTail else false, [] + else + false, [] + + | MPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> + // CLEANUP can probably be tidier + let matchesFirst, varsFirst = matchPattern first firstVal + if matchesFirst then + let matchesSecond, varsSecond = matchPattern second secondVal + if matchesSecond then + let rec matchRest pats vals = + match pats, vals with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | thirdPat :: otherPats, firstVal :: otherVals -> + let matches, vars = matchPattern thirdPat firstVal + if matches then + let matchesRest, varsRest = matchRest otherPats otherVals + if matchesRest then + true, varsFirst @ varsSecond @ vars @ varsRest + else + false, [] + else + false, [] + matchRest theRest theRestVal + else + false, [] + else + false, [] + + | _ -> false, [] + + + let matches, vars = matchPattern pat vmState.registers[valueReg] + + if matches then + let vmState = + vars + |> List.fold + (fun vmState (varName, value) -> + { vmState with + symbolTable = Map.add varName value vmState.symbolTable }) + vmState + return! execute exeState vmState (counter + 1) + else + return! execute exeState vmState (counter + failJump + 1) + + + | ExtractTupleItems(extractFrom, firstReg, secondReg, restRegs) -> match vmState.registers[extractFrom] with | DTuple(first, second, rest) -> @@ -133,6 +232,7 @@ let rec execute | _ -> return DString "Error: Expected a tuple for decomposition" | Fail _rte -> return DUnit // TODO + | MatchUnmatched -> return DUnit // TODO } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index cec0dffedd..24045c2b83 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -124,35 +124,35 @@ type LetPattern = theRest : List | LPVariable of id * name : string -// /// Used for pattern matching in a match statement -// type MatchPattern = -// | MPUnit of id +/// Used for pattern matching in a match statement +type MatchPattern = + | MPUnit of id -// | MPBool of id * bool + | MPBool of id * bool -// | MPInt8 of id * int8 -// | MPUInt8 of id * uint8 -// | MPInt16 of id * int16 -// | MPUInt16 of id * uint16 -// | MPInt32 of id * int32 -// | MPUInt32 of id * uint32 -// | MPInt64 of id * int64 -// | MPUInt64 of id * uint64 -// | MPInt128 of id * System.Int128 -// | MPUInt128 of id * System.UInt128 + | MPInt8 of id * int8 + | MPUInt8 of id * uint8 + | MPInt16 of id * int16 + | MPUInt16 of id * uint16 + | MPInt32 of id * int32 + | MPUInt32 of id * uint32 + | MPInt64 of id * int64 + | MPUInt64 of id * uint64 + | MPInt128 of id * System.Int128 + | MPUInt128 of id * System.UInt128 -// | MPFloat of id * Sign * string * string + | MPFloat of id * Sign * string * string -// | MPChar of id * string -// | MPString of id * string + | MPChar of id * string + | MPString of id * string -// | MPList of id * List -// | MPListCons of id * head : MatchPattern * tail : MatchPattern -// | MPTuple of id * MatchPattern * MatchPattern * List + | MPList of id * List + | MPListCons of id * head : MatchPattern * tail : MatchPattern + | MPTuple of id * MatchPattern * MatchPattern * List -// | MPEnum of id * caseName : string * fieldPats : List + //| MPEnum of id * caseName : string * fieldPats : List -// | MPVariable of id * string + | MPVariable of id * string type BinaryOperation = | BinOpAnd @@ -260,15 +260,15 @@ type Expr = // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List - // /// Supports `match` expressions - // /// ```fsharp - // /// match x + 2 with // arg - // /// | pattern -> expr // cases[0] - // /// | pattern -> expr - // /// | ... - // /// ``` - // // cases is a list to represent when a user starts typing but doesn't complete it - // | EMatch of id * arg : Expr * cases : List + /// Supports `match` expressions + /// ```fsharp + /// match x + 2 with // arg + /// | pattern -> expr // cases[0] + /// | pattern -> expr + /// | ... + /// ``` + // cases is a list to represent when a user starts typing but doesn't complete it + | EMatch of id * arg : Expr * cases : List // // Composed of binding pattern, the expression to create bindings for, @@ -353,7 +353,7 @@ type Expr = // NameResolution -//and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } +and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } and StringSegment = | StringText of string @@ -409,8 +409,7 @@ module Expr = // | ERecord(id, _, _) // | ERecordUpdate(id, _, _) // | EEnum(id, _, _, _) - // | EMatch(id, _, _) - -> id + | EMatch(id, _, _) -> id // module PipeExpr = // let toID (expr : PipeExpr) : id = diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index a36f01d3c1..0f6eaa369d 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -142,6 +142,9 @@ module LetPattern = | PT.LPTuple(_id, first, second, theRest) -> // reserve the first two registers + // TODO: why do we actually need registers, when we're just assigning variables? + // If RT.LetPattern were more like RT.MatchPattern, we could simply have one instruction that + // assigns the variables in one fell swoop, failing if anything doesn't deconstruct properly. let firstReg, secondReg, rc = rc, rc + 1, rc + 2 let (rcAfterFirst, firstInstrs) = toRT rc first firstReg @@ -166,39 +169,88 @@ module LetPattern = +module MatchPattern = + let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = + match p with + | PT.MPUnit _ -> RT.MPUnit + | PT.MPBool(_, b) -> RT.MPBool b -// module MatchPattern = -// let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = -// match p with -// | PT.MPVariable(id, str) -> RT.MPVariable(id, str) -// | PT.MPEnum(id, caseName, fieldPats) -> -// RT.MPEnum(id, caseName, List.map toRT fieldPats) -// | PT.MPInt64(id, i) -> RT.MPInt64(id, i) -// | PT.MPUInt64(id, i) -> RT.MPUInt64(id, i) -// | PT.MPInt8(id, i) -> RT.MPInt8(id, i) -// | PT.MPUInt8(id, i) -> RT.MPUInt8(id, i) -// | PT.MPInt16(id, i) -> RT.MPInt16(id, i) -// | PT.MPUInt16(id, i) -> RT.MPUInt16(id, i) -// | PT.MPInt32(id, i) -> RT.MPInt32(id, i) -// | PT.MPUInt32(id, i) -> RT.MPUInt32(id, i) -// | PT.MPInt128(id, i) -> RT.MPInt128(id, i) -// | PT.MPUInt128(id, i) -> RT.MPUInt128(id, i) -// | PT.MPBool(id, b) -> RT.MPBool(id, b) -// | PT.MPChar(id, c) -> RT.MPChar(id, c) -// | PT.MPString(id, s) -> RT.MPString(id, s) -// | PT.MPFloat(id, s, w, f) -> -// let w = if w = "" then "0" else w -// RT.MPFloat(id, makeFloat s w f) -// | PT.MPUnit id -> RT.MPUnit id -// | PT.MPTuple(id, first, second, theRest) -> -// RT.MPTuple(id, toRT first, toRT second, List.map toRT theRest) -// | PT.MPList(id, pats) -> RT.MPList(id, List.map toRT pats) -// | PT.MPListCons(id, head, tail) -> RT.MPListCons(id, toRT head, toRT tail) + | PT.MPInt8(_, i) -> RT.MPInt8 i + | PT.MPUInt8(_, i) -> RT.MPUInt8 i + | PT.MPInt16(_, i) -> RT.MPInt16 i + | PT.MPUInt16(_, i) -> RT.MPUInt16 i + | PT.MPInt32(_, i) -> RT.MPInt32 i + | PT.MPUInt32(_, i) -> RT.MPUInt32 i + | PT.MPInt64(_, i) -> RT.MPInt64 i + | PT.MPUInt64(_, i) -> RT.MPUInt64 i + | PT.MPInt128(_, i) -> RT.MPInt128 i + | PT.MPUInt128(_, i) -> RT.MPUInt128 i + + | PT.MPFloat(_, sign, whole, frac) -> RT.MPFloat(makeFloat sign whole frac) + + | PT.MPChar(_, c) -> RT.MPChar c + | PT.MPString(_, s) -> RT.MPString s + + | PT.MPList(_, pats) -> RT.MPList(List.map toRT pats) + | PT.MPListCons(_, head, tail) -> RT.MPListCons(toRT head, toRT tail) + + | PT.MPTuple(_, first, second, theRest) -> + RT.MPTuple(toRT first, toRT second, List.map toRT theRest) + + | PT.MPVariable(_, name) -> RT.MPVariable name + + + let toMatchInstr + (p : PT.MatchPattern) + (valueReg : RT.Register) + (jumpByFail) + : RT.Instruction = + RT.MatchValue(valueReg, toRT p, jumpByFail) + + +module MatchCase = + /// Compiling a MatchCase happens in two phases, because many instructions + /// require knowing how many instructions to jump over, which we can't know + /// until we know the basics of all the cases. + /// + /// This type holds all the information we gather as part of the first phase + /// , in order of where the instrs should be at the end of the second phase. + /// + /// Note: not represented here, we'll also need an unconditional `JumpBy` instr + /// , to get past all the cases. We can only determine how many instrs to jump + /// after the first phases is complete, but it'll land at the end of these. + type IntermediateValue = + { + /// jumpByFail -> instr + /// `RT.MatchValue(valueReg, pat, jumpByFail)` + /// (the `pat` and `valueReg` are known in the first phase) + matchValueInstrFn : int -> RT.Instruction + + /// Evaluation of the `whenCondition` (if it exists -- might be empty) + whenCondInstructions : RT.Instructions + + /// (jumpBy) -> instr + /// `RT.JumpByIfFalse(jumpBy, whenCondResultReg)` + /// (`whenCondResultReg` is known in the first phase) + whenCondJump : Option RT.Instruction> + + /// Evaluation of the RHS + /// + /// Includes `CopyVal(resultReg, rhsResultReg)` + rhsInstrs : RT.Instructions + + /// RC after all instructions + /// + /// Note: Different branches/cases will require different # of registers + /// , so we'll end up taking the max of all the RCs + rc : int + } module Expr = // CLEANUP clearly not the most efficient to do this, but probably fine for now + // TODO ok this is actually really wasteful. a single text string segment could be a single instruction let rec compileString (rc : int) (segments : List) @@ -251,6 +303,7 @@ module Expr = | PT.EString(_id, segments) -> compileString rc segments + | PT.EList(_id, items) -> let listReg = rc let init = (rc + 1, [ RT.LoadVal(listReg, RT.DList(VT.unknown, [])) ]) @@ -266,6 +319,7 @@ module Expr = (regCounter, instrs, listReg) + | PT.EDict(_id, items) -> let dictReg = rc let init = (rc + 1, [ RT.LoadVal(dictReg, RT.DDict(VT.unknown, Map.empty)) ]) @@ -281,6 +335,7 @@ module Expr = (regCounter, instrs, dictReg) + | PT.ETuple(_id, first, second, theRest) -> // save the 'first' register for the result let tupleReg, rc = rc, rc + 1 @@ -384,6 +439,7 @@ module Expr = // (which should fail when we apply it) (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) + | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> let (regCounter, thingToApplyInstrs, thingToApplyReg) = // (usually, a fn name) @@ -413,6 +469,100 @@ module Expr = (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) + | PT.EMatch(_id, expr, cases) -> + // first, the easy part - compile the expression we're `match`ing against. + let (rcAfterExpr, exprInstrs, exprResultReg) = toRT rc expr + + // Shortly, we'll compile each of the cases. + // We'll use this `resultReg` to store the final result of the match + // , so we have a consistent place to look for it. + // (similar to how we handle `EIf` -- refer to that for a simpler example) + let resultReg, rcAfterResult = rcAfterExpr, rcAfterExpr + 1 + + // We compile each `case` in two phases, because some instrs require knowing + // how many instrs to jump over, which we can't know until we know the basics + // of all the cases. + // + // See `MatchCase.IntermediateValue` for more info. + let casesAfterFirstPhase : List = + cases + |> List.map (fun c -> + // compile the `when` condition, if it exists, as much as we can + let rcAfterWhenCond, whenCondInstrs, whenCondJump = + match c.whenCondition with + | None -> (rcAfterResult, [], None) + | Some whenCond -> + let (rcAfterWhenCond, whenCondInstrs, whenCondReg) = + toRT rcAfterResult whenCond + (rcAfterWhenCond, + whenCondInstrs, + Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCondReg))) + + // compile the `rhs` of the case + let rcAfterRhs, rhsInstrs, rhsResultReg = toRT rcAfterWhenCond c.rhs + + // return the intermediate results, as far along as they are + { matchValueInstrFn = MatchPattern.toMatchInstr c.pat exprResultReg + whenCondInstructions = whenCondInstrs + whenCondJump = whenCondJump + rhsInstrs = rhsInstrs @ [ RT.CopyVal(resultReg, rhsResultReg) ] + rc = rcAfterRhs }) + + let countInstrsForCase (c : MatchCase.IntermediateValue) : int = + 1 // for the `MatchValue` instruction + + List.length c.whenCondInstructions + + (match c.whenCondJump with + | Some _ -> 1 + | None -> 0) + + List.length c.rhsInstrs + + 1 // for the `JumpBy` instruction + + let (cases, _) : List * int = + casesAfterFirstPhase + |> List.map (fun c -> + let instrCount = countInstrsForCase c + (c, instrCount)) + |> List.foldRight + // CLEANUP this works, but hurts the brain a bit. + (fun (acc, runningTotal) (c, instrCount) -> + let newTotal = runningTotal + instrCount + (acc @ [ c, runningTotal ], newTotal)) + ([], 0) + let cases = List.rev cases + + + let caseInstrs = + cases + |> List.fold + (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> + // note: `instrsAfterThisCaseUntilEndOfMatch` does not include + // the final MatchUnmatched instruction + + let caseInstrs = + [ c.matchValueInstrFn ( + countInstrsForCase c + // because we can skip over the MatchValue instr + - 1 + ) ] + @ c.whenCondInstructions + @ (match c.whenCondJump with + // jump to next case if the when condition is false + | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] + | None -> []) + @ c.rhsInstrs + @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] + + instrs @ caseInstrs) + [] + + + let instrs = exprInstrs @ caseInstrs @ [ RT.MatchUnmatched ] + + let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max + + (rcAtEnd, instrs, resultReg) + + // let rec toRT (e : PT.Expr) : RT.Instructions = // match e with // // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 4ca2e07adf..6de4c20d48 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -122,6 +122,9 @@ module FQFnName = let package (id : uuid) = id + let fqBuiltin (name : string) (version : int) : FQFnName = + Builtin { name = name; version = version } + let fqPackage (id : uuid) : FQFnName = Package id let builtinToString (s : Builtin) : string = @@ -456,7 +459,7 @@ and TypeReference = | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference // | TDB of TypeReference - // | TVariable of string + | TVariable of string // | TCustomType of // NameResolution * // typeArgs : List @@ -496,16 +499,44 @@ and TypeReference = // | TCustomType(_, ts) -> List.forall isConcrete ts | TDict t -> isConcrete t - //| TVariable _-> false + | TVariable _ -> false isConcrete this and Register = int // // TODO: unit of measure -// TODO: consider if each of these should include the Expr ID that they came from -// -// Would Expr ID be enough? -// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) +and MatchPattern = + | MPUnit + | MPBool of bool + | MPInt8 of int8 + | MPUInt8 of uint8 + | MPInt16 of int16 + | MPUInt16 of uint16 + | MPInt32 of int32 + | MPUInt32 of uint32 + | MPInt64 of int64 + | MPUInt64 of uint64 + | MPInt128 of System.Int128 + | MPUInt128 of System.UInt128 + | MPFloat of float + | MPChar of string + | MPString of string + | MPList of List + | MPListCons of head : MatchPattern * tail : MatchPattern // TODO: but the tail is a list... + | MPTuple of + first : MatchPattern * + second : MatchPattern * + theRest : List + | MPVariable of string + +/// TODO: consider if each of these should include the Expr ID that they came from +/// +/// Would Expr ID be enough? +/// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) +/// +/// We could also record the Instruction Index -> ExprID mapping _adjacent_ to RT, +/// and only load it when needed. +/// That way, the Interpreter could be lighter-weight. and Instruction = /// Push a ("constant") value into a register | LoadVal of loadTo : Register * Dval @@ -568,19 +599,30 @@ and Instruction = /// Fail if this is hit (basically "raise an exception") | Fail of RuntimeError + /// Check if the value in the noted register the noted pattern, + /// and extract vars per MPVariable as relevant. + | MatchValue of + valueReg : Register * // what we're matching against + pat : MatchPattern * + //successJump : int * + failJump : int + + /// Could not find matching case in a match expression + /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs + /// TODO maybe make this a special case of Fail + | MatchUnmatched + and Instructions = List and InstructionsWithContext = // (rc, instructions, result register) (int * Instructions * Register) + // // Expressions here are runtime variants of the AST in ProgramTypes, having had // // superfluous information removed. // and Expr = - - // // // flow control -// // | EMatch of id * Expr * NEList // // | EAnd of id * lhs : Expr * rhs : Expr // // | EOr of id * lhs : Expr * rhs : Expr @@ -588,7 +630,6 @@ and InstructionsWithContext = // // | ERecordFieldAccess of id * Expr * string // // calling fns and other things -// | EApply of id * Expr * typeArgs : List * args : NEList // //| ELambda of id * pats : NEList * body : Expr // // // working with custom types @@ -603,8 +644,6 @@ and InstructionsWithContext = // // subexpressions to evaluate before evaluating the error. // | EError of id * RuntimeError * List -// // and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } - and DvalMap = Map @@ -619,6 +658,10 @@ and DvalMap = Map // body : Expr } and FnValImpl = + // TODO: consider inlining these cases (DLambnda, DNamedBuiltinFn, DNamedPackageFn) + // maybe this includes partially-applied stuff? + // or maybe we have a separate type for that? idk. + //| Lambda of LambdaImpl | NamedFn of FQFnName.FQFnName @@ -1545,7 +1588,10 @@ and ExecutionState = and Registers = Dval array and VMState = - { instructions : Instruction array + { // /// Program counter -- what instruction index are we pointing at? + //pc: int + + instructions : Instruction array registers : Registers resultReg : Register diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index c969ac2a66..8e6ac1c0f6 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -232,10 +232,10 @@ let rec valueTypeUnifies //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV - // | TVariable name, _ -> - // match Map.get name tst with - // | None -> return true - // | Some t -> return! r t actual + | TVariable name, _ -> + match Map.get name tst with + | None -> return true + | Some t -> return! r t actual | _, _ -> return false } @@ -257,13 +257,13 @@ let rec unify // // // // Potentially needs to be removed before we use this type checker for DBs? // // - Could always have a type checking context that allows/disallows any - // | TVariable name, _ -> - // match Map.get name tst with - // // for now, allow undefined type variables. In the future, we would create a - // // type from the value and return any variables defined this way for usage in - // // further arguments and return values. - // | None -> return Ok() - // | Some t -> return! unify context types tst t value + | TVariable name, _ -> + match Map.get name tst with + // for now, allow undefined type variables. In the future, we would create a + // type from the value and return any variables defined this way for usage in + // further arguments and return values. + | None -> return Ok() + | Some t -> return! unify context types tst t value | TBool, DBool _ -> return Ok() | TUnit, DUnit -> return Ok() @@ -455,7 +455,7 @@ let rec unify // | TCustomType _, _ - // | TVariable _, _ + | TVariable _, _ | TFn _, _ // | TDB _, _ diff --git a/backend/src/Prelude/NEList.fs b/backend/src/Prelude/NEList.fs index ddcbb71615..28804c36e3 100644 --- a/backend/src/Prelude/NEList.fs +++ b/backend/src/Prelude/NEList.fs @@ -42,7 +42,9 @@ let map2 (f : 'a -> 'b -> 'c) (l1 : NEList<'a>) (l2 : NEList<'b>) : NEList<'c> = match l1, l2 with | [], [] -> [] | [], _ - | _, [] -> Exception.raiseInternal "NEList.map2: lists have different lengths" [] + | _, [] -> + System.Console.WriteLine((l1, l2)) + Exception.raiseInternal "NEList.map2: lists have different lengths" [] | x1 :: xs1, x2 :: xs2 -> f x1 x2 :: loop xs1 xs2 { head = f l1.head l2.head; tail = loop l1.tail l2.tail } diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index e85ac0d049..35603a5d74 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -23,15 +23,35 @@ let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = EFloat(gid (), sign, whole, fraction) let eChar (c : string) : Expr = EChar(gid (), c) -let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) - - +let strText (str : string) : StringSegment = StringText str +let strInterp (expr : Expr) : StringSegment = StringInterpolation expr +let eStr (segments : List) : Expr = EString(gid (), segments) let eList (elems : Expr list) : Expr = EList(gid (), elems) - +let eDict (entries : List) : Expr = EDict(gid (), entries) +let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = + ETuple(gid (), first, second, theRest) + + +let lpUnit () : LetPattern = LPUnit(gid ()) +let lpVar (name : string) : LetPattern = LPVariable(gid (), name) +let lpTuple + (first : LetPattern) + (second : LetPattern) + (theRest : LetPattern list) + : LetPattern = + LPTuple(gid (), first, second, theRest) +let eLet (pat : LetPattern) (value : Expr) (body : Expr) : Expr = + ELet(gid (), pat, value, body) let eVar (name : string) : Expr = EVariable(gid (), name) +let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = + EIf(gid (), cond, thenBranch, elseBranch) + +let eMatch (expr : Expr) (cases : List) : Expr = + EMatch(gid (), expr, cases) + // let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // ERecordFieldAccess(gid (), expr, fieldName) @@ -79,8 +99,7 @@ let eApply let args = NEList.ofListUnsafe "eApply" [] args EApply(gid (), target, typeArgs, args) -// let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = -// ETuple(gid (), first, second, theRest) + // let customTypeRecord (fields : List) : TypeDeclaration.T = diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 2b9b0f2c33..9f2f5256ba 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -13,7 +13,7 @@ module E = Tests.ProgramTypesToRuntimeTypes.Expressions let eval pt = uply { - let vmState = PT2RT.Expr.toRT 0 pt |> RT.VMState.fromInstructions + let vmState = pt |> PT2RT.Expr.toRT 0 |> RT.VMState.fromInstructions let! executionState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false @@ -21,147 +21,118 @@ let eval pt = return! LibExecution.Interpreter.eval executionState vmState } - -let onePlusTwo = - testTask "1+2" { - let! actual = eval E.onePlusTwo |> Ply.toTask - let expected = RT.DInt64 3L +let t name expr expected = + testTask name { + let! actual = eval expr |> Ply.toTask return Expect.equal actual expected "" } + +let onePlusTwo = t "1+2" E.onePlusTwo (RT.DInt64 3L) + let boolList = - testTask "[true; false; true]" { - let! actual = eval E.boolList |> Ply.toTask - let expected = - RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ]) - return Expect.equal actual expected "" - } + t + "[true; false; true]" + E.boolList + (RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ])) let boolListList = - testTask "[[true; false]; [false; true]]" { - let! actual = eval E.boolListList |> Ply.toTask - let expected = - RT.DList( - VT.unknown, - [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) - RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] - ) - return Expect.equal actual expected "" - } -let letSimple = - testTask "let x = true\nx" { - let! actual = eval E.letSimple |> Ply.toTask - let expected = RT.DBool true - return Expect.equal actual expected "" - } -let letTuple = - testTask "let (x, y) = (1, 2)\nx" { - let! actual = eval E.letTuple |> Ply.toTask - let expected = RT.DInt64 1L - return Expect.equal actual expected "" - } + t + "[[true; false]; [false; true]]" + E.boolListList + (RT.DList( + VT.unknown, + [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] + )) +let letSimple = t "let x = true\nx" E.letSimple (RT.DBool true) +let letTuple = t "let (x, y) = (1, 2)\nx" E.letTuple (RT.DInt64 1L) let letTupleNested = - testTask "let (a, (b, c)) = (1, (2, 3))\nb" { - let! actual = eval E.letTupleNested |> Ply.toTask - let expected = RT.DInt64 2L - return Expect.equal actual expected "" - } + t "let (a, (b, c)) = (1, (2, 3))\nb" E.letTupleNested (RT.DInt64 2L) -let simpleString = - testTask "[\"hello\"]" { - let! actual = eval E.simpleString |> Ply.toTask - let expected = RT.DString "hello" - return Expect.equal actual expected "" - } +let simpleString = t "[\"hello\"]" E.simpleString (RT.DString "hello") let stringWithInterpolation = - testTask "[let x = \"world\" in $\"hello {x}\"]" { - let! actual = eval E.stringWithInterpolation |> Ply.toTask - let expected = RT.DString "hello, world" - return Expect.equal actual expected "" - } + t + "[let x = \"world\" in $\"hello {x}\"]" + E.stringWithInterpolation + (RT.DString "hello, world") -let dictEmpty = - testTask "Dict {}" { - let! actual = eval E.dictEmpty |> Ply.toTask - let expected = RT.DDict(VT.unknown, Map.empty) - return Expect.equal actual expected "" - } +let dictEmpty = t "Dict {}" E.dictEmpty (RT.DDict(VT.unknown, Map.empty)) let dictSimple = - testTask "Dict { t: true}" { - let! actual = eval E.dictSimple |> Ply.toTask - let expected = RT.DDict(VT.unknown, Map [ "key", RT.DBool true ]) - return Expect.equal actual expected "" - } + t + "Dict { t: true}" + E.dictSimple + (RT.DDict(VT.unknown, Map [ "key", RT.DBool true ])) let dictMultEntries = - testTask "Dict {t: true; f: false}" { - let! actual = eval E.dictMultEntries |> Ply.toTask - let expected = - RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ]) - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false}" + E.dictMultEntries + (RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ])) let dictDupeKey = - testTask "Dict {t: true; f: false; t: false}" { - let! actual = eval E.dictDupeKey |> Ply.toTask - let expected = - RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ]) - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false; t: false}" + E.dictDupeKey + (RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ])) -let ifGotoThenBranch = - testTask "if true then 1 else 2" { - let! actual = eval E.ifGotoThenBranch |> Ply.toTask - let expected = RT.DInt64 1L - return Expect.equal actual expected "" - } +let ifGotoThenBranch = t "if true then 1 else 2" E.ifGotoThenBranch (RT.DInt64 1L) -let ifGotoElseBranch = - testTask "if false then 1 else 2" { - let! actual = eval E.ifGotoElseBranch |> Ply.toTask - let expected = RT.DInt64 2L - return Expect.equal actual expected "" - } -let ifElseMissing = - testTask "if false then 1" { - let! actual = eval E.ifElseMissing |> Ply.toTask - let expected = RT.DUnit - return Expect.equal actual expected "" - } +let ifGotoElseBranch = t "if false then 1 else 2" E.ifGotoElseBranch (RT.DInt64 2L) +let ifElseMissing = t "if false then 1" E.ifElseMissing RT.DUnit let tuple2 = - testTask "(false, true)" { - let! actual = eval E.tuple2 |> Ply.toTask - let expected = RT.DTuple(RT.DBool false, RT.DBool true, []) - return Expect.equal actual expected "" - } + t "(false, true)" E.tuple2 (RT.DTuple(RT.DBool false, RT.DBool true, [])) let tuple3 = - testTask "(false, true, false)" { - let! actual = eval E.tuple3 |> Ply.toTask - let expected = RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ]) - return Expect.equal actual expected "" - } - + t + "(false, true, false)" + E.tuple3 + (RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ])) let tupleNested = - testTask "((false, true), true, (true, false)))" { - let! actual = eval E.tupleNested |> Ply.toTask - let expected = - RT.DTuple( - RT.DTuple(RT.DBool false, RT.DBool true, []), - RT.DBool true, - [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] - ) - return Expect.equal actual expected "" - } - -// let TODO = -// testTask "TODO" { -// let! actual = eval E.TODO |> Ply.toTask -// let expected = RT.DUnit -// return Expect.equal actual expected "" -// } - + t + "((false, true), true, (true, false)))" + E.tupleNested + (RT.DTuple( + RT.DTuple(RT.DBool false, RT.DBool true, []), + RT.DBool true, + [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] + )) + +let matchSimple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.matchSimple + (RT.DString "second branch") + +let matchNotMatched = + t "match true with\n| false -> \"first branch\"" E.matchNotMatched RT.DUnit + +let matchWithVar = t "match true with\n| x -> x" E.matchWithVar (RT.DBool true) + +let matchWithVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.matchWithVarAndWhenCondition + (RT.DString "second branch") + +let matchList = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.matchList + (RT.DString "first branch") + +let matchListCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.matchListCons + (RT.DList(VT.unknown, [ RT.DInt64 2L ])) + +let matchTuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.matchTuple + (RT.DString "first branch") let tests = testList @@ -183,4 +154,11 @@ let tests = ifElseMissing tuple2 tuple3 - tupleNested ] + tupleNested + matchSimple + matchNotMatched + matchWithVar + //matchWithVarAndWhenCondition + matchList + matchListCons + matchTuple ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 99556edfec..416218e576 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -10,484 +10,597 @@ module VT = RT.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs +open TestUtils.PTShortcuts + // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists module Expressions = - let one = PT.EInt64(gid (), 1) + let one = eInt64 1 - let onePlusTwo : PT.Expr = - PT.EApply( - gid (), - PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0)), - [], - (NEList.ofList (PT.EInt64(gid (), 1)) [ PT.EInt64(gid (), 2) ]) - ) + let onePlusTwo = + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) + [] + [ eInt64 1; eInt64 2 ] // TODO: try to use undefined variable // TODO: lpunit - let letSimple : PT.Expr = - PT.ELet( - gid (), - PT.LPVariable(gid (), "x"), - PT.EBool(gid (), true), - PT.EVariable(gid (), "x") - ) - let letTuple : PT.Expr = - PT.ELet( - gid (), - PT.LPTuple(gid (), PT.LPVariable(gid (), "x"), PT.LPVariable(gid (), "y"), []), - PT.ETuple(gid (), PT.EInt64(gid (), 1), PT.EInt64(gid (), 2), []), - PT.EVariable(gid (), "x") - ) + let letSimple = eLet (lpVar "x") (eBool true) (eVar "x") + let letTuple = + eLet + (lpTuple (lpVar "x") (lpVar "y") []) + (eTuple (eInt64 1) (eInt64 2) []) + (eVar "x") /// `let (a, (b, c)) = (1, (2, 3)) in b` - let letTupleNested : PT.Expr = - PT.ELet( - gid (), - PT.LPTuple( - gid (), - PT.LPVariable(gid (), "a"), - PT.LPTuple( - gid (), - PT.LPVariable(gid (), "b"), - PT.LPVariable(gid (), "c"), - [] - ), - [] - ), - PT.ETuple( - gid (), - PT.EInt64(gid (), 1), - PT.ETuple(gid (), PT.EInt64(gid (), 2), PT.EInt64(gid (), 3), []), - [] - ), - PT.EVariable(gid (), "b") - ) - - let boolList : PT.Expr = - PT.EList( - gid (), - [ PT.EBool(gid (), true); PT.EBool(gid (), false); PT.EBool(gid (), true) ] - ) - - let boolListList : PT.Expr = - PT.EList( - gid (), - [ PT.EList(gid (), [ PT.EBool(gid (), true); PT.EBool(gid (), false) ]) - PT.EList(gid (), [ PT.EBool(gid (), false); PT.EBool(gid (), true) ]) ] - ) - - let simpleString : PT.Expr = PT.EString(gid (), [ PT.StringText("hello") ]) - - let stringWithInterpolation : PT.Expr = - PT.ELet( - gid (), - PT.LPVariable(gid (), "x"), - PT.EString(gid (), [ PT.StringText ", world" ]), - PT.EString( - gid (), - [ PT.StringText "hello"; PT.StringInterpolation(PT.EVariable(gid (), "x")) ] - ) - ) - - let dictEmpty : PT.Expr = PT.EDict(gid (), []) - let dictSimple : PT.Expr = PT.EDict(gid (), [ "key", PT.EBool(gid (), true) ]) - let dictMultEntries : PT.Expr = - PT.EDict(gid (), [ "t", PT.EBool(gid (), true); "f", PT.EBool(gid (), false) ]) - let dictDupeKey : PT.Expr = - PT.EDict( - gid (), - [ "t", PT.EBool(gid (), true) - "f", PT.EBool(gid (), false) - "t", PT.EBool(gid (), false) ] - ) - - let ifGotoThenBranch : PT.Expr = - PT.EIf( - gid (), - PT.EBool(gid (), true), - PT.EInt64(gid (), 1), - Some(PT.EInt64(gid (), 2)) - ) - let ifGotoElseBranch : PT.Expr = - PT.EIf( - gid (), - PT.EBool(gid (), false), - PT.EInt64(gid (), 1), - Some(PT.EInt64(gid (), 2)) - ) - let ifElseMissing : PT.Expr = - PT.EIf(gid (), PT.EBool(gid (), false), PT.EInt64(gid (), 1), None) + let letTupleNested = + eLet + (lpTuple (lpVar "a") (lpTuple (lpVar "b") (lpVar "c") []) []) + (eTuple (eInt64 1) (eTuple (eInt64 2) (eInt64 3) []) []) + (eVar "b") + + let boolList = eList [ eBool true; eBool false; eBool true ] + + let boolListList = + eList [ eList [ eBool true; eBool false ]; eList [ eBool false; eBool true ] ] + + let simpleString = eStr [ strText "hello" ] + + let stringWithInterpolation = + eLet + (lpVar "x") + (eStr [ strText ", world" ]) + (eStr [ strText "hello"; strInterp (eVar "x") ]) + + let dictEmpty = eDict [] + let dictSimple = eDict [ "key", eBool true ] + let dictMultEntries = eDict [ "t", eBool true; "f", eBool false ] + let dictDupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] + + let ifGotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) + let ifGotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) + let ifElseMissing = eIf (eBool false) (eInt64 1) None /// (false, true) - let tuple2 : PT.Expr = - PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []) + let tuple2 = eTuple (eBool false) (eBool true) [] /// (false, true, false) - let tuple3 : PT.Expr = - PT.ETuple( - gid (), - PT.EBool(gid (), false), - PT.EBool(gid (), true), - [ PT.EBool(gid (), false) ] - ) + let tuple3 = eTuple (eBool false) (eBool true) [ eBool false ] /// ((false, true), true, (true, false)) - let tupleNested : PT.Expr = - PT.ETuple( - gid (), - PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []), - PT.EBool(gid (), true), - [ PT.ETuple(gid (), PT.EBool(gid (), true), PT.EBool(gid (), false), []) ] - ) + let tupleNested = + eTuple + (eTuple (eBool false) (eBool true) []) + (eBool true) + [ eTuple (eBool true) (eBool false) [] ] + + /// match true with + /// | false -> "first branch" + /// | true -> "second branch" + let matchSimple = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPBool(gid (), true) + whenCondition = None + rhs = eStr [ strText "second branch" ] } ] + + /// match true with + /// | false -> "first branch" + let matchNotMatched = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + /// match true with + /// | x -> x + let matchWithVar = + eMatch + (eBool true) + [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] + + /// match 4 with + /// | 1 -> "first branch" + /// | x when x % 2 == 0 -> "second branch" + let matchWithVarAndWhenCondition = + eMatch + (eInt64 4) + [ { pat = PT.MPInt64(gid (), 1) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPVariable(gid (), "x") + // "is even" + whenCondition = + Some( + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + [] + [ eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + [] + [ eVar "x" ] + eInt64 2 ] + ) + rhs = eStr [ strText "second branch" ] } ] + + let matchList = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + let matchListCons = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = + PT.MPListCons( + gid (), + PT.MPInt64(gid (), 1), + PT.MPVariable(gid (), "tail") + ) + whenCondition = None + rhs = eVar "tail" } ] + let matchTuple = + eMatch + (eTuple (eInt64 1) (eInt64 2) []) + [ { pat = PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] module E = Expressions -let one = - testTask "1" { - let actual = PT2RT.Expr.toRT 0 E.one - let expected = (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) +let t name expr expected = + testTask name { + let actual = PT2RT.Expr.toRT 0 expr return Expect.equal actual expected "" } +let one = t "1" E.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) + + let onePlusTwo = - testTask "1+2" { - let actual = PT2RT.Expr.toRT 0 E.onePlusTwo - - let expected = - (4, - [ RT.LoadVal( - 0, - RT.DFnVal( - RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) - ) + t + "1+2" + E.onePlusTwo + (4, + [ RT.LoadVal( + 0, + RT.DFnVal( + RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], - 3) - - return Expect.equal actual expected "" - } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], + 3) let letSimple = - testTask "let x = true\n x" { - let actual = PT2RT.Expr.toRT 0 E.letSimple - - let expected = - (2, - [ RT.LoadVal(0, RT.DBool true) - RT.SetVar("x", 0) // where the 'true' is stored - RT.GetVar(1, "x") ], - 1) - - return Expect.equal actual expected "" - } + t + "let x = true\n x" + E.letSimple + (2, + [ RT.LoadVal(0, RT.DBool true) + RT.SetVar("x", 0) // where the 'true' is stored + RT.GetVar(1, "x") ], + 1) let letTuple = - testTask "let (x, y) = (1, 2)\nx" { - let actual = PT2RT.Expr.toRT 0 E.letTuple - - let expected = - (6, - [ // register 0 isn't exposed, but used to temporarily store the tuple - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - RT.ExtractTupleItems(0, 3, 4, []) - - RT.SetVar("x", 3) - RT.SetVar("y", 4) - - RT.GetVar(5, "x") ], - 5) - - return Expect.equal actual expected "" - } + t + "let (x, y) = (1, 2)\nx" + E.letTuple + (6, + [ // register 0 isn't exposed, but used to temporarily store the tuple + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + RT.ExtractTupleItems(0, 3, 4, []) + + RT.SetVar("x", 3) + RT.SetVar("y", 4) + + RT.GetVar(5, "x") ], + 5) let letTupleNested = - testTask "let (a, (b, c)) = (1, (2, 3)) in b" { - let actual = PT2RT.Expr.toRT 0 E.letTupleNested - - let expected = - (10, - [ // reserve 0 for outer tuple - RT.LoadVal(1, RT.DInt64 1L) - // reserve 2 for inner tuple - RT.LoadVal(3, RT.DInt64 2L) - RT.LoadVal(4, RT.DInt64 3L) - RT.CreateTuple(2, 3, 4, []) // create inner tuple - RT.CreateTuple(0, 1, 2, []) // create outer tuple - RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items - RT.SetVar("a", 5) - RT.ExtractTupleItems(6, 7, 8, []) - RT.SetVar("b", 7) - RT.SetVar("c", 8) - RT.GetVar(9, "b") ], - 9) - - return Expect.equal actual expected "" - } + t + "let (a, (b, c)) = (1, (2, 3)) in b" + E.letTupleNested + (10, + [ // reserve 0 for outer tuple + RT.LoadVal(1, RT.DInt64 1L) + // reserve 2 for inner tuple + RT.LoadVal(3, RT.DInt64 2L) + RT.LoadVal(4, RT.DInt64 3L) + RT.CreateTuple(2, 3, 4, []) // create inner tuple + RT.CreateTuple(0, 1, 2, []) // create outer tuple + RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items + RT.SetVar("a", 5) + RT.ExtractTupleItems(6, 7, 8, []) + RT.SetVar("b", 7) + RT.SetVar("c", 8) + RT.GetVar(9, "b") ], + 9) let boolList = - testTask "[true, false, true]" { - let actual = PT2RT.Expr.toRT 0 E.boolList - - let expected = - (4, - [ RT.LoadVal(0, RT.DList(VT.unknown, [])) + t + "[true, false, true]" + E.boolList + (4, + [ RT.LoadVal(0, RT.DList(VT.unknown, [])) - RT.LoadVal(1, RT.DBool true) - RT.AddItemToList(0, 1) + RT.LoadVal(1, RT.DBool true) + RT.AddItemToList(0, 1) - RT.LoadVal(2, RT.DBool false) - RT.AddItemToList(0, 2) + RT.LoadVal(2, RT.DBool false) + RT.AddItemToList(0, 2) - RT.LoadVal(3, RT.DBool true) - RT.AddItemToList(0, 3) ], - 0) - - return Expect.equal actual expected "" - } + RT.LoadVal(3, RT.DBool true) + RT.AddItemToList(0, 3) ], + 0) let boolListList = - testTask "[[true; false]; [false; true]]" { - let actual = PT2RT.Expr.toRT 0 E.boolListList - - let expected = - (7, - [ // create outer list - RT.LoadVal(0, RT.DList(VT.unknown, [])) - - // first inner list - RT.LoadVal(1, RT.DList(VT.unknown, [])) - RT.LoadVal(2, RT.DBool true) - RT.AddItemToList(1, 2) - RT.LoadVal(3, RT.DBool false) - RT.AddItemToList(1, 3) - // add it to outer - RT.AddItemToList(0, 1) - - // second inner list - RT.LoadVal(4, RT.DList(VT.unknown, [])) - RT.LoadVal(5, RT.DBool false) - RT.AddItemToList(4, 5) - RT.LoadVal(6, RT.DBool true) - RT.AddItemToList(4, 6) - // add it to outer - RT.AddItemToList(0, 4) ], - 0) + t + "[[true; false]; [false; true]]" + E.boolListList + (7, + [ // create outer list + RT.LoadVal(0, RT.DList(VT.unknown, [])) + + // first inner list + RT.LoadVal(1, RT.DList(VT.unknown, [])) + RT.LoadVal(2, RT.DBool true) + RT.AddItemToList(1, 2) + RT.LoadVal(3, RT.DBool false) + RT.AddItemToList(1, 3) + // add it to outer + RT.AddItemToList(0, 1) + + // second inner list + RT.LoadVal(4, RT.DList(VT.unknown, [])) + RT.LoadVal(5, RT.DBool false) + RT.AddItemToList(4, 5) + RT.LoadVal(6, RT.DBool true) + RT.AddItemToList(4, 6) + // add it to outer + RT.AddItemToList(0, 4) ], + 0) - return Expect.equal actual expected "" - } let simpleString = - testTask "[\"hello\"]" { - let actual = PT2RT.Expr.toRT 0 E.simpleString - - let expected = - (2, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString "hello") - RT.AppendString(0, 1) ], - 0) - - return Expect.equal actual expected "" - } + t + "[\"hello\"]" + E.simpleString + (2, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString "hello") + RT.AppendString(0, 1) ], + 0) let stringWithInterpolation = - testTask "[let x = \"world\"\n$\"hello {x}\"]" { - let actual = PT2RT.Expr.toRT 0 E.stringWithInterpolation - - let expected = - (5, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString ", world") - RT.AppendString(0, 1) - RT.SetVar("x", 0) - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "hello") - RT.AppendString(2, 3) - RT.GetVar(4, "x") - RT.AppendString(2, 4) ], - 2) + t + "[let x = \"world\"\n$\"hello {x}\"]" + E.stringWithInterpolation + (5, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString ", world") + RT.AppendString(0, 1) + RT.SetVar("x", 0) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "hello") + RT.AppendString(2, 3) + RT.GetVar(4, "x") + RT.AppendString(2, 4) ], + 2) - return Expect.equal actual expected "" - } let dictEmpty = - testTask "Dict {}" { - let actual = PT2RT.Expr.toRT 0 E.dictEmpty - - let expected = (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) - - return Expect.equal actual expected "" - } + t "Dict {}" E.dictEmpty (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) let dictSimple = - testTask "Dict { t: true}" { - let actual = PT2RT.Expr.toRT 0 E.dictSimple - - let expected = - (2, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "key", 1) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict { t: true}" + E.dictSimple + (2, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "key", 1) ], + 0) let dictMultEntries = - testTask "Dict {t: true; f: false}" { - let actual = PT2RT.Expr.toRT 0 E.dictMultEntries - - let expected = - (3, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) - RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false}" + E.dictMultEntries + (3, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) ], + 0) let dictDupeKey = - testTask "Dict {t: true; f: false; t: true}" { - let actual = PT2RT.Expr.toRT 0 E.dictDupeKey - - let expected = - (4, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) - RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) - RT.LoadVal(3, RT.DBool false) - RT.AddDictEntry(0, "t", 3) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false; t: true}" + E.dictDupeKey + (4, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) + RT.LoadVal(3, RT.DBool false) + RT.AddDictEntry(0, "t", 3) ], + 0) let ifGotoThenBranch = - testTask "if true then 1 else 2" { - let actual = PT2RT.Expr.toRT 0 E.ifGotoThenBranch + t + "if true then 1 else 2" + E.ifGotoThenBranch + (4, + [ // reserve register 0 for the result - let expected = - (4, - [ // cond - RT.LoadVal(1, RT.DBool true) - RT.JumpByIfFalse(3, 1) + // cond + RT.LoadVal(1, RT.DBool true) + RT.JumpByIfFalse(3, 1) - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) - return Expect.equal actual expected "" - } let ifGotoElseBranch = - testTask "if false then 1 else 2" { - let actual = PT2RT.Expr.toRT 0 E.ifGotoElseBranch - - let expected = - (4, - [ // cond - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(3, 1) + t + "if false then 1 else 2" + E.ifGotoElseBranch + (4, + [ // cond + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(3, 1) - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) - return Expect.equal actual expected "" - } let ifElseMissing = - testTask "if false then 1" { - let actual = PT2RT.Expr.toRT 0 E.ifElseMissing - - let expected = - (3, - [ RT.LoadVal(0, RT.DUnit) - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(2, 1) - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) ], - 0) + t + "if false then 1" + E.ifElseMissing + (3, + [ RT.LoadVal(0, RT.DUnit) + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(2, 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) ], + 0) - return Expect.equal actual expected "" - } let tuple2 = - testTask "(false, true)" { - let actual = PT2RT.Expr.toRT 0 E.tuple2 - - let expected = - (3, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.CreateTuple(0, 1, 2, []) ], - 0) - - return Expect.equal actual expected "" - } + t + "(false, true)" + E.tuple2 + (3, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.CreateTuple(0, 1, 2, []) ], + 0) let tuple3 = - testTask "(false, true, false)" { - let actual = PT2RT.Expr.toRT 0 E.tuple3 - - let expected = - (4, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateTuple(0, 1, 2, [ 3 ]) ], - 0) - - return Expect.equal actual expected "" - } + t + "(false, true, false)" + E.tuple3 + (4, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateTuple(0, 1, 2, [ 3 ]) ], + 0) let tupleNested = - testTask "((false, true), true, (true, false))" { - let actual = PT2RT.Expr.toRT 0 E.tupleNested - - let expected = - (8, - [ // 0 "reserved" for outer tuple - - // first inner tuple (1 "reserved") - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateTuple(1, 2, 3, []) - - // middle value - RT.LoadVal(4, RT.DBool true) - - // second inner tuple (5 "reserved") - RT.LoadVal(6, RT.DBool true) - RT.LoadVal(7, RT.DBool false) - RT.CreateTuple(5, 6, 7, []) - - // wrap all in outer tuple - RT.CreateTuple(0, 1, 4, [ 5 ]) ], - 0) - - return Expect.equal actual expected "" - } + t + "((false, true), true, (true, false))" + E.tupleNested + (8, + [ // 0 "reserved" for outer tuple + + // first inner tuple (1 "reserved") + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateTuple(1, 2, 3, []) + + // middle value + RT.LoadVal(4, RT.DBool true) + + // second inner tuple (5 "reserved") + RT.LoadVal(6, RT.DBool true) + RT.LoadVal(7, RT.DBool false) + RT.CreateTuple(5, 6, 7, []) + + // wrap all in outer tuple + RT.CreateTuple(0, 1, 4, [ 5 ]) ], + 0) + +let matchSimple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.matchSimple + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.MatchValue(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 7 + + // SECOND BRANCH + RT.MatchValue(0, RT.MPBool true, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "second branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchNotMatched = + t + "match true with\n| false -> \"first branch\"" + E.matchNotMatched + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.MatchValue(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchWithVar = + t + "match true with\n| x -> x" + E.matchWithVar + (3, + [ RT.LoadVal(0, RT.DBool true) + + RT.MatchValue(0, RT.MPVariable "x", 3) + RT.GetVar(2, "x") + RT.CopyVal(1, 2) + RT.JumpBy 1 + + RT.MatchUnmatched ], + 1) + +let matchWithVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.matchWithVarAndWhenCondition + (10, + [ RT.LoadVal(0, RT.DInt64 4L) + + // first branch + RT.MatchValue(0, RT.MPInt64 1L, 5) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 14 + + // second branch + RT.MatchValue(0, RT.MPVariable "x", 12) + RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + RT.GetVar(4, "x") + RT.Apply(5, 3, [], NEList.ofList 4 []) + RT.LoadVal(6, RT.DInt64 2L) + RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + RT.JumpByIfFalse(5, 7) + RT.LoadVal(8, RT.DString "") + RT.LoadVal(9, RT.DString "second branch") + RT.AppendString(8, 9) + RT.CopyVal(1, 8) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchList = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.matchList + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(0, RT.DList(VT.unknown, [])) + RT.LoadVal(1, RT.DInt64 1L) + RT.AddItemToList(0, 1) + RT.LoadVal(2, RT.DInt64 2L) + RT.AddItemToList(0, 2) + + // first branch + RT.MatchValue(0, RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], 5) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + +let matchListCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.matchListCons + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(0, RT.DList(VT.unknown, [])) + RT.LoadVal(1, RT.DInt64 1L) + RT.AddItemToList(0, 1) + RT.LoadVal(2, RT.DInt64 2L) + RT.AddItemToList(0, 2) + + // first branch + RT.MatchValue(0, RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), 3) + RT.GetVar(4, "tail") + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + +let matchTuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.matchTuple + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + // first branch + RT.MatchValue(0, RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), 5) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) let tests = testList @@ -510,4 +623,11 @@ let tests = ifElseMissing tuple2 tuple3 - tupleNested ] + tupleNested + matchSimple + matchNotMatched + matchWithVar + //matchWithVarAndWhenCondition // -- disabled because of fn-calling issues + matchList + matchListCons + matchTuple ] diff --git a/tree-sitter-darklang/package-lock.json b/tree-sitter-darklang/package-lock.json index f2cf375bca..b15741a1bd 100644 --- a/tree-sitter-darklang/package-lock.json +++ b/tree-sitter-darklang/package-lock.json @@ -28,7 +28,6 @@ "integrity": "sha512-XjTcS3wdTy/2cc/ptMLc/WRyOLECRYcMTrSWyhZnj1oGSOWbHLTklgsgRICU3cPfb0vy+oZCC33M43u6R1HSCA==", "dev": true, "hasInstallScript": true, - "license": "MIT", "bin": { "tree-sitter": "cli.js" } From 5532b198743d3ca24417c08c01bab226997b442a Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 15 Aug 2024 12:36:41 -0400 Subject: [PATCH 14/60] Update new interpreter to be loop, not recursive Otherwise, what's the point of all of this --- backend/src/LibExecution/Interpreter.fs | 99 ++++++++++++++---------- backend/src/LibExecution/RuntimeTypes.fs | 6 +- backend/tests/Tests/Interpreter.Tests.fs | 5 +- backend/tests/Tests/PT2RT.Tests.fs | 6 +- 4 files changed, 66 insertions(+), 50 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index f91b038372..5fed547495 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -16,32 +16,29 @@ open RuntimeTypes /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec execute - (exeState : ExecutionState) - (vmState : VMState) - (counter : int) - : Ply = +let rec execute (exeState : ExecutionState) (initialVmState : VMState) : Ply = uply { - let instructions = vmState.instructions + let mutable vmState = initialVmState + let mutable counter = 0 // what instruction (by index) we're on + + // if we encounter a runtime error, we store it here and then `raise` it at the end + let mutable rte : Option = None - if counter >= instructions.Length then - // is this OK? - return vmState.registers[vmState.resultReg] - else - let instruction = instructions[counter] + while counter < vmState.instructions.Length && Option.isNone rte do + let instruction = vmState.instructions[counter] match instruction with // `1L` -> next register | LoadVal(reg, value) -> vmState.registers[reg] <- value - return! execute exeState vmState (counter + 1) + counter <- counter + 1 // `let x = 1` | SetVar(varName, loadFrom) -> let value = vmState.registers[loadFrom] - let vmState = + vmState <- { vmState with symbolTable = Map.add varName value vmState.symbolTable } - return! execute exeState vmState (counter + 1) + counter <- counter + 1 // later, `x` | GetVar(loadTo, varName) -> @@ -53,7 +50,7 @@ let rec execute vmState.registers[loadTo] <- value - return! execute exeState vmState (counter + 1) + counter <- counter + 1 // `add (increment 1L) (3L)` and store results in `putResultIn` @@ -66,10 +63,8 @@ let rec execute //debuG "args" (NEList.length args) let thingToCall = vmState.registers[thingToCallReg] let! result = call exeState vmState thingToCall typeArgs args - vmState.registers[putResultIn] <- result - - return! execute exeState vmState (counter + 1) + counter <- counter + 1 | AddItemToList(listReg, itemToAddReg) -> match vmState.registers[listReg] with @@ -82,15 +77,17 @@ let rec execute let itemToAdd = vmState.registers[itemToAddReg] vmState.registers[listReg] <- DList(vt, list @ [ itemToAdd ]) - return! execute exeState vmState (counter + 1) - | _ -> return DString "TODO can't operate list-add to a non-list" + counter <- counter + 1 + | _ -> + rte <- + Some(RuntimeError.oldError "TODO can't operate list-add to a non-list") | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> let first = vmState.registers[firstReg] let second = vmState.registers[secondReg] let theRest = theRestRegs |> List.map (fun r -> vmState.registers[r]) vmState.registers[tupleReg] <- DTuple(first, second, theRest) - return! execute exeState vmState (counter + 1) + counter <- counter + 1 | AddDictEntry(dictReg, key, valueReg) -> match vmState.registers[dictReg] with @@ -98,29 +95,37 @@ let rec execute // TODO: type checking of key and value; adjust vt let value = vmState.registers[valueReg] vmState.registers[dictReg] <- DDict(vt, Map.add key value entries) - return! execute exeState vmState (counter + 1) - | _ -> return DString "TODO can't operate dict-add to a non-dict" + counter <- counter + 1 + | _ -> + rte <- + Some(RuntimeError.oldError "TODO can't operate dict-add to a non-dict") | AppendString(targetReg, sourceReg) -> match vmState.registers[targetReg], vmState.registers[sourceReg] with | DString target, DString source -> vmState.registers[targetReg] <- DString(target + source) - return! execute exeState vmState (counter + 1) - | _, _ -> return DString "Error: Invalid string-append attempt" + counter <- counter + 1 + | _, _ -> + // TODO + rte <- Some(RuntimeError.oldError "Error: Invalid string-append attempt") | JumpByIfFalse(jumpBy, condReg) -> match vmState.registers[condReg] with - | DBool false -> return! execute exeState vmState (counter + jumpBy + 1) - | DBool true -> return! execute exeState vmState (counter + 1) - | _ -> return DString "Error: Jump condition must be a boolean" + | DBool false -> counter <- counter + jumpBy + 1 + | DBool true -> counter <- counter + 1 + | _ -> + // TODO + rte <- + Some(RuntimeError.oldError "Error: Jump condition must be a boolean") + + | JumpBy jumpBy -> counter <- counter + jumpBy + 1 - | JumpBy jumpBy -> return! execute exeState vmState (counter + jumpBy + 1) | CopyVal(copyTo, copyFrom) -> vmState.registers[copyTo] <- vmState.registers[copyFrom] - return! execute exeState vmState (counter + 1) + counter <- counter + 1 | MatchValue(valueReg, pat, failJump) -> let rec matchPattern pat dv = @@ -128,9 +133,7 @@ let rec execute | MPVariable name, dv -> true, [ (name, dv) ] | MPUnit, DUnit -> true, [] - | MPBool l, DBool r -> l = r, [] - | MPInt8 l, DInt8 r -> l = r, [] | MPUInt8 l, DUInt8 r -> l = r, [] | MPInt16 l, DInt16 r -> l = r, [] @@ -141,9 +144,7 @@ let rec execute | MPUInt64 l, DUInt64 r -> l = r, [] | MPInt128 l, DInt128 r -> l = r, [] | MPUInt128 l, DUInt128 r -> l = r, [] - | MPFloat l, DFloat r -> l = r, [] - | MPChar l, DChar r -> l = r, [] | MPString l, DString r -> l = r, [] @@ -206,17 +207,16 @@ let rec execute let matches, vars = matchPattern pat vmState.registers[valueReg] if matches then - let vmState = + vmState <- vars |> List.fold (fun vmState (varName, value) -> { vmState with symbolTable = Map.add varName value vmState.symbolTable }) vmState - return! execute exeState vmState (counter + 1) + counter <- counter + 1 else - return! execute exeState vmState (counter + failJump + 1) - + counter <- counter + failJump + 1 | ExtractTupleItems(extractFrom, firstReg, secondReg, restRegs) -> @@ -228,11 +228,24 @@ let rec execute List.zip restRegs rest |> List.iter (fun (reg, value) -> vmState.registers[reg] <- value) - return! execute exeState vmState (counter + 1) - | _ -> return DString "Error: Expected a tuple for decomposition" + counter <- counter + 1 + | _ -> + // TODO + rte <- + Some(RuntimeError.oldError "Error: Expected a tuple for decomposition") + + | Fail _rte -> rte <- Some(RuntimeError.oldError "TODO") + + | MatchUnmatched -> rte <- Some(RuntimeError.oldError "match not matched") + - | Fail _rte -> return DUnit // TODO - | MatchUnmatched -> return DUnit // TODO + // If we've reached the end of the instructions, return the result + match rte with + | None -> return vmState.registers[vmState.resultReg] + | Some rte -> + // TODO + //return raiseRTE exeState.tracing.callStack rte + return RuntimeError.toDT rte } @@ -408,4 +421,4 @@ and execFn and eval (exeState : ExecutionState) (vmState : VMState) : Ply = - execute exeState vmState 0 + execute exeState vmState diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 6de4c20d48..40b45fc016 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -669,7 +669,7 @@ and FnValImpl = /// primarily used for things where the user made an error, such as a type error, as /// opposed to a place where the runtime is flawed (use Exception.raiseInternal for those). /// See docs/errors.md for detailed discussion. -and RuntimeError = private RuntimeError of string //Dval +and RuntimeError = private RuntimeError of Dval // We use NoComparison here to avoid accidentally using structural comparison and [] Dval = @@ -831,7 +831,7 @@ module RuntimeError = // let typeName = // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error - // let toDT (RuntimeError e : RuntimeError) : Dval = e + let toDT (RuntimeError e : RuntimeError) : Dval = e // let fromDT (dv : Dval) : RuntimeError = RuntimeError dv @@ -858,7 +858,7 @@ module RuntimeError = // TODO remove all usages of this in favor of better error cases let oldError (msg : string) : RuntimeError = //case "OldStringErrorTODO" [ DString msg ] - RuntimeError msg + RuntimeError(DString msg) /// Note: in cases where it's awkward to niclude a CallStack, diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 9f2f5256ba..7f3cccbea6 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -106,7 +106,10 @@ let matchSimple = (RT.DString "second branch") let matchNotMatched = - t "match true with\n| false -> \"first branch\"" E.matchNotMatched RT.DUnit + t + "match true with\n| false -> \"first branch\"" + E.matchNotMatched + (RT.DString "match not matched") let matchWithVar = t "match true with\n| x -> x" E.matchWithVar (RT.DBool true) diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 416218e576..fe8cda20c0 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -576,7 +576,7 @@ let matchListCons = RT.CopyVal(3, 4) RT.JumpBy 1 - // handle the case where no branches match + // handle the case where no branches match RT.MatchUnmatched ], 3) @@ -590,7 +590,7 @@ let matchTuple = RT.LoadVal(2, RT.DInt64 2L) RT.CreateTuple(0, 1, 2, []) - // first branch + // first branch RT.MatchValue(0, RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), 5) RT.LoadVal(4, RT.DString "") RT.LoadVal(5, RT.DString "first branch") @@ -598,7 +598,7 @@ let matchTuple = RT.CopyVal(3, 4) RT.JumpBy 1 - // handle the case where no branches match + // handle the case where no branches match RT.MatchUnmatched ], 3) From 4995d05cefd2700ac4dfd3de5b2e965d7ed0e93a Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 15 Aug 2024 16:40:09 -0400 Subject: [PATCH 15/60] (no-op) tidy interpreter --- backend/src/LibExecution/Interpreter.fs | 67 ++++++++++--------------- 1 file changed, 26 insertions(+), 41 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 5fed547495..97a8577bc9 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -16,7 +16,10 @@ open RuntimeTypes /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec execute (exeState : ExecutionState) (initialVmState : VMState) : Ply = +let rec private execute + (exeState : ExecutionState) + (initialVmState : VMState) + : Ply = uply { let mutable vmState = initialVmState let mutable counter = 0 // what instruction (by index) we're on @@ -129,6 +132,19 @@ let rec execute (exeState : ExecutionState) (initialVmState : VMState) : Ply let rec matchPattern pat dv = + let rec matchList pats items = + match pats, items with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | pat :: otherPats, item :: items -> + let matches, vars = matchPattern pat item + if matches then + let matchesRest, varsRest = matchList otherPats items + if matchesRest then true, vars @ varsRest else false, [] + else + false, [] + match pat, dv with | MPVariable name, dv -> true, [ (name, dv) ] @@ -148,20 +164,7 @@ let rec execute (exeState : ExecutionState) (initialVmState : VMState) : Ply l = r, [] | MPString l, DString r -> l = r, [] - | MPList pats, DList(_, items) -> - let rec matchList pats items = - match pats, items with - | [], [] -> true, [] - | [], _ -> false, [] - | _, [] -> false, [] - | pat :: otherPats, item :: items -> - let matches, vars = matchPattern pat item - if matches then - let matchesRest, varsRest = matchList otherPats items - if matchesRest then true, vars @ varsRest else false, [] - else - false, [] - matchList pats items + | MPList pats, DList(_, items) -> matchList pats items | MPListCons(head, tail), DList(vt, items) -> match items with @@ -175,32 +178,14 @@ let rec execute (exeState : ExecutionState) (initialVmState : VMState) : Ply - // CLEANUP can probably be tidier - let matchesFirst, varsFirst = matchPattern first firstVal - if matchesFirst then - let matchesSecond, varsSecond = matchPattern second secondVal - if matchesSecond then - let rec matchRest pats vals = - match pats, vals with - | [], [] -> true, [] - | [], _ -> false, [] - | _, [] -> false, [] - | thirdPat :: otherPats, firstVal :: otherVals -> - let matches, vars = matchPattern thirdPat firstVal - if matches then - let matchesRest, varsRest = matchRest otherPats otherVals - if matchesRest then - true, varsFirst @ varsSecond @ vars @ varsRest - else - false, [] - else - false, [] - matchRest theRest theRestVal - else - false, [] - else - false, [] - + match matchPattern first firstVal, matchPattern second secondVal with + | (true, varsFirst), (true, varsSecond) -> + match matchList theRest theRestVal with + | true, varsRest -> true, varsFirst @ varsSecond @ varsRest + | false, _ -> false, [] + | _ -> false, [] + + // Dval didn't match the pattern even in a basic sense | _ -> false, [] From b29cdd11875a27a1ecae803ff0d644b02dabc100 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 20 Aug 2024 09:56:09 -0400 Subject: [PATCH 16/60] (new interpreter) tidy list- and dict- creation --- backend/src/LibExecution/Interpreter.fs | 243 +++++++++++------- .../ProgramTypesToRuntimeTypes.fs | 76 ++---- backend/src/LibExecution/RuntimeTypes.fs | 161 ++---------- backend/src/LibExecution/TypeChecker.fs | 90 +++---- backend/tests/Tests/Interpreter.Tests.fs | 10 +- backend/tests/Tests/PT2RT.Tests.fs | 129 +++++----- tree-sitter-darklang/package-lock.json | 1 + 7 files changed, 297 insertions(+), 413 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 97a8577bc9..49dfeca129 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -7,7 +7,101 @@ open FSharp.Control.Tasks.Affine.Unsafe open Prelude open RuntimeTypes - +module VT = ValueType + + +let rec checkAndExtractLetPattern + (pat : LetPattern) + (dv : Dval) + : bool * List = + let r = checkAndExtractLetPattern + + let rec rList pats items = + match pats, items with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | pat :: otherPats, item :: items -> + let matches, vars = r pat item + if matches then + let matchesRest, varsRest = rList otherPats items + if matchesRest then true, vars @ varsRest else false, [] + else + false, [] + + match pat, dv with + | LPVariable name, dv -> true, [ (name, dv) ] + | LPUnit, DUnit -> true, [] + | LPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> + match r first firstVal, r second secondVal with + | (true, varsFirst), (true, varsSecond) -> + match rList theRest theRestVal with + | true, varsRest -> true, varsFirst @ varsSecond @ varsRest + | false, _ -> false, [] + | _ -> false, [] + | _ -> false, [] + +let rec checkAndExtractMatchPattern + (pat : MatchPattern) + (dv : Dval) + : bool * List = + let r = checkAndExtractMatchPattern + + let rec rList pats items = + match pats, items with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | pat :: otherPats, item :: items -> + let matches, vars = r pat item + if matches then + let matchesRest, varsRest = rList otherPats items + if matchesRest then true, vars @ varsRest else false, [] + else + false, [] + + match pat, dv with + | MPVariable name, dv -> true, [ (name, dv) ] + + | MPUnit, DUnit -> true, [] + | MPBool l, DBool r -> l = r, [] + | MPInt8 l, DInt8 r -> l = r, [] + | MPUInt8 l, DUInt8 r -> l = r, [] + | MPInt16 l, DInt16 r -> l = r, [] + | MPUInt16 l, DUInt16 r -> l = r, [] + | MPInt32 l, DInt32 r -> l = r, [] + | MPUInt32 l, DUInt32 r -> l = r, [] + | MPInt64 l, DInt64 r -> l = r, [] + | MPUInt64 l, DUInt64 r -> l = r, [] + | MPInt128 l, DInt128 r -> l = r, [] + | MPUInt128 l, DUInt128 r -> l = r, [] + | MPFloat l, DFloat r -> l = r, [] + | MPChar l, DChar r -> l = r, [] + | MPString l, DString r -> l = r, [] + + | MPList pats, DList(_, items) -> rList pats items + + | MPListCons(head, tail), DList(vt, items) -> + match items with + | [] -> false, [] + | headItem :: tailItems -> + let matchesHead, varsHead = r head headItem + if matchesHead then + let matchesTail, varsTail = r tail (DList(vt, tailItems)) + if matchesTail then true, varsHead @ varsTail else false, [] + else + false, [] + + | MPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> + match r first firstVal, r second secondVal with + | (true, varsFirst), (true, varsSecond) -> + match rList theRest theRestVal with + | true, varsRest -> true, varsFirst @ varsSecond @ varsRest + | false, _ -> false, [] + | _ -> false, [] + + // Dval didn't match the pattern even in a basic sense + | _ -> false, [] /// TODO: don't pass ExecutionState around so much? /// The parts that change, (e.g. `st` and `tst`) should probably all be part of VMState @@ -31,7 +125,7 @@ let rec private execute let instruction = vmState.instructions[counter] match instruction with - // `1L` -> next register + // put a static Dval into a register | LoadVal(reg, value) -> vmState.registers[reg] <- value counter <- counter + 1 @@ -69,21 +163,25 @@ let rec private execute vmState.registers[putResultIn] <- result counter <- counter + 1 - | AddItemToList(listReg, itemToAddReg) -> - match vmState.registers[listReg] with - | DList(vt, list) -> - // TODO: type checking of item-add; adjust vt - - // Had: - // let! results = Ply.List.mapSequentially (eval state) exprs - // return TypeChecker.DvalCreator.list callStack VT.unknown results + | CreateList(listReg, itemsToAddRegs) -> + // CLEANUP reference registers directly in DvalCreator.list, + // so we don't have to copy things + let itemsToAdd = itemsToAddRegs |> List.map (fun r -> vmState.registers[r]) + vmState.registers[listReg] <- + TypeChecker.DvalCreator.list + exeState.tracing.callStack + VT.unknown + itemsToAdd + counter <- counter + 1 - let itemToAdd = vmState.registers[itemToAddReg] - vmState.registers[listReg] <- DList(vt, list @ [ itemToAdd ]) - counter <- counter + 1 - | _ -> - rte <- - Some(RuntimeError.oldError "TODO can't operate list-add to a non-list") + | CreateDict(dictReg, entries) -> + // CLEANUP reference registers directly in DvalCreator.dict, + // so we don't have to copy things + let entries = + entries + |> List.map (fun (key, valueReg) -> (key, vmState.registers[valueReg])) + vmState.registers[dictReg] <- TypeChecker.DvalCreator.dict VT.unknown entries + counter <- counter + 1 | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> let first = vmState.registers[firstReg] @@ -92,18 +190,22 @@ let rec private execute vmState.registers[tupleReg] <- DTuple(first, second, theRest) counter <- counter + 1 - | AddDictEntry(dictReg, key, valueReg) -> - match vmState.registers[dictReg] with - | DDict(vt, entries) -> - // TODO: type checking of key and value; adjust vt - let value = vmState.registers[valueReg] - vmState.registers[dictReg] <- DDict(vt, Map.add key value entries) - counter <- counter + 1 - | _ -> - rte <- - Some(RuntimeError.oldError "TODO can't operate dict-add to a non-dict") - + // I'm not sure, but it also feels like string-creation doesn't need to be so many + // instructions. Maybe we should just have a CreateString instruction. + // Maybe that's a tad more complicated because of interpolation... but maybe not actually. + // If CreateString just references a list of registers, then the interpolation is already + // done by the time we get to CreateString. + // I don't think we need to worry about checking "is this string part really a string" + // before we get to CreateString. + // Oh, that said - if there's nested string interpolation (if that's legal?), would that + // result in nested CreateString instructions? Write out an example. + // OK did some quick search and it seems no language really allows nested string interpolation. + // So we're probably fine. + // That said, let's also consider the _normal_ case of a String with a simple StringText or StringInterpolation + // segment - this shouldn't result in many instructions. + // CreateString itself could contain a list of Text and Interpolation segments, where Interpolation + // segments just refer to a register with some (supposed) string value -- and we only have to cehck those. | AppendString(targetReg, sourceReg) -> match vmState.registers[targetReg], vmState.registers[sourceReg] with | DString target, DString source -> @@ -130,66 +232,9 @@ let rec private execute vmState.registers[copyTo] <- vmState.registers[copyFrom] counter <- counter + 1 - | MatchValue(valueReg, pat, failJump) -> - let rec matchPattern pat dv = - let rec matchList pats items = - match pats, items with - | [], [] -> true, [] - | [], _ -> false, [] - | _, [] -> false, [] - | pat :: otherPats, item :: items -> - let matches, vars = matchPattern pat item - if matches then - let matchesRest, varsRest = matchList otherPats items - if matchesRest then true, vars @ varsRest else false, [] - else - false, [] - - match pat, dv with - | MPVariable name, dv -> true, [ (name, dv) ] - - | MPUnit, DUnit -> true, [] - | MPBool l, DBool r -> l = r, [] - | MPInt8 l, DInt8 r -> l = r, [] - | MPUInt8 l, DUInt8 r -> l = r, [] - | MPInt16 l, DInt16 r -> l = r, [] - | MPUInt16 l, DUInt16 r -> l = r, [] - | MPInt32 l, DInt32 r -> l = r, [] - | MPUInt32 l, DUInt32 r -> l = r, [] - | MPInt64 l, DInt64 r -> l = r, [] - | MPUInt64 l, DUInt64 r -> l = r, [] - | MPInt128 l, DInt128 r -> l = r, [] - | MPUInt128 l, DUInt128 r -> l = r, [] - | MPFloat l, DFloat r -> l = r, [] - | MPChar l, DChar r -> l = r, [] - | MPString l, DString r -> l = r, [] - - | MPList pats, DList(_, items) -> matchList pats items - - | MPListCons(head, tail), DList(vt, items) -> - match items with - | [] -> false, [] - | headItem :: tailItems -> - let matchesHead, varsHead = matchPattern head headItem - if matchesHead then - let matchesTail, varsTail = matchPattern tail (DList(vt, tailItems)) - if matchesTail then true, varsHead @ varsTail else false, [] - else - false, [] - - | MPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> - match matchPattern first firstVal, matchPattern second secondVal with - | (true, varsFirst), (true, varsSecond) -> - match matchList theRest theRestVal with - | true, varsRest -> true, varsFirst @ varsSecond @ varsRest - | false, _ -> false, [] - | _ -> false, [] - - // Dval didn't match the pattern even in a basic sense - | _ -> false, [] - - - let matches, vars = matchPattern pat vmState.registers[valueReg] + | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> + let matches, vars = + checkAndExtractMatchPattern pat vmState.registers[valueReg] if matches then vmState <- @@ -204,20 +249,20 @@ let rec private execute counter <- counter + failJump + 1 - | ExtractTupleItems(extractFrom, firstReg, secondReg, restRegs) -> - match vmState.registers[extractFrom] with - | DTuple(first, second, rest) -> - vmState.registers[firstReg] <- first - vmState.registers[secondReg] <- second - - List.zip restRegs rest - |> List.iter (fun (reg, value) -> vmState.registers[reg] <- value) + | CheckLetPatternAndExtractVars(valueReg, pat) -> + let matches, vars = checkAndExtractLetPattern pat vmState.registers[valueReg] + if matches then + vmState <- + vars + |> List.fold + (fun vmState (varName, value) -> + { vmState with + symbolTable = Map.add varName value vmState.symbolTable }) + vmState counter <- counter + 1 - | _ -> - // TODO - rte <- - Some(RuntimeError.oldError "Error: Expected a tuple for decomposition") + else + rte <- Some(RuntimeError.oldError "Let Pattern did not match") | Fail _rte -> rte <- Some(RuntimeError.oldError "TODO") diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 0f6eaa369d..c14560896d 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -130,42 +130,18 @@ module TypeReference = module LetPattern = - let rec toRT - (rc : int) - (pat : PT.LetPattern) - (rhsReg : RT.Register) // what we're binding to - : (int * RT.Instructions) = - match pat with - // No binding needed for unit pattern - // (would also be the case if we have a `_ignore` pattern later) - | PT.LPUnit _ -> (rc, []) - - | PT.LPTuple(_id, first, second, theRest) -> - // reserve the first two registers - // TODO: why do we actually need registers, when we're just assigning variables? - // If RT.LetPattern were more like RT.MatchPattern, we could simply have one instruction that - // assigns the variables in one fell swoop, failing if anything doesn't deconstruct properly. - let firstReg, secondReg, rc = rc, rc + 1, rc + 2 - - let (rcAfterFirst, firstInstrs) = toRT rc first firstReg - let (rcAfterSecond, secondInstrs) = toRT rcAfterFirst second secondReg - - let (finalRc, restInstrs, restRegs) = - theRest - |> List.fold - (fun (currentRc, instrs, regs) restPattern -> - let restReg = currentRc - let (rcAfterPat, patternInstrs) = - toRT (currentRc + 1) restPattern restReg - (rcAfterPat, instrs @ patternInstrs, regs @ [ restReg ])) - (rcAfterSecond, [], []) + let rec toRT (p : PT.LetPattern) : RT.LetPattern = + match p with + | PT.LPUnit _ -> RT.LPUnit - let extractInstructions = - [ RT.ExtractTupleItems(rhsReg, firstReg, secondReg, restRegs) ] + | PT.LPTuple(_, first, second, theRest) -> + RT.LPTuple(toRT first, toRT second, List.map toRT theRest) - (finalRc, extractInstructions @ firstInstrs @ secondInstrs @ restInstrs) + | PT.LPVariable(_, name) -> RT.LPVariable name - | PT.LPVariable(_id, varName) -> (rc, [ RT.SetVar(varName, rhsReg) ]) + + let toInstr (valueReg : RT.Register) (p : PT.LetPattern) : RT.Instruction = + RT.CheckLetPatternAndExtractVars(valueReg, toRT p) @@ -202,11 +178,11 @@ module MatchPattern = let toMatchInstr - (p : PT.MatchPattern) (valueReg : RT.Register) - (jumpByFail) + (p : PT.MatchPattern) + (jumpByFail : int) : RT.Instruction = - RT.MatchValue(valueReg, toRT p, jumpByFail) + RT.CheckMatchPatternAndExtractVars(valueReg, toRT p, jumpByFail) module MatchCase = @@ -306,34 +282,32 @@ module Expr = | PT.EList(_id, items) -> let listReg = rc - let init = (rc + 1, [ RT.LoadVal(listReg, RT.DList(VT.unknown, [])) ]) + let init = (rc + 1, [], []) - let (regCounter, instrs) = + let (regCounter, instrs, itemResultRegs) = items |> List.fold - (fun (rc, instrs) item -> + (fun (rc, instrs, itemResultRegs) item -> let (newRc, itemInstrs, innerResultReg) = toRT rc item - (newRc, - instrs @ itemInstrs @ [ RT.AddItemToList(listReg, innerResultReg) ])) + (newRc, instrs @ itemInstrs, itemResultRegs @ [ innerResultReg ])) init - (regCounter, instrs, listReg) + (regCounter, instrs @ [ RT.CreateList(listReg, itemResultRegs) ], listReg) | PT.EDict(_id, items) -> let dictReg = rc - let init = (rc + 1, [ RT.LoadVal(dictReg, RT.DDict(VT.unknown, Map.empty)) ]) + let init = (rc + 1, [], []) - let (regCounter, instrs) = + let (regCounter, instrs, entryPairs) = items |> List.fold - (fun (rc, instrs) (key, value) -> + (fun (rc, instrs, entryPairs) (key, value) -> let (newRc, valueInstrs, valueReg) = toRT rc value - (newRc, - instrs @ valueInstrs @ [ RT.AddDictEntry(dictReg, key, valueReg) ])) + (newRc, instrs @ valueInstrs, entryPairs @ [ (key, valueReg) ])) init - (regCounter, instrs, dictReg) + (regCounter, instrs @ [ RT.CreateDict(dictReg, entryPairs) ], dictReg) | PT.ETuple(_id, first, second, theRest) -> @@ -365,9 +339,9 @@ module Expr = // let x = 1 | PT.ELet(_id, pat, expr, body) -> let (regCounter, exprInstrs, exprReg) = toRT rc expr - let (regCounter, patInstrs) = LetPattern.toRT regCounter pat exprReg + let patInstr = LetPattern.toInstr exprReg pat let (regCounter, bodyInstrs, bodyExprReg) = toRT regCounter body - (regCounter, exprInstrs @ patInstrs @ bodyInstrs, bodyExprReg) + (regCounter, exprInstrs @ [ patInstr ] @ bodyInstrs, bodyExprReg) | PT.EVariable(_id, varName) -> @@ -502,7 +476,7 @@ module Expr = let rcAfterRhs, rhsInstrs, rhsResultReg = toRT rcAfterWhenCond c.rhs // return the intermediate results, as far along as they are - { matchValueInstrFn = MatchPattern.toMatchInstr c.pat exprResultReg + { matchValueInstrFn = MatchPattern.toMatchInstr exprResultReg c.pat whenCondInstructions = whenCondInstrs whenCondJump = whenCondJump rhsInstrs = rhsInstrs @ [ RT.CopyVal(resultReg, rhsResultReg) ] diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 40b45fc016..00b0685e37 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -379,53 +379,16 @@ module ValueType = // Exprs // ------------ -// /// The LHS pattern in -// /// - a `let` binding (in `let x = 1`, the `x`) -// /// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` -// type LetPattern = -// | LPUnit of id -// | LPTuple of -// id * -// first : LetPattern * -// second : LetPattern * -// theRest : List -// | LPVariable of id * name : string - - -// /// The LHS of a `match` case -// /// -// /// i.e. the `true` (`MPBool true`) in -// /// ```fsharp -// /// match x with -// /// | true -> "some text" -// /// ``` -// type MatchPattern = -// | MPUnit of id - -// | MPBool of id * bool -// | MPInt8 of id * int8 -// | MPUInt8 of id * uint8 -// | MPInt16 of id * int16 -// | MPUInt16 of id * uint16 -// | MPInt32 of id * int32 -// | MPUInt32 of id * uint32 -// | MPInt64 of id * int64 -// | MPUInt64 of id * uint64 -// | MPInt128 of id * System.Int128 -// | MPUInt128 of id * System.UInt128 - -// | MPFloat of id * double - -// | MPChar of id * string -// | MPString of id * string +/// The LHS pattern in +/// - a `let` binding (in `let x = 1`, the `x`) +/// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` +type LetPattern = + | LPUnit + //| LPParens of inner : LetPattern + | LPTuple of first : LetPattern * second : LetPattern * theRest : List + | LPVariable of name : string -// | MPList of id * List -// | MPListCons of id * head : MatchPattern * tail : MatchPattern -// | MPTuple of id * MatchPattern * MatchPattern * List -// | MPEnum of id * caseName : string * fieldPatterns : List - -// | MPVariable of id * string // ------------ @@ -551,15 +514,8 @@ and Instruction = | GetVar of loadTo : Register * varName : string - /// Add an item to an existing list - /// , and type-check to make sure it matches the ValueType of that list - /// - /// Note: lists are _created_ with `LoadVal` - /// (always an empty list of unknown type, to ensure type safety) - /// - /// TODO consider removing in favor of a bulk `CreateList` instruction. - /// Not sure what we're getting from this. - | AddItemToList of listRegister : Register * itemToAdd : Register + /// Create a list, and type-check to ensure the items are of a consistent type + | CreateList of listRegister : Register * itemsToAdd : List | CreateTuple of createTo : Register * @@ -567,12 +523,8 @@ and Instruction = second : Register * theRest : List - /// Add an item to an existing dict - /// , and type-check to make sure it matches the ValueType of that dict - /// - /// Note: dicts are _created_ with `LoadVal` - /// (always an empty dict of unknown type, to ensure type safety) - | AddDictEntry of dictRegister : Register * key : string * entryToAdd : Register + /// Create a dict, and type-check to ensure the entries are of a consistent type + | CreateDict of dictRegister : Register * entries : List | CopyVal of copyTo : Register * copyFrom : Register @@ -582,11 +534,7 @@ and Instruction = /// Go n instructions forward, unconditionally | JumpBy of instrsToJump : int - | ExtractTupleItems of - extractFrom : Register * - firstReg : Register * - secondReg : Register * - restRegs : List + | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern /// Apply some args (and maybe type args) to something /// (a named function, or lambda, etc) @@ -601,10 +549,11 @@ and Instruction = /// Check if the value in the noted register the noted pattern, /// and extract vars per MPVariable as relevant. - | MatchValue of - valueReg : Register * // what we're matching against + | CheckMatchPatternAndExtractVars of + // what we're matching against + valueReg : Register * pat : MatchPattern * - //successJump : int * + // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) failJump : int /// Could not find matching case in a match expression @@ -925,82 +874,6 @@ type Deprecation<'name> = // type T = { typeParams : List; definition : Definition } -// // Functions for working with Dark runtime expressions -// module Expr = -// let toID (expr : Expr) : id = -// match expr with -// | EUnit id - -// | EBool(id, _) - -// // | EInt8(id, _) -// // | EUInt8(id, _) -// // | EInt16(id, _) -// // | EUInt16(id, _) -// // | EInt32(id, _) -// // | EUInt32(id, _) -// | EInt64(id, _) -// // | EUInt64(id, _) -// // | EInt128(id, _) -// // | EUInt128(id, _) - -// // | EFloat(id, _) - -// // | EChar(id, _) -// | EString(id, _) - -// // | EConstant(id, _) -// // | EVariable(id, _) -// // | ERecordFieldAccess(id, _, _) -// // | ELambda(id, _, _) -// // | ELet(id, _, _, _) -// // | EIf(id, _, _, _) -// | EApply(id, _, _, _) -// | EFnName(id, _) -// // | EList(id, _) -// // | ETuple(id, _, _, _) -// // | ERecord(id, _, _) -// // | ERecordUpdate(id, _, _) -// // | EDict(id, _) -// // | EEnum(id, _, _, _) -// // | EMatch(id, _, _) -// | EError(id, _, _) -// // | EAnd(id, _, _) -// // | EOr(id, _, _) -// -> id - -// // Functions for working with Dark Let patterns -// module LetPattern = -// let toID (pat : LetPattern) : id = -// match pat with -// | LPVariable(id, _) -> id -// | LPUnit id -> id -// | LPTuple(id, _, _, _) -> id - -// // Functions for working with Dark match patterns -// module MatchPattern = -// let toID (pat : MatchPattern) : id = -// match pat with -// | MPInt64(id, _) -// | MPUInt64(id, _) -// | MPInt8(id, _) -// | MPUInt8(id, _) -// | MPInt16(id, _) -// | MPUInt16(id, _) -// | MPInt32(id, _) -// | MPUInt32(id, _) -// | MPInt128(id, _) -// | MPUInt128(id, _) -// | MPString(id, _) -// | MPChar(id, _) -// | MPBool(id, _) -// | MPUnit id -// | MPFloat(id, _) -// | MPVariable(id, _) -// | MPTuple(id, _, _, _) -// | MPEnum(id, _, _) -// | MPListCons(id, _, _) -// | MPList(id, _) -> id // Functions for working with Dark runtime values module Dval = diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index 8e6ac1c0f6..d6f26f3c64 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -515,51 +515,51 @@ let checkFunctionReturnType unify context types tst fn.returnType result -// /// Helpers for creating type-checked Dvals -// /// (lists, records, enums, etc.) -// /// -// /// Dvals should be created carefully: -// /// - to have the correct valueTypes, where appropriate -// /// i.e. we should not have DList(Known KTInt64, [ DString("hi") ]) -// /// -// /// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes -// /// i.e. `List.append [1] ["hi"]` should fail -// /// because we can't merge `Known KTInt64` and `Known KTString` -// /// -// /// These functions are intended to help with both of these, in cases where -// /// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types -// /// of a Dval in some F# code). -// /// -// /// TODO: review _all_ usages of these functions -// /// -// /// TODO: ideally we don't require a callStack to be input here -- too much data-passing -// /// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) -// module DvalCreator = -// // let list -// // (callStack : CallStack) -// // (initialType : ValueType) -// // (list : List) -// // : Dval = -// // let (typ, dvs) = -// // List.fold -// // (fun (typ, list) dv -> -// // let dvalType = Dval.toValueType dv - -// // match VT.merge typ dvalType with -// // | Ok newType -> newType, dv :: list -// // | Error() -> -// // RuntimeError.oldError -// // $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" -// // |> raiseRTE callStack) -// // (initialType, []) -// // (List.rev list) - -// // DList(typ, dvs) - - -// // let dict (typ : ValueType) (entries : List) : Dval = -// // // TODO: dictPush, etc. -// // DDict(typ, Map entries) +/// Helpers for creating type-checked Dvals +/// (lists, records, enums, etc.) +/// +/// Dvals should be created carefully: +/// - to have the correct valueTypes, where appropriate +/// i.e. we should not have DList(Known KTInt64, [ DString("hi") ]) +/// +/// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes +/// i.e. `List.append [1] ["hi"]` should fail +/// because we can't merge `Known KTInt64` and `Known KTString` +/// +/// These functions are intended to help with both of these, in cases where +/// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types +/// of a Dval in some F# code). +/// +/// TODO: review _all_ usages of these functions +/// +/// TODO: ideally we don't require a callStack to be input here -- too much data-passing +/// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) +module DvalCreator = + let list + (callStack : CallStack) + (initialType : ValueType) + (list : List) + : Dval = + let (typ, dvs) = + List.fold + (fun (typ, list) dv -> + let dvalType = Dval.toValueType dv + + match VT.merge typ dvalType with + | Ok newType -> newType, dv :: list + | Error() -> + RuntimeError.oldError + $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" + |> raiseRTE callStack) + (initialType, []) + (List.rev list) + + DList(typ, dvs) + + + let dict (typ : ValueType) (entries : List) : Dval = + // TODO: dictPush, etc. + DDict(typ, Map entries) // // let dictFromMap (typ : ValueType) (entries : Map) : Dval = // // // TODO: dictPush, etc. diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 7f3cccbea6..6fc9130100 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -34,16 +34,16 @@ let boolList = t "[true; false; true]" E.boolList - (RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ])) + (RT.DList(VT.bool, [ RT.DBool true; RT.DBool false; RT.DBool true ])) let boolListList = t "[[true; false]; [false; true]]" E.boolListList (RT.DList( - VT.unknown, - [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) - RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] + VT.list VT.bool, + [ RT.DList(VT.bool, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.bool, [ RT.DBool false; RT.DBool true ]) ] )) let letSimple = t "let x = true\nx" E.letSimple (RT.DBool true) let letTuple = t "let (x, y) = (1, 2)\nx" E.letTuple (RT.DInt64 1L) @@ -129,7 +129,7 @@ let matchListCons = t "match [1, 2] with\n| 1 :: tail -> tail" E.matchListCons - (RT.DList(VT.unknown, [ RT.DInt64 2L ])) + (RT.DList(VT.int64, [ RT.DInt64 2L ])) let matchTuple = t diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index fe8cda20c0..b90ffe1bda 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -185,7 +185,7 @@ let letSimple = E.letSimple (2, [ RT.LoadVal(0, RT.DBool true) - RT.SetVar("x", 0) // where the 'true' is stored + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") RT.GetVar(1, "x") ], 1) @@ -193,23 +193,24 @@ let letTuple = t "let (x, y) = (1, 2)\nx" E.letTuple - (6, + (4, [ // register 0 isn't exposed, but used to temporarily store the tuple RT.LoadVal(1, RT.DInt64 1L) RT.LoadVal(2, RT.DInt64 2L) RT.CreateTuple(0, 1, 2, []) - RT.ExtractTupleItems(0, 3, 4, []) - RT.SetVar("x", 3) - RT.SetVar("y", 4) + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple(RT.LPVariable "x", RT.LPVariable "y", []) + ) - RT.GetVar(5, "x") ], - 5) + RT.GetVar(3, "x") ], + 3) let letTupleNested = t "let (a, (b, c)) = (1, (2, 3)) in b" E.letTupleNested - (10, + (6, [ // reserve 0 for outer tuple RT.LoadVal(1, RT.DInt64 1L) // reserve 2 for inner tuple @@ -217,29 +218,26 @@ let letTupleNested = RT.LoadVal(4, RT.DInt64 3L) RT.CreateTuple(2, 3, 4, []) // create inner tuple RT.CreateTuple(0, 1, 2, []) // create outer tuple - RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items - RT.SetVar("a", 5) - RT.ExtractTupleItems(6, 7, 8, []) - RT.SetVar("b", 7) - RT.SetVar("c", 8) - RT.GetVar(9, "b") ], - 9) + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple( + RT.LPVariable "a", + RT.LPTuple(RT.LPVariable "b", RT.LPVariable "c", []), + [] + ) + ) + RT.GetVar(5, "b") ], + 5) let boolList = t "[true, false, true]" E.boolList (4, - [ RT.LoadVal(0, RT.DList(VT.unknown, [])) - - RT.LoadVal(1, RT.DBool true) - RT.AddItemToList(0, 1) - + [ RT.LoadVal(1, RT.DBool true) RT.LoadVal(2, RT.DBool false) - RT.AddItemToList(0, 2) - RT.LoadVal(3, RT.DBool true) - RT.AddItemToList(0, 3) ], + RT.CreateList(0, [ 1; 2; 3 ]) ], 0) let boolListList = @@ -247,26 +245,18 @@ let boolListList = "[[true; false]; [false; true]]" E.boolListList (7, - [ // create outer list - RT.LoadVal(0, RT.DList(VT.unknown, [])) - - // first inner list - RT.LoadVal(1, RT.DList(VT.unknown, [])) + [ // first inner list RT.LoadVal(2, RT.DBool true) - RT.AddItemToList(1, 2) RT.LoadVal(3, RT.DBool false) - RT.AddItemToList(1, 3) - // add it to outer - RT.AddItemToList(0, 1) + RT.CreateList(1, [ 2; 3 ]) // second inner list - RT.LoadVal(4, RT.DList(VT.unknown, [])) RT.LoadVal(5, RT.DBool false) - RT.AddItemToList(4, 5) RT.LoadVal(6, RT.DBool true) - RT.AddItemToList(4, 6) - // add it to outer - RT.AddItemToList(0, 4) ], + RT.CreateList(4, [ 5; 6 ]) + + // outer list + RT.CreateList(0, [ 1; 4 ]) ], 0) @@ -288,50 +278,43 @@ let stringWithInterpolation = [ RT.LoadVal(0, RT.DString "") RT.LoadVal(1, RT.DString ", world") RT.AppendString(0, 1) - RT.SetVar("x", 0) + + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") + RT.LoadVal(2, RT.DString "") RT.LoadVal(3, RT.DString "hello") RT.AppendString(2, 3) + RT.GetVar(4, "x") RT.AppendString(2, 4) ], 2) -let dictEmpty = - t "Dict {}" E.dictEmpty (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) +let dictEmpty = t "Dict {}" E.dictEmpty (1, [ RT.CreateDict(0, []) ], 0) let dictSimple = t "Dict { t: true}" E.dictSimple - (2, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "key", 1) ], - 0) + (2, [ RT.LoadVal(1, RT.DBool true); RT.CreateDict(0, [ ("key", 1) ]) ], 0) let dictMultEntries = t "Dict {t: true; f: false}" E.dictMultEntries (3, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) + [ RT.LoadVal(1, RT.DBool true) RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) ], + RT.CreateDict(0, [ ("t", 1); ("f", 2) ]) ], 0) let dictDupeKey = t "Dict {t: true; f: false; t: true}" E.dictDupeKey (4, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) + [ RT.LoadVal(1, RT.DBool true) RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) RT.LoadVal(3, RT.DBool false) - RT.AddDictEntry(0, "t", 3) ], + RT.CreateDict(0, [ ("t", 1); ("f", 2); ("t", 3) ]) ], 0) let ifGotoThenBranch = @@ -443,7 +426,7 @@ let matchSimple = RT.LoadVal(0, RT.DBool true) // FIRST BRANCH - RT.MatchValue(0, RT.MPBool false, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) // rhs RT.LoadVal(2, RT.DString "") RT.LoadVal(3, RT.DString "first branch") @@ -452,7 +435,7 @@ let matchSimple = RT.JumpBy 7 // SECOND BRANCH - RT.MatchValue(0, RT.MPBool true, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 5) // rhs RT.LoadVal(2, RT.DString "") RT.LoadVal(3, RT.DString "second branch") @@ -473,7 +456,7 @@ let matchNotMatched = RT.LoadVal(0, RT.DBool true) // FIRST BRANCH - RT.MatchValue(0, RT.MPBool false, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) // rhs RT.LoadVal(2, RT.DString "") RT.LoadVal(3, RT.DString "first branch") @@ -492,7 +475,7 @@ let matchWithVar = (3, [ RT.LoadVal(0, RT.DBool true) - RT.MatchValue(0, RT.MPVariable "x", 3) + RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) RT.GetVar(2, "x") RT.CopyVal(1, 2) RT.JumpBy 1 @@ -508,7 +491,7 @@ let matchWithVarAndWhenCondition = [ RT.LoadVal(0, RT.DInt64 4L) // first branch - RT.MatchValue(0, RT.MPInt64 1L, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) RT.LoadVal(2, RT.DString "") RT.LoadVal(3, RT.DString "first branch") RT.AppendString(2, 3) @@ -516,7 +499,7 @@ let matchWithVarAndWhenCondition = RT.JumpBy 14 // second branch - RT.MatchValue(0, RT.MPVariable "x", 12) + RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) RT.GetVar(4, "x") @@ -540,14 +523,16 @@ let matchList = E.matchList (6, [ // expr, whose result we store in 0 - RT.LoadVal(0, RT.DList(VT.unknown, [])) RT.LoadVal(1, RT.DInt64 1L) - RT.AddItemToList(0, 1) RT.LoadVal(2, RT.DInt64 2L) - RT.AddItemToList(0, 2) + RT.CreateList(0, [ 1; 2 ]) // first branch - RT.MatchValue(0, RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], 5) + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], + 5 + ) RT.LoadVal(4, RT.DString "") RT.LoadVal(5, RT.DString "first branch") RT.AppendString(4, 5) @@ -564,14 +549,16 @@ let matchListCons = E.matchListCons (5, [ // expr, whose result we store in 0 - RT.LoadVal(0, RT.DList(VT.unknown, [])) RT.LoadVal(1, RT.DInt64 1L) - RT.AddItemToList(0, 1) RT.LoadVal(2, RT.DInt64 2L) - RT.AddItemToList(0, 2) + RT.CreateList(0, [ 1; 2 ]) // first branch - RT.MatchValue(0, RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), 3) + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), + 3 + ) RT.GetVar(4, "tail") RT.CopyVal(3, 4) RT.JumpBy 1 @@ -591,7 +578,11 @@ let matchTuple = RT.CreateTuple(0, 1, 2, []) // first branch - RT.MatchValue(0, RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), 5) + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), + 5 + ) RT.LoadVal(4, RT.DString "") RT.LoadVal(5, RT.DString "first branch") RT.AppendString(4, 5) diff --git a/tree-sitter-darklang/package-lock.json b/tree-sitter-darklang/package-lock.json index b15741a1bd..f2cf375bca 100644 --- a/tree-sitter-darklang/package-lock.json +++ b/tree-sitter-darklang/package-lock.json @@ -28,6 +28,7 @@ "integrity": "sha512-XjTcS3wdTy/2cc/ptMLc/WRyOLECRYcMTrSWyhZnj1oGSOWbHLTklgsgRICU3cPfb0vy+oZCC33M43u6R1HSCA==", "dev": true, "hasInstallScript": true, + "license": "MIT", "bin": { "tree-sitter": "cli.js" } From ab40164c72cf70e03bac43277d2d46e6ccc69eea Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 20 Aug 2024 21:30:31 -0400 Subject: [PATCH 17/60] Interpreter rewrite: tests, RTEs, let exprs --- backend/src/LibExecution/Execution.fs | 41 +- backend/src/LibExecution/Interpreter.fs | 21 +- backend/src/LibExecution/ProgramTypes.fs | 17 +- backend/src/LibExecution/RuntimeTypes.fs | 16 +- backend/tests/Tests/Interpreter.Tests.fs | 357 ++++--- backend/tests/Tests/PT2RT.Tests.fs | 1080 ++++++++++------------ backend/tests/Tests/TestValues.fs | 183 ++++ backend/tests/Tests/Tests.fsproj | 1 + notes.dark | 281 ++++++ 9 files changed, 1232 insertions(+), 765 deletions(-) create mode 100644 backend/tests/Tests/TestValues.fs create mode 100644 notes.dark diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 023494aded..3a8267ee5a 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -39,6 +39,8 @@ let createState types = { typeSymbolTable = Map.empty } fns = { builtIn = builtins.fns; package = packageManager.getFn } } + + let executeExpr (exeState : RT.ExecutionState) (inputVars : RT.Symtable) @@ -62,8 +64,18 @@ let executeExpr let! result = Interpreter.eval exeState vmState return Ok result - with RT.RuntimeErrorException(source, rte) -> - return Error(source, rte) + + with + | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) + | ex -> + let context : Metadata = + //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] + [] + exeState.reportException exeState context ex + return + RT.raiseRTE + exeState.tracing.callStack + (RT.RuntimeError.oldError "Unknown error") finally // Does nothing in non-tests exeState.test.postTestExecutionHook exeState.test @@ -71,7 +83,7 @@ let executeExpr let executeFunction - (state : RT.ExecutionState) + (exeState : RT.ExecutionState) (name : RT.FQFnName.FQFnName) (typeArgs : List) (args : NEList) @@ -79,22 +91,31 @@ let executeFunction task { try try - let state = - { state with + let exeState = + { exeState with tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } let! result = Interpreter.call - state - RT.VMState.empty + exeState + RT.VMState.empty // ok? (RT.DFnVal(RT.NamedFn name)) typeArgs args return Ok result - with RT.RuntimeErrorException(source, rte) -> - return Error(source, rte) + with + | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) + | ex -> + let context : Metadata = + //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] + [] + exeState.reportException exeState context ex + return + RT.raiseRTE + exeState.tracing.callStack + (RT.RuntimeError.oldError "Unknown error") finally // Does nothing in non-tests - state.test.postTestExecutionHook state.test + exeState.test.postTestExecutionHook exeState.test } diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 49dfeca129..9027d9c9a4 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -41,6 +41,7 @@ let rec checkAndExtractLetPattern | _ -> false, [] | _ -> false, [] + let rec checkAndExtractMatchPattern (pat : MatchPattern) (dv : Dval) @@ -139,15 +140,12 @@ let rec private execute // later, `x` | GetVar(loadTo, varName) -> - let value = - Map.find varName vmState.symbolTable - // TODO: handle missing variable - //return errStr callStack $"There is no variable named: {name}" - |> Option.defaultValue DUnit - - vmState.registers[loadTo] <- value - - counter <- counter + 1 + match Map.find varName vmState.symbolTable with + | Some value -> + vmState.registers[loadTo] <- value + counter <- counter + 1 + | None -> + rte <- Some(RuntimeError.oldError ("Variable not found: " + varName)) // `add (increment 1L) (3L)` and store results in `putResultIn` @@ -272,10 +270,7 @@ let rec private execute // If we've reached the end of the instructions, return the result match rte with | None -> return vmState.registers[vmState.resultReg] - | Some rte -> - // TODO - //return raiseRTE exeState.tracing.callStack rte - return RuntimeError.toDT rte + | Some rte -> return raiseRTE exeState.tracing.callStack rte } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 24045c2b83..6f6e82fd68 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -115,14 +115,27 @@ module FQFnName = type NameResolution<'a> = Result<'a, NameResolutionError.Error> + type LetPattern = - | LPUnit of id + /// `let x = 1` + | LPVariable of id * name : string + + // /// `let _ignored = 1` + // | LPIgnored + + /// let (x) = 1 + //| LPParens of inner : LetPattern + + /// `let (x, _) = (1, 2)` | LPTuple of id * first : LetPattern * second : LetPattern * theRest : List - | LPVariable of id * name : string + + /// `let () = ()` + | LPUnit of id + /// Used for pattern matching in a match statement type MatchPattern = diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 00b0685e37..29ef460c60 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -383,11 +383,19 @@ module ValueType = /// - a `let` binding (in `let x = 1`, the `x`) /// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` type LetPattern = - | LPUnit - //| LPParens of inner : LetPattern - | LPTuple of first : LetPattern * second : LetPattern * theRest : List + /// `let x = 1` | LPVariable of name : string + // /// `let _ = 1` + // | LPIgnored + + /// `let (x, y) = (1, 2)` + | LPTuple of first : LetPattern * second : LetPattern * theRest : List + + /// `let () = ()` + | LPUnit + + @@ -782,7 +790,7 @@ module RuntimeError = let toDT (RuntimeError e : RuntimeError) : Dval = e - // let fromDT (dv : Dval) : RuntimeError = RuntimeError dv + let fromDT (dv : Dval) : RuntimeError = RuntimeError dv // let case (caseName : string) (fields : List) : RuntimeError = // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 6fc9130100..ec0804bdec 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -9,159 +9,232 @@ module RT = LibExecution.RuntimeTypes module VT = RT.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module E = Tests.ProgramTypesToRuntimeTypes.Expressions +module E = TestValues.Expressions -let eval pt = - uply { - let vmState = pt |> PT2RT.Expr.toRT 0 |> RT.VMState.fromInstructions +let t name ptExpr expectedInsts = + testTask name { + let vmState = ptExpr |> PT2RT.Expr.toRT 0 |> RT.VMState.fromInstructions - let! executionState = + let! exeState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false - return! LibExecution.Interpreter.eval executionState vmState + let! actual = LibExecution.Interpreter.eval exeState vmState |> Ply.toTask + return Expect.equal actual expectedInsts "" } -let t name expr expected = +let tFail name ptExpr expectedRte = testTask name { - let! actual = eval expr |> Ply.toTask - return Expect.equal actual expected "" + let instructionsWithContext = ptExpr |> PT2RT.Expr.toRT 0 + + let! exeState = + executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false + + let! actual = + LibExecution.Execution.executeExpr exeState Map.empty instructionsWithContext + + match actual with + | Ok _ -> return Expect.equal 1 2 "Expected an RTE, but got a successful result" + | Error(_cs, actualRte) -> return Expect.equal actualRte expectedRte "" } -let onePlusTwo = t "1+2" E.onePlusTwo (RT.DInt64 3L) - -let boolList = - t - "[true; false; true]" - E.boolList - (RT.DList(VT.bool, [ RT.DBool true; RT.DBool false; RT.DBool true ])) - -let boolListList = - t - "[[true; false]; [false; true]]" - E.boolListList - (RT.DList( - VT.list VT.bool, - [ RT.DList(VT.bool, [ RT.DBool true; RT.DBool false ]) - RT.DList(VT.bool, [ RT.DBool false; RT.DBool true ]) ] - )) -let letSimple = t "let x = true\nx" E.letSimple (RT.DBool true) -let letTuple = t "let (x, y) = (1, 2)\nx" E.letTuple (RT.DInt64 1L) -let letTupleNested = - t "let (a, (b, c)) = (1, (2, 3))\nb" E.letTupleNested (RT.DInt64 2L) - -let simpleString = t "[\"hello\"]" E.simpleString (RT.DString "hello") - -let stringWithInterpolation = - t - "[let x = \"world\" in $\"hello {x}\"]" - E.stringWithInterpolation - (RT.DString "hello, world") - -let dictEmpty = t "Dict {}" E.dictEmpty (RT.DDict(VT.unknown, Map.empty)) -let dictSimple = - t - "Dict { t: true}" - E.dictSimple - (RT.DDict(VT.unknown, Map [ "key", RT.DBool true ])) -let dictMultEntries = - t - "Dict {t: true; f: false}" - E.dictMultEntries - (RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ])) -let dictDupeKey = - t - "Dict {t: true; f: false; t: false}" - E.dictDupeKey - (RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ])) - - -let ifGotoThenBranch = t "if true then 1 else 2" E.ifGotoThenBranch (RT.DInt64 1L) - -let ifGotoElseBranch = t "if false then 1 else 2" E.ifGotoElseBranch (RT.DInt64 2L) -let ifElseMissing = t "if false then 1" E.ifElseMissing RT.DUnit - -let tuple2 = - t "(false, true)" E.tuple2 (RT.DTuple(RT.DBool false, RT.DBool true, [])) - -let tuple3 = - t - "(false, true, false)" - E.tuple3 - (RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ])) -let tupleNested = - t - "((false, true), true, (true, false)))" - E.tupleNested - (RT.DTuple( - RT.DTuple(RT.DBool false, RT.DBool true, []), - RT.DBool true, - [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] - )) - -let matchSimple = - t - "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" - E.matchSimple - (RT.DString "second branch") - -let matchNotMatched = - t - "match true with\n| false -> \"first branch\"" - E.matchNotMatched - (RT.DString "match not matched") - -let matchWithVar = t "match true with\n| x -> x" E.matchWithVar (RT.DBool true) - -let matchWithVarAndWhenCondition = - t - "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - E.matchWithVarAndWhenCondition - (RT.DString "second branch") - -let matchList = - t - "match [1, 2] with\n| [1, 2] -> \"first branch\"" - E.matchList - (RT.DString "first branch") - -let matchListCons = - t - "match [1, 2] with\n| 1 :: tail -> tail" - E.matchListCons - (RT.DList(VT.int64, [ RT.DInt64 2L ])) - -let matchTuple = - t - "match (1, 2) with\n| (1, 2) -> \"first branch\"" - E.matchTuple - (RT.DString "first branch") +module Basic = + // CLEANUP back fill with more simple stuff + + let onePlusTwo = t "1+2" E.Basic.onePlusTwo (RT.DInt64 3L) + + let tests = testList "Basic" [ onePlusTwo ] + + +module List = + let simple = + t + "[true; false; true]" + E.List.simple + (RT.DList(VT.bool, [ RT.DBool true; RT.DBool false; RT.DBool true ])) + + let nested = + t + "[[true; false]; [false; true]]" + E.List.nested + (RT.DList( + VT.list VT.bool, + [ RT.DList(VT.bool, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.bool, [ RT.DBool false; RT.DBool true ]) ] + )) + + let mixed = + tFail + "[1; true]" + E.List.mixed + (RT.RuntimeError.fromDT ( + RT.DString "Could not merge types List and List" + )) + + let tests = testList "Lists" [ simple; nested; mixed ] + + +module Let = + let simple = t "let x = true\nx" E.Let.simple (RT.DBool true) + + let tuple = t "let (x, y) = (1, 2)\nx" E.Let.tuple (RT.DInt64 1L) + + /// `let (a, b) = 1 in a` + let tupleNotTuple = + tFail + "let (a, b) = 1 in a" + E.Let.tupleNotTuple + (RT.RuntimeError.fromDT (RT.DString "Let Pattern did not match")) + + /// `let (a, b) = (1, 2, 3) in a` + let tupleIncorrectLen = + tFail + "let (a, b) = (1, 2, 3) in a" + E.Let.tupleIncorrectLen + (RT.RuntimeError.fromDT (RT.DString "Let Pattern did not match")) + + let tupleNested = + t "let (a, (b, c)) = (1, (2, 3))\nb" E.Let.tupleNested (RT.DInt64 2L) + + /// `a` + let undefinedVar = + tFail + "a" + E.Let.undefinedVar + (RT.RuntimeError.fromDT (RT.DString "Variable not found: a")) + + let tests = + testList + "Let" + [ simple; tuple; tupleNotTuple; tupleIncorrectLen; tupleNested; undefinedVar ] + + +module String = + let simple = t "[\"hello\"]" E.String.simple (RT.DString "hello") + + let withInterpolation = + t + "[let x = \"world\" in $\"hello {x}\"]" + E.String.withInterpolation + (RT.DString "hello, world") + + let tests = testList "Strings" [ simple; withInterpolation ] + + +module Dict = + let empty = t "Dict {}" E.Dict.empty (RT.DDict(VT.unknown, Map.empty)) + + let simple = + t + "Dict { t: true}" + E.Dict.simple + (RT.DDict(VT.unknown, Map [ "key", RT.DBool true ])) + + let multEntries = + t + "Dict {t: true; f: false}" + E.Dict.multEntries + (RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ])) + + let dupeKey = + t + "Dict {t: true; f: false; t: false}" + E.Dict.dupeKey + (RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ])) + + let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] + + +module If = + let gotoThenBranch = t "if true then 1 else 2" E.If.gotoThenBranch (RT.DInt64 1L) + let gotoElseBranch = t "if false then 1 else 2" E.If.gotoElseBranch (RT.DInt64 2L) + let elseMissing = t "if false then 1" E.If.elseMissing RT.DUnit + + let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] + + +module Tuples = + let two = + t "(false, true)" E.Tuples.two (RT.DTuple(RT.DBool false, RT.DBool true, [])) + + let three = + t + "(false, true, false)" + E.Tuples.three + (RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ])) + + let nested = + t + "((false, true), true, (true, false)))" + E.Tuples.nested + (RT.DTuple( + RT.DTuple(RT.DBool false, RT.DBool true, []), + RT.DBool true, + [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] + )) + + let tests = testList "Tuples" [ two; three; nested ] + + +module Match = + let simple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.Match.simple + (RT.DString "second branch") + + let notMatched = + tFail + "match true with\n| false -> \"first branch\"" + E.Match.notMatched + (RT.RuntimeError.fromDT (RT.DString "match not matched")) + + let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) + + let withVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.Match.withVarAndWhenCondition + (RT.DString "second branch") + + let list = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.Match.list + (RT.DString "first branch") + + let listCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.Match.listCons + (RT.DList(VT.int64, [ RT.DInt64 2L ])) + + let tuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.Match.tuple + (RT.DString "first branch") + + let tests = + testList + "Match" + [ simple + notMatched + withVar + //withVarAndWhenCondition + list + listCons + tuple ] + let tests = testList "Interpreter" - [ onePlusTwo - boolList - boolListList - letSimple - letTuple - letTupleNested - simpleString - stringWithInterpolation - dictEmpty - dictSimple - dictMultEntries - dictDupeKey - ifGotoThenBranch - ifGotoElseBranch - ifElseMissing - tuple2 - tuple3 - tupleNested - matchSimple - matchNotMatched - matchWithVar - //matchWithVarAndWhenCondition - matchList - matchListCons - matchTuple ] + [ Basic.tests + List.tests + Let.tests + String.tests + Dict.tests + If.tests + Tuples.tests + Match.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index b90ffe1bda..2dae5f4d6b 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -10,615 +10,507 @@ module VT = RT.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs -open TestUtils.PTShortcuts +module E = TestValues.Expressions // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists -module Expressions = - let one = eInt64 1 - - let onePlusTwo = - eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) - [] - [ eInt64 1; eInt64 2 ] - - // TODO: try to use undefined variable - // TODO: lpunit - let letSimple = eLet (lpVar "x") (eBool true) (eVar "x") - let letTuple = - eLet - (lpTuple (lpVar "x") (lpVar "y") []) - (eTuple (eInt64 1) (eInt64 2) []) - (eVar "x") - /// `let (a, (b, c)) = (1, (2, 3)) in b` - let letTupleNested = - eLet - (lpTuple (lpVar "a") (lpTuple (lpVar "b") (lpVar "c") []) []) - (eTuple (eInt64 1) (eTuple (eInt64 2) (eInt64 3) []) []) - (eVar "b") - - let boolList = eList [ eBool true; eBool false; eBool true ] - - let boolListList = - eList [ eList [ eBool true; eBool false ]; eList [ eBool false; eBool true ] ] - - let simpleString = eStr [ strText "hello" ] - - let stringWithInterpolation = - eLet - (lpVar "x") - (eStr [ strText ", world" ]) - (eStr [ strText "hello"; strInterp (eVar "x") ]) - - let dictEmpty = eDict [] - let dictSimple = eDict [ "key", eBool true ] - let dictMultEntries = eDict [ "t", eBool true; "f", eBool false ] - let dictDupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] - - let ifGotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) - let ifGotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) - let ifElseMissing = eIf (eBool false) (eInt64 1) None - - /// (false, true) - let tuple2 = eTuple (eBool false) (eBool true) [] - - /// (false, true, false) - let tuple3 = eTuple (eBool false) (eBool true) [ eBool false ] - - /// ((false, true), true, (true, false)) - let tupleNested = - eTuple - (eTuple (eBool false) (eBool true) []) - (eBool true) - [ eTuple (eBool true) (eBool false) [] ] - - /// match true with - /// | false -> "first branch" - /// | true -> "second branch" - let matchSimple = - eMatch - (eBool true) - [ { pat = PT.MPBool(gid (), false) - whenCondition = None - rhs = eStr [ strText "first branch" ] } - { pat = PT.MPBool(gid (), true) - whenCondition = None - rhs = eStr [ strText "second branch" ] } ] - - /// match true with - /// | false -> "first branch" - let matchNotMatched = - eMatch - (eBool true) - [ { pat = PT.MPBool(gid (), false) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - - /// match true with - /// | x -> x - let matchWithVar = - eMatch - (eBool true) - [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] - - /// match 4 with - /// | 1 -> "first branch" - /// | x when x % 2 == 0 -> "second branch" - let matchWithVarAndWhenCondition = - eMatch - (eInt64 4) - [ { pat = PT.MPInt64(gid (), 1) - whenCondition = None - rhs = eStr [ strText "first branch" ] } - { pat = PT.MPVariable(gid (), "x") - // "is even" - whenCondition = - Some( - eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) - [] - [ eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) - [] - [ eVar "x" ] - eInt64 2 ] - ) - rhs = eStr [ strText "second branch" ] } ] - - let matchList = - eMatch - (eList [ eInt64 1; eInt64 2 ]) - [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - let matchListCons = - eMatch - (eList [ eInt64 1; eInt64 2 ]) - [ { pat = - PT.MPListCons( - gid (), - PT.MPInt64(gid (), 1), - PT.MPVariable(gid (), "tail") - ) - whenCondition = None - rhs = eVar "tail" } ] - let matchTuple = - eMatch - (eTuple (eInt64 1) (eInt64 2) []) - [ { pat = PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - -module E = Expressions - - let t name expr expected = testTask name { let actual = PT2RT.Expr.toRT 0 expr return Expect.equal actual expected "" } -let one = t "1" E.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) +module Basic = + let one = t "1" E.Basic.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) + let onePlusTwo = + t + "1+2" + E.Basic.onePlusTwo + (4, + [ RT.LoadVal( + 0, + RT.DFnVal( + RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], + 3) + + let tests = testList "Basic" [ one; onePlusTwo ] + + +module Let = + let simple = + t + "let x = true\n x" + E.Let.simple + (2, + [ RT.LoadVal(0, RT.DBool true) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") + RT.GetVar(1, "x") ], + 1) + + let tuple = + t + "let (x, y) = (1, 2)\nx" + E.Let.tuple + (4, + [ // register 0 isn't exposed, but used to temporarily store the tuple + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple(RT.LPVariable "x", RT.LPVariable "y", []) + ) + + RT.GetVar(3, "x") ], + 3) -let onePlusTwo = - t - "1+2" - E.onePlusTwo - (4, - [ RT.LoadVal( - 0, - RT.DFnVal( - RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + let tupleNested = + t + "let (a, (b, c)) = (1, (2, 3)) in b" + E.Let.tupleNested + (6, + [ // reserve 0 for outer tuple + RT.LoadVal(1, RT.DInt64 1L) + // reserve 2 for inner tuple + RT.LoadVal(3, RT.DInt64 2L) + RT.LoadVal(4, RT.DInt64 3L) + RT.CreateTuple(2, 3, 4, []) // create inner tuple + RT.CreateTuple(0, 1, 2, []) // create outer tuple + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple( + RT.LPVariable "a", + RT.LPTuple(RT.LPVariable "b", RT.LPVariable "c", []), + [] + ) ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], - 3) - -let letSimple = - t - "let x = true\n x" - E.letSimple - (2, - [ RT.LoadVal(0, RT.DBool true) - RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - RT.GetVar(1, "x") ], - 1) - -let letTuple = - t - "let (x, y) = (1, 2)\nx" - E.letTuple - (4, - [ // register 0 isn't exposed, but used to temporarily store the tuple - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - - RT.CheckLetPatternAndExtractVars( - 0, - RT.LPTuple(RT.LPVariable "x", RT.LPVariable "y", []) - ) - - RT.GetVar(3, "x") ], - 3) -let letTupleNested = - t - "let (a, (b, c)) = (1, (2, 3)) in b" - E.letTupleNested - (6, - [ // reserve 0 for outer tuple - RT.LoadVal(1, RT.DInt64 1L) - // reserve 2 for inner tuple - RT.LoadVal(3, RT.DInt64 2L) - RT.LoadVal(4, RT.DInt64 3L) - RT.CreateTuple(2, 3, 4, []) // create inner tuple - RT.CreateTuple(0, 1, 2, []) // create outer tuple - RT.CheckLetPatternAndExtractVars( - 0, - RT.LPTuple( - RT.LPVariable "a", - RT.LPTuple(RT.LPVariable "b", RT.LPVariable "c", []), - [] + RT.GetVar(5, "b") ], + 5) + + let tests = testList "Let" [ simple; tuple; tupleNested ] + + +module List = + let simple = + t + "[true, false, true]" + E.List.simple + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateList(0, [ 1; 2; 3 ]) ], + 0) + + let nested = + t + "[[true; false]; [false; true]]" + E.List.nested + (7, + [ // first inner list + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateList(1, [ 2; 3 ]) + + // second inner list + RT.LoadVal(5, RT.DBool false) + RT.LoadVal(6, RT.DBool true) + RT.CreateList(4, [ 5; 6 ]) + + // outer list + RT.CreateList(0, [ 1; 4 ]) ], + 0) + + let mixed = + t + "[1, true]" + E.List.mixed + (3, + [ RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DBool true) + RT.CreateList(0, [ 1; 2 ]) ], + 0) + + let tests = testList "Lists" [ simple; nested; mixed ] + + +module String = + let simple = + t + "[\"hello\"]" + E.String.simple + (2, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString "hello") + RT.AppendString(0, 1) ], + 0) + + let withInterpolation = + t + "[let x = \"world\"\n$\"hello {x}\"]" + E.String.withInterpolation + (5, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString ", world") + RT.AppendString(0, 1) + + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") + + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "hello") + RT.AppendString(2, 3) + + RT.GetVar(4, "x") + RT.AppendString(2, 4) ], + 2) + + let tests = testList "String" [ simple; withInterpolation ] + + +module Dict = + let empty = t "Dict {}" E.Dict.empty (1, [ RT.CreateDict(0, []) ], 0) + + let simple = + t + "Dict { t: true}" + E.Dict.simple + (2, [ RT.LoadVal(1, RT.DBool true); RT.CreateDict(0, [ ("key", 1) ]) ], 0) + + let multEntries = + t + "Dict {t: true; f: false}" + E.Dict.multEntries + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.CreateDict(0, [ ("t", 1); ("f", 2) ]) ], + 0) + + let dupeKey = + t + "Dict {t: true; f: false; t: true}" + E.Dict.dupeKey + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool false) + RT.CreateDict(0, [ ("t", 1); ("f", 2); ("t", 3) ]) ], + 0) + + let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] + + +module If = + let gotoThenBranch = + t + "if true then 1 else 2" + E.If.gotoThenBranch + (4, + [ // reserve register 0 for the result + + // cond + RT.LoadVal(1, RT.DBool true) + RT.JumpByIfFalse(3, 1) + + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 + + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) + + + let gotoElseBranch = + t + "if false then 1 else 2" + E.If.gotoElseBranch + (4, + [ // cond + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(3, 1) + + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 + + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) + + let elseMissing = + t + "if false then 1" + E.If.elseMissing + (3, + [ RT.LoadVal(0, RT.DUnit) + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(2, 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) ], + 0) + + let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] + + +module Tuples = + let two = + t + "(false, true)" + E.Tuples.two + (3, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.CreateTuple(0, 1, 2, []) ], + 0) + + let three = + t + "(false, true, false)" + E.Tuples.three + (4, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateTuple(0, 1, 2, [ 3 ]) ], + 0) + + let nested = + t + "((false, true), true, (true, false))" + E.Tuples.nested + (8, + [ // 0 "reserved" for outer tuple + + // first inner tuple (1 "reserved") + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateTuple(1, 2, 3, []) + + // middle value + RT.LoadVal(4, RT.DBool true) + + // second inner tuple (5 "reserved") + RT.LoadVal(6, RT.DBool true) + RT.LoadVal(7, RT.DBool false) + RT.CreateTuple(5, 6, 7, []) + + // wrap all in outer tuple + RT.CreateTuple(0, 1, 4, [ 5 ]) ], + 0) + + let tests = testList "Tuples" [ two; three; nested ] + + +module Match = + let simple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.Match.simple + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 7 + + // SECOND BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "second branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + + let notMatched = + t + "match true with\n| false -> \"first branch\"" + E.Match.notMatched + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + + let withVar = + t + "match true with\n| x -> x" + E.Match.withVar + (3, + [ RT.LoadVal(0, RT.DBool true) + + RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) + RT.GetVar(2, "x") + RT.CopyVal(1, 2) + RT.JumpBy 1 + + RT.MatchUnmatched ], + 1) + + let withVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.Match.withVarAndWhenCondition + (10, + [ RT.LoadVal(0, RT.DInt64 4L) + + // first branch + RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 14 + + // second branch + RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) + RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + RT.GetVar(4, "x") + RT.Apply(5, 3, [], NEList.ofList 4 []) + RT.LoadVal(6, RT.DInt64 2L) + RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + RT.JumpByIfFalse(5, 7) + RT.LoadVal(8, RT.DString "") + RT.LoadVal(9, RT.DString "second branch") + RT.AppendString(8, 9) + RT.CopyVal(1, 8) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + + let list = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.Match.list + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateList(0, [ 1; 2 ]) + + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], + 5 ) - ) - RT.GetVar(5, "b") ], - 5) - -let boolList = - t - "[true, false, true]" - E.boolList - (4, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateList(0, [ 1; 2; 3 ]) ], - 0) - -let boolListList = - t - "[[true; false]; [false; true]]" - E.boolListList - (7, - [ // first inner list - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateList(1, [ 2; 3 ]) - - // second inner list - RT.LoadVal(5, RT.DBool false) - RT.LoadVal(6, RT.DBool true) - RT.CreateList(4, [ 5; 6 ]) - - // outer list - RT.CreateList(0, [ 1; 4 ]) ], - 0) - - -let simpleString = - t - "[\"hello\"]" - E.simpleString - (2, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString "hello") - RT.AppendString(0, 1) ], - 0) - -let stringWithInterpolation = - t - "[let x = \"world\"\n$\"hello {x}\"]" - E.stringWithInterpolation - (5, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString ", world") - RT.AppendString(0, 1) - - RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "hello") - RT.AppendString(2, 3) - - RT.GetVar(4, "x") - RT.AppendString(2, 4) ], - 2) - - - -let dictEmpty = t "Dict {}" E.dictEmpty (1, [ RT.CreateDict(0, []) ], 0) -let dictSimple = - t - "Dict { t: true}" - E.dictSimple - (2, [ RT.LoadVal(1, RT.DBool true); RT.CreateDict(0, [ ("key", 1) ]) ], 0) -let dictMultEntries = - t - "Dict {t: true; f: false}" - E.dictMultEntries - (3, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.CreateDict(0, [ ("t", 1); ("f", 2) ]) ], - 0) -let dictDupeKey = - t - "Dict {t: true; f: false; t: true}" - E.dictDupeKey - (4, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool false) - RT.CreateDict(0, [ ("t", 1); ("f", 2); ("t", 3) ]) ], - 0) - -let ifGotoThenBranch = - t - "if true then 1 else 2" - E.ifGotoThenBranch - (4, - [ // reserve register 0 for the result - - // cond - RT.LoadVal(1, RT.DBool true) - RT.JumpByIfFalse(3, 1) - - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 - - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) - - -let ifGotoElseBranch = - t - "if false then 1 else 2" - E.ifGotoElseBranch - (4, - [ // cond - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(3, 1) - - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 - - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) - - -let ifElseMissing = - t - "if false then 1" - E.ifElseMissing - (3, - [ RT.LoadVal(0, RT.DUnit) - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(2, 1) - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) ], - 0) - - -let tuple2 = - t - "(false, true)" - E.tuple2 - (3, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.CreateTuple(0, 1, 2, []) ], - 0) - -let tuple3 = - t - "(false, true, false)" - E.tuple3 - (4, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateTuple(0, 1, 2, [ 3 ]) ], - 0) - -let tupleNested = - t - "((false, true), true, (true, false))" - E.tupleNested - (8, - [ // 0 "reserved" for outer tuple - - // first inner tuple (1 "reserved") - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateTuple(1, 2, 3, []) - - // middle value - RT.LoadVal(4, RT.DBool true) - - // second inner tuple (5 "reserved") - RT.LoadVal(6, RT.DBool true) - RT.LoadVal(7, RT.DBool false) - RT.CreateTuple(5, 6, 7, []) - - // wrap all in outer tuple - RT.CreateTuple(0, 1, 4, [ 5 ]) ], - 0) - -let matchSimple = - t - "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" - E.matchSimple - (4, - [ // handle the value we're matching on - RT.LoadVal(0, RT.DBool true) - - // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) - // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) - RT.CopyVal(1, 2) - RT.JumpBy 7 - - // SECOND BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 5) - // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "second branch") - RT.AppendString(2, 3) - RT.CopyVal(1, 2) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) - -let matchNotMatched = - t - "match true with\n| false -> \"first branch\"" - E.matchNotMatched - (4, - [ // handle the value we're matching on - RT.LoadVal(0, RT.DBool true) - - // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) - // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) - RT.CopyVal(1, 2) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) - -let matchWithVar = - t - "match true with\n| x -> x" - E.matchWithVar - (3, - [ RT.LoadVal(0, RT.DBool true) - - RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) - RT.GetVar(2, "x") - RT.CopyVal(1, 2) - RT.JumpBy 1 - - RT.MatchUnmatched ], - 1) - -let matchWithVarAndWhenCondition = - t - "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - E.matchWithVarAndWhenCondition - (10, - [ RT.LoadVal(0, RT.DInt64 4L) - - // first branch - RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) - RT.CopyVal(1, 2) - RT.JumpBy 14 - - // second branch - RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) - RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) - RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) - RT.GetVar(4, "x") - RT.Apply(5, 3, [], NEList.ofList 4 []) - RT.LoadVal(6, RT.DInt64 2L) - RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) - RT.JumpByIfFalse(5, 7) - RT.LoadVal(8, RT.DString "") - RT.LoadVal(9, RT.DString "second branch") - RT.AppendString(8, 9) - RT.CopyVal(1, 8) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) - -let matchList = - t - "match [1, 2] with\n| [1, 2] -> \"first branch\"" - E.matchList - (6, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateList(0, [ 1; 2 ]) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], - 5 - ) - RT.LoadVal(4, RT.DString "") - RT.LoadVal(5, RT.DString "first branch") - RT.AppendString(4, 5) - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) - -let matchListCons = - t - "match [1, 2] with\n| 1 :: tail -> tail" - E.matchListCons - (5, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateList(0, [ 1; 2 ]) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), - 3 - ) - RT.GetVar(4, "tail") - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) - -let matchTuple = - t - "match (1, 2) with\n| (1, 2) -> \"first branch\"" - E.matchTuple - (6, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), - 5 - ) - RT.LoadVal(4, RT.DString "") - RT.LoadVal(5, RT.DString "first branch") - RT.AppendString(4, 5) - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + + let listCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.Match.listCons + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateList(0, [ 1; 2 ]) + + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), + 3 + ) + RT.GetVar(4, "tail") + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + + let tuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.Match.tuple + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), + 5 + ) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + + let tests = + testList + "Match" + [ simple + notMatched + withVar + //withVarAndWhenCondition // -- disabled because of fn-calling issues + list + listCons + tuple ] + let tests = testList "PT2RT" - [ one - onePlusTwo - letSimple - letTuple - letTupleNested - boolList - boolListList - simpleString - stringWithInterpolation - dictEmpty - dictSimple - dictMultEntries - dictDupeKey - ifGotoThenBranch - ifGotoElseBranch - ifElseMissing - tuple2 - tuple3 - tupleNested - matchSimple - matchNotMatched - matchWithVar - //matchWithVarAndWhenCondition // -- disabled because of fn-calling issues - matchList - matchListCons - matchTuple ] + [ Basic.tests + Let.tests + List.tests + String.tests + Dict.tests + If.tests + Tuples.tests + Match.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs new file mode 100644 index 0000000000..05bb497242 --- /dev/null +++ b/backend/tests/Tests/TestValues.fs @@ -0,0 +1,183 @@ +module Tests.TestValues + +open Prelude +open TestUtils.TestUtils + +module PT = LibExecution.ProgramTypes +module PackageIDs = LibExecution.PackageIDs + +open TestUtils.PTShortcuts + +// TODO: consider adding an Expect.equalInstructions, +// which better points out the diffs in the lists + +module Expressions = + module Basic = + let one = eInt64 1 + + let onePlusTwo = + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) + [] + [ eInt64 1; eInt64 2 ] + + + module Let = + // TODO: try to use undefined variable + // TODO: lpunit + let simple = eLet (lpVar "x") (eBool true) (eVar "x") + + let tuple = + eLet + (lpTuple (lpVar "x") (lpVar "y") []) + (eTuple (eInt64 1) (eInt64 2) []) + (eVar "x") + + /// `let (a, b) = 1 in a` + let tupleNotTuple = + eLet (lpTuple (lpVar "a") (lpVar "b") []) (eInt64 1) (eVar "a") + + /// `let (a, b) = (1, 2, 3) in a` + let tupleIncorrectLen = + eLet + (lpTuple (lpVar "a") (lpVar "b") []) + (eTuple (eInt64 1) (eInt64 2) [ eInt64 3 ]) + (eVar "a") + + + /// `let (a, (b, c)) = (1, (2, 3)) in b` + let tupleNested = + eLet + (lpTuple (lpVar "a") (lpTuple (lpVar "b") (lpVar "c") []) []) + (eTuple (eInt64 1) (eTuple (eInt64 2) (eInt64 3) []) []) + (eVar "b") + + let undefinedVar = eVar "a" + + + module List = + let simple = eList [ eBool true; eBool false; eBool true ] + + let nested = + eList [ eList [ eBool true; eBool false ]; eList [ eBool false; eBool true ] ] + + let mixed = eList [ eInt64 1; eBool true ] + + + module String = + let simple = eStr [ strText "hello" ] + + let withInterpolation = + eLet + (lpVar "x") + (eStr [ strText ", world" ]) + (eStr [ strText "hello"; strInterp (eVar "x") ]) + + + module Dict = + let empty = eDict [] + let simple = eDict [ "key", eBool true ] + let multEntries = eDict [ "t", eBool true; "f", eBool false ] + let dupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] + + module If = + let gotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) + let gotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) + let elseMissing = eIf (eBool false) (eInt64 1) None + + + module Tuples = + /// `(false, true)` + let two = eTuple (eBool false) (eBool true) [] + + /// `(false, true, false)` + let three = eTuple (eBool false) (eBool true) [ eBool false ] + + /// `((false, true), true, (true, false))` + let nested = + eTuple + (eTuple (eBool false) (eBool true) []) + (eBool true) + [ eTuple (eBool true) (eBool false) [] ] + + + module Match = + /// match true with + /// | false -> "first branch" + /// | true -> "second branch" + let simple = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPBool(gid (), true) + whenCondition = None + rhs = eStr [ strText "second branch" ] } ] + + /// match true with + /// | false -> "first branch" + let notMatched = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + /// match true with + /// | x -> x + let withVar = + eMatch + (eBool true) + [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] + + /// match 4 with + /// | 1 -> "first branch" + /// | x when x % 2 == 0 -> "second branch" + let withVarAndWhenCondition = + eMatch + (eInt64 4) + [ { pat = PT.MPInt64(gid (), 1) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPVariable(gid (), "x") + // "is even" + whenCondition = + Some( + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + [] + [ eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + [] + [ eVar "x" ] + eInt64 2 ] + ) + rhs = eStr [ strText "second branch" ] } ] + + let list = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + let listCons = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = + PT.MPListCons( + gid (), + PT.MPInt64(gid (), 1), + PT.MPVariable(gid (), "tail") + ) + whenCondition = None + rhs = eVar "tail" } ] + + let tuple = + eMatch + (eTuple (eInt64 1) (eInt64 2) []) + [ { pat = + PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 312d30091b..9f58b00101 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -32,6 +32,7 @@ + diff --git a/notes.dark b/notes.dark new file mode 100644 index 0000000000..6e765ed696 --- /dev/null +++ b/notes.dark @@ -0,0 +1,281 @@ +module Darklang = +module LanguageTools = +// It's worth noting that all RTE is provided paired with a context +// of where that error happened. +// "RuntimeErrorContext"? +module RuntimeErrors = + + module NameResolution = + type ErrorType = + | NotFound of names: List + | ExpectedEnumButNot of packageTypeID: uuid + | ExpectedRecordButNot of packageTypeID: uuid + | MissingEnumModuleName of caseName: String + | InvalidPackageName of names: List + + type NameType = | Function | Type | Constant + + type Error = { errorType: ErrorType nameType: NameType } + + + + + + + + module TypeChecker = + type Context = + | FunctionCallParameter of fnName: FQFnName * parameter: RTParam * paramIndex: Int64 + | FunctionCallResult of fnName: FQFnName * returnType: TypeReference + | RecordField of recordTypeName: FQTypeName * fieldName: String * fieldType: TypeReference + | DictKey of key: String * typ: TypeReference + | EnumField of enumTypeName: FQTypeName * caseName: String * fieldIndex: Int64 * fieldCount: Int64 * fieldType: TypeReference + | DBQueryVariable of varName: String * expected: TypeReference + | DBSchemaType of name: String * expectedType: TypeReference + | ListIndex of index: Int64 * listTyp: TypeReference * parent: Context + | TupleIndex of index: Int64 * elementType: TypeReference * parent: Context + | FnValResult of returnType: TypeReference + + type ErrorType = + | ValueNotExpectedType of actualValue: Dval * expectedType: TypeReference + | TypeDoesntExist of FQTypeName + + type Error = { errorType: ErrorType context: Context } + + + module Cli = + type Error = + | NoExpressionsToExecute + | UncaughtException of String * List + | NonIntReturned of actuallyReturned: Dval.Dval + + + module Json = + type Error = UnsupportedType of RuntimeTypes.TypeReference + + + module Int = + type Error = + | DivideByZeroError + | OutOfRange + | NegativeExponent + | NegativeModulus + | ZeroModulus + + + module Execution = + type Error = + | MatchExprUnmatched of RuntimeTypes.Dval.Dval + | NonStringInStringInterpolation of RuntimeTypes.Dval.Dval + | ConstDoesntExist of RuntimeTypes.FQConstantName.FQConstantName + | EnumConstructionCaseNotFound of typeName: RuntimeTypes.FQTypeName * caseName: String + | WrongNumberOfFnArgs of fn: RuntimeTypes.FQFnName * expectedTypeArgs: Int64 * expectedArgs: Int64 * actualTypeArgs: Int64 * actualArgs: Int64 + + // TODO: Record submodule + | RecordConstructionFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * fieldName: String + | RecordConstructionMissingField of RuntimeTypes.FQTypeName * missingFieldName: String + | RecordConstructionDuplicateField of RuntimeTypes.FQTypeName * duplicateFieldName: String + | FieldAccessFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * invalidFieldName: String + | FieldAccessNotRecord of RuntimeTypes.ValueType * String + + module Unwrap = + type Error = + | GotNone + | GotError of Dval + | NonOptionOrResult of Dval + + + + // TODO: this needs a way to be extensible + // users should have _some_ way to add their own RuntimeErrors + // and we don't want to have to rebuild everything to add a new RTE + type Error = + // reframe as "Encountered unresolved name" + | NameResolution of NameResolution.Error + + | Int of Int.Error + | Json of Json.Error + + | Record of Record.Error + | Enum of Enum.Error + + | List of List.Error + + | Unwrap of Unwrap.Error + + // probably break this down.. + | TypeChecker of TypeChecker.Error + + | ExpectedBoolInCondition of Dval + | VariableNotFound of attemptedVarName : String + + + | SqlCompiler of Error // -- or maybe this should happen during PT2RT? hmm. + + // lol aren't they all execution errors? + // remove this level... + | Execution of Execution.Error + + | Cli of Cli.Error + + | OldStringTODO of String + + + + /// Sometimes, very-unexpected things happen. This is a catch-all for those. + /// For local/private runtimes+hosting, allow users to see the details, + /// but for _our_ hosting, users shouldn't see the whole call stack or + /// whatever, for (our) safety. But, they can use the error ID to refer to + /// the error in a support ticket. + | UncaughtException of reference: Uuid + +backend/src/BuiltinExecution/Libs/NoModule.fs: +413 // $"unwrap called with multiple arguments: {multipleArgs}" +414: // |> RuntimeError.oldError + +backend/src/LibCloud/SqlCompiler.fs: +1220 let err = RuntimeError.sqlCompilerRuntimeError internalError +1221 return Error err +1222 +1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) +1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) +1225 } + +backend/src/LibExecution/Interpreter.fs: +263: "Let Pattern did not match" + +265: | Fail \_rte -> rte <- Some(RuntimeError.oldError "TODO") + +351 $"Function {FQFnName.toString fnName} is not found") + +backend/src/LibExecution/Interpreter.Old.fs: +123: RuntimeError.oldError "TODO" + +161: $"Invalid const name: {msg}") + +904 $"Expected {expectedLength} arguments, got {actualLength}") + +988 $"Function {FQFnName.toString fnToCall} is not found") + +1044: "Unknown error" + +backend/src/LibExecution/NameResolutionError.fs: +105 let toRuntimeError (\_e : Error) : RT.RuntimeError = +107: "TODO" |> RT.RuntimeError.oldError + +backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs: +411 // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. +412 // maybe the 'value' here is (still) some unresolved name? +413 // (which should fail when we apply it) +414: (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) + +591: // // RT.RuntimeError.oldError "Record must have at least one field", + +673: // // RT.RuntimeError.oldError "Match must have at least one case", + +backend/src/LibExecution/RuntimeTypes.fs: +813 +814 +815 // TODO remove all usages of this in favor of better error cases +816: let oldError (msg : string) : RuntimeError = +817 //case "OldStringErrorTODO" [ DString msg ] +818 RuntimeError(DString msg) +819 + +839 +840 // TODO remove all usages of this in favor of better error cases +841 let raiseUntargetedString (s : string) : 'a = +842: raiseUntargetedRTE (RuntimeError.oldError s) +843 +844 /// Internally in the runtime, we allow throwing RuntimeErrorExceptions. At the +845 /// boundary, typically in Execution.fs, we will catch the exception, and return this + +backend/src/LibExecution/TypeChecker.fs: +130 RuntimeError.oldError "TODO" + +552 $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" + +604 $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" + +645 $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" + +666 $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" + +695: "Empty key" + +699: $"Duplicate key: {k}") + +backend/tests/TestUtils/LibTest.fs: +71 // previewable = Pure +72 // deprecated = NotDeprecated } +73 +74: // // CLEANUP consider renaming to `oldError` or something more clear +75 // { name = fn "testRuntimeError" 0 +76 // typeParams = [] +77 // parameters = [ Param.make "errorString" TString "" ] + +80 // fn = +81 // (function +82 // | _, _, [ DString errorString ] -> +83: // raiseUntargetedRTE (RuntimeError.oldError errorString) +84 // | \_ -> incorrectArgs ()) +85 // sqlSpec = NotQueryable +86 // previewable = Pure + +backend/src/LibCloud/SqlCompiler.fs: +1221 return Error err +1222 +1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) +1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) +1225 } +1226 +1227 /home/dark/app/backend/src/LibExecution/Interpreter.Old.fs +1228: 177,10: // let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) +1229: 184,40: // | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] +1230: 198,12: // errStr "Tuple pattern has wrong number of elements" +1231: 199,15: // | _ -> errStr "Tuple pattern does not match" +1232: 343,7: let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) +1233: 480,41: // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" +1234: 503,24: // errStr +1235: 508,24: // | _ -> return errStr callStack "Expected a record in record update" +1236: 529,11: errStr +1237: 538,19: // return errStr callStack "Field name is empty" +1238: 554,21: // return errStr callStack msg +1239: 775,34: // | _ -> return errStr callStack "When condition should be a boolean" +1240: 795,24: // | _ -> return errStr callStack "If only supports Booleans" +1241: 804,26: // | _ -> return errStr callStack "|| only supports Booleans" +1242: "|| only supports Booleans" +1243: "&& only supports Booleans" +1244: "&& only supports Booleans" + +backend/src/LibExecution/Interpreter.Old.fs: +184: "Unit pattern does not match" + +198: "Tuple pattern has wrong number of elements" + +199: "Tuple pattern does not match" + +480: $"Empty key for value `{dv}`" + +505 $"Expected a record but {typeStr} is something else" + +508: "Expected a record in record update" + +531 $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" + +538: "Field name is empty" + +552 "(use `DB.*` standard library functions to interact with Datastores. " +553 + "Field access only work with records)" + +775: "When condition should be a boolean" + +795: "If only supports Booleans" + +804: "|| only supports Booleans" + +814: "&& only supports Booleans" + +834 $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" + +incorrectArgs From e6168e7c0b61f7b60dfe5188f64ba817a68542a9 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 27 Aug 2024 10:14:34 -0400 Subject: [PATCH 18/60] Work on RTEs, Enums, Records; uncomment many Builtins --- backend/fsdark.sln | 40 +- backend/src/BuiltinCli/Libs/File.fs | 2 +- backend/src/BuiltinExecution/Builtin.fs | 54 +- .../BuiltinExecution/BuiltinExecution.fsproj | 53 +- .../src/BuiltinExecution/IntRuntimeError.fs | 36 - backend/src/BuiltinExecution/Libs/AltJson.fs | 6 +- backend/src/BuiltinExecution/Libs/Base64.fs | 12 +- backend/src/BuiltinExecution/Libs/Bool.fs | 2 +- backend/src/BuiltinExecution/Libs/Bytes.fs | 2 +- backend/src/BuiltinExecution/Libs/Char.fs | 18 +- backend/src/BuiltinExecution/Libs/Crypto.fs | 26 +- backend/src/BuiltinExecution/Libs/DateTime.fs | 48 +- backend/src/BuiltinExecution/Libs/Dict.fs | 486 +-- backend/src/BuiltinExecution/Libs/Float.fs | 44 +- .../src/BuiltinExecution/Libs/HttpClient.fs | 31 +- backend/src/BuiltinExecution/Libs/Int128.fs | 96 +- backend/src/BuiltinExecution/Libs/Int16.fs | 121 +- backend/src/BuiltinExecution/Libs/Int32.fs | 88 +- backend/src/BuiltinExecution/Libs/Int64.fs | 745 +++-- backend/src/BuiltinExecution/Libs/Int8.fs | 113 +- backend/src/BuiltinExecution/Libs/Json.fs | 115 +- .../BuiltinExecution/Libs/LanguageTools.fs | 174 +- backend/src/BuiltinExecution/Libs/List.fs | 1057 +++---- backend/src/BuiltinExecution/Libs/Math.fs | 22 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 93 +- backend/src/BuiltinExecution/Libs/Parser.fs | 4 +- backend/src/BuiltinExecution/Libs/String.fs | 117 +- backend/src/BuiltinExecution/Libs/UInt128.fs | 68 +- backend/src/BuiltinExecution/Libs/UInt16.fs | 87 +- backend/src/BuiltinExecution/Libs/UInt32.fs | 90 +- backend/src/BuiltinExecution/Libs/UInt64.fs | 87 +- backend/src/BuiltinExecution/Libs/UInt8.fs | 87 +- backend/src/BuiltinExecution/Libs/Uuid.fs | 8 +- backend/src/BuiltinExecution/Libs/X509.fs | 4 +- .../DvalReprInternalHash.fs | 0 .../DvalReprInternalQueryable.fs | 0 .../DvalReprInternalRoundtrippable.fs | 0 backend/src/LibCloud/Init.fs | 11 +- backend/src/LibCloud/LibCloud.fsproj | 24 +- backend/src/LibExecution/Builtin.fs | 20 +- backend/src/LibExecution/Dval.fs | 189 +- backend/src/LibExecution/DvalDecoder.fs | 168 +- backend/src/LibExecution/DvalReprDeveloper.fs | 248 -- backend/src/LibExecution/Execution.fs | 117 +- backend/src/LibExecution/Interpreter.Old.fs | 1073 ------- backend/src/LibExecution/Interpreter.fs | 607 ++-- backend/src/LibExecution/LibExecution.fsproj | 42 +- .../src/LibExecution/NameResolutionError.fs | 112 - backend/src/LibExecution/PackageIDs.fs | 58 +- backend/src/LibExecution/ProgramTypes.fs | 502 ++-- .../LibExecution/ProgramTypesToDarkTypes.fs | 2676 +++++++++-------- .../ProgramTypesToRuntimeTypes.fs | 572 ++-- backend/src/LibExecution/RuntimeTypes.fs | 1200 ++++---- backend/src/LibExecution/RuntimeTypesAst.fs | 583 ---- .../LibExecution/RuntimeTypesToDarkTypes.fs | 636 ++-- backend/src/LibExecution/TypeChecker.fs | 1175 ++++---- backend/src/LibExecution/ValueType.fs | 159 + backend/src/LibHttpMiddleware/Http.fs | 2 +- backend/src/LibParser/FSharpToWrittenTypes.fs | 40 +- backend/src/LibParser/NameResolver.fs | 23 +- backend/src/LibParser/WrittenTypes.fs | 4 +- .../LibParser/WrittenTypesToProgramTypes.fs | 188 +- backend/src/LocalExec/LocalExec.fsproj | 6 +- backend/src/Prelude/Prelude.fsproj | 1 + backend/src/Prelude/StringBuilder.fs | 6 + backend/tests/TestUtils/LibTest.fs | 36 +- backend/tests/TestUtils/PTShortcuts.fs | 35 +- backend/tests/TestUtils/TestUtils.fs | 274 +- backend/tests/TestUtils/TestUtils.fsproj | 2 +- backend/tests/Tests/Interpreter.Tests.fs | 127 +- backend/tests/Tests/PT2RT.Tests.fs | 288 +- backend/tests/Tests/TestValues.fs | 118 +- backend/tests/Tests/Tests.fs | 22 +- backend/tests/Tests/Tests.fsproj | 27 +- notes.dark | 281 -- scripts/build/compile | 2 +- 76 files changed, 6753 insertions(+), 8937 deletions(-) delete mode 100644 backend/src/BuiltinExecution/IntRuntimeError.fs rename backend/src/{LibExecution => LibCloud}/DvalReprInternalHash.fs (100%) rename backend/src/{LibExecution => LibCloud}/DvalReprInternalQueryable.fs (100%) rename backend/src/{LibExecution => LibCloud}/DvalReprInternalRoundtrippable.fs (100%) delete mode 100644 backend/src/LibExecution/DvalReprDeveloper.fs delete mode 100644 backend/src/LibExecution/Interpreter.Old.fs delete mode 100644 backend/src/LibExecution/NameResolutionError.fs delete mode 100644 backend/src/LibExecution/RuntimeTypesAst.fs create mode 100644 backend/src/LibExecution/ValueType.fs create mode 100644 backend/src/Prelude/StringBuilder.fs delete mode 100644 notes.dark diff --git a/backend/fsdark.sln b/backend/fsdark.sln index f89105d8df..eabb776a4c 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -27,24 +27,24 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExec EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinExecution", "src\BuiltinExecution\BuiltinExecution.fsproj", "{BBFC824F-A0DE-4A28-B82F-49C04EBA7475}" EndProject # Cloud stuff #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "src\LibBinarySerialization\LibBinarySerialization.fsproj", "{5830D9BF-CA28-47B0-964F-343FAB28751B}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" @@ -101,18 +101,18 @@ Global {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 {DB61305F-4CA9-4D92-82A5-503495F515E8}.Release|Any CPU.Build.0 = Release|Any CPU - #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.Build.0 = Release|Any CPU + {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {3FC57943-9D51-49AE-9FBD-4A112B4F68D6}.Release|Any CPU.Build.0 = Release|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Debug|Any CPU.Build.0 = Debug|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|Any CPU.ActiveCfg = Release|Any CPU {5FD0E378-FD88-45E5-9963-BFF2921E6A6A}.Release|Any CPU.Build.0 = Release|Any CPU - #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.Build.0 = Release|Any CPU + {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Debug|Any CPU.Build.0 = Debug|Any CPU + {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.ActiveCfg = Release|Any CPU + {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}.Release|Any CPU.Build.0 = Release|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Debug|Any CPU.Build.0 = Debug|Any CPU {839A1EF7-18F5-491E-B40B-2BAA57378B40}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -185,10 +185,10 @@ Global #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.Build.0 = Release|Any CPU - #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.Build.0 = Release|Any CPU + {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU + {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU + {625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection # Notes of what projects being in which folders @@ -198,8 +198,8 @@ Global {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} - #{3FC57943-9D51-49AE-9FBD-4A112B4F68D6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {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} #{FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index 59cfea1a56..c92ed0bf6e 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -65,7 +65,7 @@ let fns : List = do! System.IO.File.WriteAllBytesAsync( path, - Dval.DlistToByteArray contents + Dval.dlistToByteArray contents ) return resultOk DUnit with e -> diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 2bd9ffb11e..242dfb9988 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -10,51 +10,51 @@ let fnRenames = // eg: fn "Http" "respond" 0, fn "Http" "response" 0 [] -let builtins : Builtins = +let builtins httpConfig : Builtins = Builtin.combine [ Libs.NoModule.builtins - // Libs.Bool.builtins + Libs.Bool.builtins - // Libs.Int8.builtins - // Libs.UInt8.builtins - // Libs.Int16.builtins - // Libs.UInt16.builtins - // Libs.Int32.builtins - // Libs.UInt32.builtins + Libs.Int8.builtins + Libs.UInt8.builtins + Libs.Int16.builtins + Libs.UInt16.builtins + Libs.Int32.builtins + Libs.UInt32.builtins Libs.Int64.builtins - // Libs.UInt64.builtins - // Libs.Int128.builtins - // Libs.UInt128.builtins + Libs.UInt64.builtins + Libs.Int128.builtins + Libs.UInt128.builtins - // Libs.Float.builtins + Libs.Float.builtins - // Libs.Math.builtins + Libs.Math.builtins - // Libs.Bytes.builtins + Libs.Bytes.builtins - // Libs.Char.builtins - // Libs.String.builtins + Libs.Char.builtins + Libs.String.builtins - // Libs.List.builtins - // Libs.Dict.builtins + Libs.List.builtins + Libs.Dict.builtins - // Libs.DateTime.builtins - // Libs.Uuid.builtins + Libs.DateTime.builtins + Libs.Uuid.builtins - // Libs.Base64.builtins + Libs.Base64.builtins // Libs.Json.builtins // Libs.AltJson.builtins - // Libs.HttpClient.builtins httpConfig + Libs.HttpClient.builtins httpConfig - // Libs.LanguageTools.builtins - // Libs.Parser.builtins + Libs.LanguageTools.builtins + //Libs.Parser.builtins - // Libs.Crypto.builtins - // Libs.X509.builtins + Libs.Crypto.builtins + Libs.X509.builtins - // Libs.Packages.builtins pm + //Libs.Packages.builtins pm ] fnRenames diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index c079e05a3c..fbae2424c1 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -12,47 +12,46 @@ - - - - - - - - - + + + + + + + + - - - + + + - + - + - + - - + + - - + + - - + + - + - + - + - - + + @@ -61,7 +60,7 @@ - + diff --git a/backend/src/BuiltinExecution/IntRuntimeError.fs b/backend/src/BuiltinExecution/IntRuntimeError.fs deleted file mode 100644 index 34efb956d5..0000000000 --- a/backend/src/BuiltinExecution/IntRuntimeError.fs +++ /dev/null @@ -1,36 +0,0 @@ -module BuiltinExecution.IntRuntimeError - -open FSharp.Control.Tasks -open System.Threading.Tasks - -open System.Numerics - -open Prelude -open LibExecution.RuntimeTypes -open LibExecution.Builtin.Shortcuts - -module VT = ValueType -module Dval = LibExecution.Dval -module PackageIDs = LibExecution.PackageIDs - -type Error = - | DivideByZeroError - | OutOfRange - | NegativeExponent - | NegativeModulus - | ZeroModulus - -module RTE = - let toRuntimeError (e : Error) : RuntimeError = - let (caseName, fields) = - match e with - | DivideByZeroError -> "DivideByZeroError", [] - | OutOfRange -> "OutOfRange", [] - | NegativeExponent -> "NegativeExponent", [] - | NegativeModulus -> "NegativeModulus", [] - | ZeroModulus -> "ZeroModulus", [] - - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.Int.error - - DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.intError diff --git a/backend/src/BuiltinExecution/Libs/AltJson.fs b/backend/src/BuiltinExecution/Libs/AltJson.fs index 236933c3b9..c7b3f26928 100644 --- a/backend/src/BuiltinExecution/Libs/AltJson.fs +++ b/backend/src/BuiltinExecution/Libs/AltJson.fs @@ -6,7 +6,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs @@ -185,7 +185,7 @@ let fns : List = description = "Formats a JSON value as a JSON string." fn = (function - | _, [], [ jtDval ] -> + | _, _, [], [ jtDval ] -> let jt = Json.fromDT jtDval let jsonString = Serialize.writeJson (fun w -> Serialize.writeToken w jt) Ply(DString jsonString) @@ -204,7 +204,7 @@ let fns : List = let result = Dval.result Json.knownType ParseError.knownType (function - | _, [], [ DString jsonString ] -> + | _, _, [], [ DString jsonString ] -> match Parsing.parse jsonString with | Ok jt -> jt |> Json.toDT |> Ok |> result |> Ply | Error e -> e |> ParseError.toDT |> Error |> result |> Ply diff --git a/backend/src/BuiltinExecution/Libs/Base64.fs b/backend/src/BuiltinExecution/Libs/Base64.fs index d0cede78a4..0afa060f50 100644 --- a/backend/src/BuiltinExecution/Libs/Base64.fs +++ b/backend/src/BuiltinExecution/Libs/Base64.fs @@ -7,7 +7,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -27,7 +27,7 @@ let fns : List = let resultError r = Dval.resultError (KTList(ValueType.Known KTUInt8)) KTString r |> Ply (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> let base64FromUrlEncoded (str : string) : string = let initial = str.Replace('-', '+').Replace('_', '/') let length = initial.Length @@ -68,8 +68,8 @@ let fns : List = section [4](https://www.rfc-editor.org/rfc/rfc4648.html#section-4)." fn = (function - | _, _, [ DList(_vt, bytes) ] -> - let bytes = Dval.DlistToByteArray bytes + | _, _, _, [ DList(_vt, bytes) ] -> + let bytes = Dval.dlistToByteArray bytes System.Convert.ToBase64String(bytes) |> DString |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -87,8 +87,8 @@ let fns : List = section [5](https://www.rfc-editor.org/rfc/rfc4648.html#section-5)." fn = (function - | _, _, [ DList(_vt, bytes) ] -> - let bytes = Dval.DlistToByteArray bytes + | _, _, _, [ DList(_vt, bytes) ] -> + let bytes = Dval.dlistToByteArray bytes // Differs from Base64.encodeToUrlSafe as this version has padding System.Convert.ToBase64String(bytes).Replace('+', '-').Replace('/', '_') |> DString diff --git a/backend/src/BuiltinExecution/Libs/Bool.fs b/backend/src/BuiltinExecution/Libs/Bool.fs index 3a77bb1dec..b2a2e68ab2 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 ] -> Ply(DBool(not b)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "not" previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Bytes.fs b/backend/src/BuiltinExecution/Libs/Bytes.fs index 183fe7b699..48b430675b 100644 --- a/backend/src/BuiltinExecution/Libs/Bytes.fs +++ b/backend/src/BuiltinExecution/Libs/Bytes.fs @@ -17,7 +17,7 @@ let fns : List = with [RFC 4648 section 8](https://www.rfc-editor.org/rfc/rfc4648.html#section-8)." fn = (function - | _, _, [ DList(_, bytes) ] -> + | _, _, _, [ DList(_, bytes) ] -> let hexUppercaseLookup = "0123456789ABCDEF" let len = bytes.Length let buf = new StringBuilder(len * 2) diff --git a/backend/src/BuiltinExecution/Libs/Char.fs b/backend/src/BuiltinExecution/Libs/Char.fs index 71569a64e8..712362fae9 100644 --- a/backend/src/BuiltinExecution/Libs/Char.fs +++ b/backend/src/BuiltinExecution/Libs/Char.fs @@ -8,7 +8,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -22,7 +22,7 @@ let fns : List = If does not have an uppercase value, returns " fn = function - | _, _, [ DChar c ] -> Ply(DChar(c.ToUpper())) + | _, _, _, [ DChar c ] -> Ply(DChar(c.ToUpper())) | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -38,7 +38,7 @@ let fns : List = If does not have a lowercase value, returns " fn = function - | _, _, [ DChar c ] -> Ply(DChar(c.ToLower())) + | _, _, _, [ DChar c ] -> Ply(DChar(c.ToLower())) | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -53,7 +53,7 @@ let fns : List = "Return {{Some }} if is a valid ASCII character, otherwise {{None}}" fn = function - | _, _, [ DChar c ] -> + | _, _, _, [ DChar c ] -> let charValue = int c[0] if charValue >= 0 && charValue < 256 then Dval.optionSome KTInt64 (DInt64 charValue) |> Ply @@ -72,7 +72,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 |> Ply | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -86,7 +86,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 |> Ply | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -100,7 +100,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 |> Ply | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -114,7 +114,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 |> Ply | _ -> incorrectArgs () sqlSpec = NotYetImplemented previewable = Pure @@ -128,7 +128,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DChar c ] -> Ply(DString c) + | _, _, _, [ DChar c ] -> Ply(DString c) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Crypto.fs b/backend/src/BuiltinExecution/Libs/Crypto.fs index b42ff15027..fc26a59b4a 100644 --- a/backend/src/BuiltinExecution/Libs/Crypto.fs +++ b/backend/src/BuiltinExecution/Libs/Crypto.fs @@ -11,7 +11,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -23,8 +23,8 @@ let fns : List = description = "Computes the SHA-256 digest of the given " fn = (function - | _, _, [ DList(_vt, data) ] -> - let data = Dval.DlistToByteArray data + | _, _, _, [ DList(_vt, data) ] -> + let data = Dval.dlistToByteArray data let hash = SHA256.HashData(System.ReadOnlySpan(data)) Dval.byteArrayToDvalList hash |> Ply | _ -> incorrectArgs ()) @@ -40,8 +40,8 @@ let fns : List = description = "Computes the SHA-384 digest of the given " fn = (function - | _, _, [ DList(_vt, data) ] -> - let data = Dval.DlistToByteArray data + | _, _, _, [ DList(_vt, data) ] -> + let data = Dval.dlistToByteArray data let hash = SHA384.HashData(System.ReadOnlySpan data) Dval.byteArrayToDvalList hash |> Ply | _ -> incorrectArgs ()) @@ -58,8 +58,8 @@ let fns : List = "Computes the md5 digest of the given . NOTE: There are multiple security problems with md5, see https://en.wikipedia.org/wiki/MD5#Security" fn = (function - | _, _, [ DList(_vt, data) ] -> - let data = Dval.DlistToByteArray data + | _, _, _, [ DList(_vt, data) ] -> + let data = Dval.dlistToByteArray data let hash = MD5.HashData(System.ReadOnlySpan data) Dval.byteArrayToDvalList hash |> Ply | _ -> incorrectArgs ()) @@ -77,10 +77,10 @@ let fns : List = "Computes the SHA-256 HMAC (hash-based message authentication code) digest of the given and ." fn = (function - | _, _, [ DList(_, key); DList(_, data) ] -> - let key = Dval.DlistToByteArray key + | _, _, _, [ DList(_, key); DList(_, data) ] -> + let key = Dval.dlistToByteArray key let hmac = new HMACSHA256(key) - let data = Dval.DlistToByteArray data + let data = Dval.dlistToByteArray data let hash = hmac.ComputeHash(data) Dval.byteArrayToDvalList hash |> Ply | _ -> incorrectArgs ()) @@ -98,10 +98,10 @@ let fns : List = "Computes the SHA1-HMAC (hash-based message authentication code) digest of the given and ." fn = (function - | _, _, [ DList(_, key); DList(_, data) ] -> - let key = Dval.DlistToByteArray key + | _, _, _, [ DList(_, key); DList(_, data) ] -> + let key = Dval.dlistToByteArray key let hmac = new HMACSHA1(key) - let data = Dval.DlistToByteArray data + let data = Dval.dlistToByteArray data let hash = hmac.ComputeHash(data) Dval.byteArrayToDvalList hash |> Ply | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/DateTime.fs b/backend/src/BuiltinExecution/Libs/DateTime.fs index 64607a13ec..0591295960 100644 --- a/backend/src/BuiltinExecution/Libs/DateTime.fs +++ b/backend/src/BuiltinExecution/Libs/DateTime.fs @@ -5,7 +5,7 @@ type Instant = NodaTime.Instant open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module DarkDateTime = LibExecution.DarkDateTime @@ -39,7 +39,7 @@ let fns : List = + "}} (for example: 2019-09-07T22:44:25Z) and returns the {{Date}} wrapped in a {{Result}}." fn = (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> ISO8601DateParser s |> Result.map DDateTime |> Result.mapError (fun () -> DString "Invalid date format") @@ -59,7 +59,7 @@ let fns : List = "Stringify to the ISO 8601 format {{YYYY-MM-DD'T'hh:mm:ss'Z'}}" fn = (function - | _, _, [ DDateTime d ] -> + | _, _, _, [ DDateTime d ] -> let dt = DarkDateTime.toDateTimeUtc d dt.ToString("s", System.Globalization.CultureInfo.InvariantCulture) + "Z" |> DString @@ -78,7 +78,7 @@ let fns : List = "Stringify to the ISO 8601 basic format {{YYYYMMDD'T'hhmmss'Z'}}" fn = (function - | _, _, [ DDateTime d ] -> + | _, _, _, [ DDateTime d ] -> (DarkDateTime.toDateTimeUtc d).ToString("yyyyMMddTHHmmssZ") |> DString |> Ply @@ -95,7 +95,7 @@ let fns : List = description = "Stringify to the ISO 8601 basic format YYYYMMDD" fn = (function - | _, _, [ DDateTime d ] -> + | _, _, _, [ DDateTime d ] -> (DarkDateTime.toDateTimeUtc d).ToString("yyyyMMdd") |> DString |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -110,7 +110,7 @@ let fns : List = description = "Returns the current datetime" fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> Instant.now () |> DarkDateTime.fromInstant |> DDateTime |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -125,7 +125,7 @@ let fns : List = description = "Returns the with the time set to midnight" fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> let now = DarkDateTime.fromInstant (Instant.now ()) Ply(DDateTime(DarkDateTime.T(now.Year, now.Month, now.Day, 0, 0, 0))) | _ -> incorrectArgs ()) @@ -142,7 +142,7 @@ let fns : List = "Returns a seconds after " fn = (function - | _, _, [ DDateTime d; DInt64 s ] -> + | _, _, _, [ DDateTime d; DInt64 s ] -> d + (NodaTime.Period.FromSeconds s) |> DDateTime |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "+" @@ -163,7 +163,7 @@ let fns : List = "Returns a seconds before " fn = (function - | _, _, [ DDateTime d; DInt64 s ] -> + | _, _, _, [ DDateTime d; DInt64 s ] -> d - (NodaTime.Period.FromSeconds s) |> DDateTime |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "-" @@ -178,7 +178,7 @@ let fns : List = description = "Returns whether {{ > }}" fn = (function - | _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 > d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 > d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">" previewable = Pure @@ -192,7 +192,7 @@ let fns : List = description = "Returns whether {{ < }}" fn = (function - | _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 < d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 < d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<" previewable = Pure @@ -206,7 +206,7 @@ let fns : List = description = "Returns whether {{ >= }}" fn = (function - | _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 >= d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 >= d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">=" previewable = Pure @@ -220,7 +220,7 @@ let fns : List = description = "Returns whether {{ <= }}" fn = (function - | _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 <= d2)) + | _, _, _, [ DDateTime d1; DDateTime d2 ] -> Ply(DBool(d1 <= d2)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<=" previewable = Pure @@ -235,7 +235,7 @@ let fns : List = "Converts to an representing seconds since the Unix epoch" fn = (function - | _, _, [ DDateTime d ] -> + | _, _, _, [ DDateTime d ] -> (DarkDateTime.toInstant d).ToUnixTimeSeconds() |> DInt64 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -251,7 +251,7 @@ let fns : List = "Converts an representing seconds since the Unix epoch into a " fn = (function - | _, _, [ DInt64 s ] -> + | _, _, _, [ DInt64 s ] -> s |> Instant.FromUnixTimeSeconds |> DarkDateTime.fromInstant @@ -270,7 +270,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'year'" ]) previewable = Pure @@ -285,7 +285,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'month'" ]) previewable = Pure @@ -299,7 +299,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 |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'day'" ]) previewable = Pure @@ -315,7 +315,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -329,7 +329,7 @@ let fns : List = description = "Returns the hour portion of as an " fn = (function - | _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Hour) + | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Hour) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'hour'" ]) previewable = Pure @@ -343,7 +343,7 @@ let fns : List = description = "Returns the minute portion of as an " fn = (function - | _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Minute) + | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Minute) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'minute'" ]) previewable = Pure @@ -357,7 +357,7 @@ let fns : List = description = "Returns the second portion of as an " fn = (function - | _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Second) + | _, _, _, [ DDateTime d ] -> Ply(Dval.int64 d.Second) | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_part", [ "'second'" ]) previewable = Pure @@ -371,7 +371,7 @@ let fns : List = description = "Returns with the time set to midnight" fn = (function - | _, _, [ DDateTime d ] -> + | _, _, _, [ DDateTime d ] -> DarkDateTime.T(d.Year, d.Month, d.Day, 0, 0, 0) |> DDateTime |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunctionWithPrefixArgs("date_trunc", [ "'day'" ]) @@ -391,7 +391,7 @@ let fns : List = description = "Returns the difference of the two dates, in seconds" fn = (function - | _, _, [ DDateTime endDate; DDateTime startDate ] -> + | _, _, _, [ DDateTime endDate; DDateTime startDate ] -> let diff = (DarkDateTime.toInstant endDate) - (DarkDateTime.toInstant startDate) diff.TotalSeconds |> System.Math.Round |> int64 |> DInt64 |> Ply diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index 2a38bd8e82..1ede86e00e 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -8,7 +8,7 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module TypeChecker = LibExecution.TypeChecker -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter module PackageIDs = LibExecution.PackageIDs @@ -25,7 +25,7 @@ let fns : List = description = "Returns the number of entries in " fn = (function - | _, _, [ DDict(_vtTODO, o) ] -> Ply(DInt64(int64 (Map.count o))) + | _, _, _, [ DDict(_vtTODO, o) ] -> Ply(DInt64(int64 (Map.count o))) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -40,7 +40,7 @@ let fns : List = "Returns 's keys in a , in an arbitrary order" fn = (function - | _, _, [ DDict(_, o) ] -> + | _, _, _, [ 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 | _ -> incorrectArgs ()) @@ -57,7 +57,7 @@ let fns : List = "Returns 's values in a , in an arbitrary order" fn = (function - | _, _, [ DDict(valueType, o) ] -> + | _, _, _, [ DDict(valueType, o) ] -> o |> Map.values |> Seq.toList |> (fun vs -> DList(valueType, vs) |> Ply) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -74,7 +74,7 @@ let fns : List = This function is the opposite of " fn = (function - | _, _, [ DDict(valueType, o) ] -> + | _, _, _, [ DDict(valueType, o) ] -> Map.toList o |> List.map (fun (k, v) -> DTuple(DString k, v, [])) |> fun pairs -> DList(VT.tuple VT.string valueType [], pairs) @@ -86,37 +86,37 @@ let fns : List = - { name = fn "dictFromListOverwritingDuplicates" 0 - typeParams = [] - parameters = [ Param.make "entries" (TList(TTuple(TString, varA, []))) "" ] - returnType = TDict varB - description = - "Returns a with . Each value in - must be a {{(key, value)}} tuple, where is a . - - If contains duplicate s, the last entry with that - key will be used in the resulting dictionary (use if you - want to enforce unique keys). - - This function is the opposite of ." - fn = - (function - | _, _, [ DList(_, l) ] -> - let f acc dv = - match dv with - | DTuple(DString k, value, []) -> Map.add k value acc - | _ -> - Exception.raiseInternal - "Not string tuples in fromListOverwritingDuplicates" - [ "dval", dv ] - - List.fold f Map.empty l - |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "dictFromListOverwritingDuplicates" 0 + // typeParams = [] + // parameters = [ Param.make "entries" (TList(TTuple(TString, varA, []))) "" ] + // returnType = TDict varB + // description = + // "Returns a with . Each value in + // must be a {{(key, value)}} tuple, where is a . + + // If contains duplicate s, the last entry with that + // key will be used in the resulting dictionary (use if you + // want to enforce unique keys). + + // This function is the opposite of ." + // fn = + // (function + // | _, _, _, [ DList(_, l) ] -> + // let f acc dv = + // match dv with + // | DTuple(DString k, value, []) -> Map.add k value acc + // | _ -> + // Exception.raiseInternal + // "Not string tuples in fromListOverwritingDuplicates" + // [ "dval", dv ] + + // List.fold f Map.empty l + // |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "dictFromList" 0 @@ -136,7 +136,7 @@ let fns : List = let dictType = VT.unknownTODO let optType = VT.dict dictType (function - | state, _, [ DList(_vtTODO, l) ] -> + | _, vmState, _, [ DList(_vtTODO, l) ] -> let f acc dv = match acc, dv with | None, _ -> None @@ -151,7 +151,7 @@ let fns : List = match result with | Some entries -> DDict(dictType, entries) - |> TypeChecker.DvalCreator.optionSome state.tracing.callStack optType + |> TypeChecker.DvalCreator.optionSome vmState.callStack optType |> Ply | None -> TypeChecker.DvalCreator.optionNone optType |> Ply | _ -> incorrectArgs ()) @@ -160,23 +160,23 @@ let fns : List = deprecated = NotDeprecated } - { name = fn "dictGet" 0 - typeParams = [] - parameters = [ Param.make "dict" (TDict varA) ""; Param.make "key" TString "" ] - returnType = TypeReference.option varA - description = - "If the contains , returns the corresponding value, - wrapped in an : {{Some value}}. Otherwise, returns {{None}}." - fn = - (function - | state, _, [ DDict(_vtTODO, o); DString s ] -> - Map.find s o - |> TypeChecker.DvalCreator.option state.tracing.callStack VT.unknownTODO - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "dictGet" 0 + // typeParams = [] + // parameters = [ Param.make "dict" (TDict varA) ""; Param.make "key" TString "" ] + // returnType = TypeReference.option varA + // description = + // "If the contains , returns the corresponding value, + // wrapped in an : {{Some value}}. Otherwise, returns {{None}}." + // fn = + // (function + // | state, _, [ DDict(_vtTODO, o); DString s ] -> + // Map.find s o + // |> TypeChecker.DvalCreator.option vmState.callStack VT.unknownTODO + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "dictMember" 0 @@ -188,178 +188,178 @@ let fns : List = {{false}} otherwise" fn = (function - | _, _, [ DDict(_, o); DString s ] -> Ply(DBool(Map.containsKey s o)) - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "dictMap" 0 - typeParams = [] - parameters = - [ Param.make "dict" (TDict varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.ofList TString [ varA ], varB)) - "" - [ "key"; "value" ] ] - returnType = TDict varB - description = - "Returns a new dictionary that contains the same keys as the original with values that have been transformed by {{fn}}, which operates on - each key-value pair. - - Consider if you also want to drop some of the entries." - fn = - (function - | state, [], [ DDict(_vtTODO, o); DFnVal b ] -> - uply { - let mapped = Map.mapWithIndex (fun i v -> (i, v)) o - - let! result = - Ply.Map.mapSequentially - (fun (key, dv) -> - let args = NEList.ofList (DString key) [ dv ] - Interpreter.applyFnVal state b [] args) - mapped - - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "dictIter" 0 - typeParams = [] - parameters = - [ Param.make "dict" (TDict varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.ofList TString [ varA ], TUnit)) - "" - [ "key"; "value" ] ] - returnType = TUnit - description = - "Evaluates {{fn key value}} on every entry in . Returns {{()}}." - fn = - (function - | state, _, [ DDict(_, o); DFnVal b ] -> - uply { - do! - Map.toList o - |> Ply.List.iterSequentially (fun (key, dv) -> - uply { - let args = NEList.ofList (DString key) [ dv ] - match! Interpreter.applyFnVal state b [] args with - | DUnit -> return () - | dv -> - return! - TypeChecker.raiseFnValResultNotExpectedType - state.tracing.callStack - dv - TUnit - }) - return DUnit - } + | _, _, _, [ DDict(_, o); DString s ] -> Ply(DBool(Map.containsKey s o)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure deprecated = NotDeprecated } - { name = fn "dictFilter" 0 - typeParams = [] - parameters = - [ Param.make "dict" (TDict varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.doubleton TString varA, TBool)) - "" - [ "key"; "value" ] ] - returnType = TDict varB - description = - "Evaluates {{fn key value}} on every entry in . Returns a that contains only the entries of for which - returned {{true}}." - fn = - (function - | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> - uply { - let f (key : string) (data : Dval) : Ply = - uply { - let args = NEList.ofList (DString key) [ data ] - match! Interpreter.applyFnVal state b [] args with - | DBool v -> return v - | v -> - return! - TypeChecker.raiseFnValResultNotExpectedType - state.tracing.callStack - v - TBool - } - let! result = Ply.Map.filterSequentially f o - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "dictFilterMap" 0 - typeParams = [] - parameters = - [ Param.make "dict" (TDict varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.ofList TString [ varA ], TypeReference.option varB)) - "" - [ "key"; "value" ] ] - returnType = TDict varB - description = - "Calls on every entry in , returning a that drops some entries (filter) and transforms others (map). - If {{fn key value}} returns {{None}}, does not add or to the new dictionary, dropping the entry. - If {{fn key value}} returns {{Some newValue}}, adds the entry : to the new dictionary. - This function combines and ." - fn = - (function - | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> - uply { - let f (key : string) (data : Dval) : Ply> = - uply { - let args = NEList.ofList (DString key) [ data ] - let! result = Interpreter.applyFnVal state b [] args - - match result with - | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "Some", [ o ]) when - id = PackageIDs.Type.Stdlib.option - -> - return Some o - - | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "None", []) when - id = PackageIDs.Type.Stdlib.option - -> - return None - - | v -> - let expectedType = TypeReference.option varB - return! - TypeChecker.raiseFnValResultNotExpectedType - state.tracing.callStack - v - expectedType - } - - let! result = Ply.Map.filterMapSequentially f o - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "dictMap" 0 + // typeParams = [] + // parameters = + // [ Param.make "dict" (TDict varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.ofList TString [ varA ], varB)) + // "" + // [ "key"; "value" ] ] + // returnType = TDict varB + // description = + // "Returns a new dictionary that contains the same keys as the original with values that have been transformed by {{fn}}, which operates on + // each key-value pair. + + // Consider if you also want to drop some of the entries." + // fn = + // (function + // | state, [], [ DDict(_vtTODO, o); DFnVal b ] -> + // uply { + // let mapped = Map.mapWithIndex (fun i v -> (i, v)) o + + // let! result = + // Ply.Map.mapSequentially + // (fun (key, dv) -> + // let args = NEList.ofList (DString key) [ dv ] + // Interpreter.applyFnVal state b [] args) + // mapped + + // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "dictIter" 0 + // typeParams = [] + // parameters = + // [ Param.make "dict" (TDict varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.ofList TString [ varA ], TUnit)) + // "" + // [ "key"; "value" ] ] + // returnType = TUnit + // description = + // "Evaluates {{fn key value}} on every entry in . Returns {{()}}." + // fn = + // (function + // | state, _, [ DDict(_, o); DFnVal b ] -> + // uply { + // do! + // Map.toList o + // |> Ply.List.iterSequentially (fun (key, dv) -> + // uply { + // let args = NEList.ofList (DString key) [ dv ] + // match! Interpreter.applyFnVal state b [] args with + // | DUnit -> return () + // | dv -> + // return! + // TypeChecker.raiseFnValResultNotExpectedType + // vmState.callStack + // dv + // TUnit + // }) + // return DUnit + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "dictFilter" 0 + // typeParams = [] + // parameters = + // [ Param.make "dict" (TDict varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.doubleton TString varA, TBool)) + // "" + // [ "key"; "value" ] ] + // returnType = TDict varB + // description = + // "Evaluates {{fn key value}} on every entry in . Returns a that contains only the entries of for which + // returned {{true}}." + // fn = + // (function + // | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> + // uply { + // let f (key : string) (data : Dval) : Ply = + // uply { + // let args = NEList.ofList (DString key) [ data ] + // match! Interpreter.applyFnVal state b [] args with + // | DBool v -> return v + // | v -> + // return! + // TypeChecker.raiseFnValResultNotExpectedType + // vmState.callStack + // v + // TBool + // } + // let! result = Ply.Map.filterSequentially f o + // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "dictFilterMap" 0 + // typeParams = [] + // parameters = + // [ Param.make "dict" (TDict varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.ofList TString [ varA ], TypeReference.option varB)) + // "" + // [ "key"; "value" ] ] + // returnType = TDict varB + // description = + // "Calls on every entry in , returning a that drops some entries (filter) and transforms others (map). + // If {{fn key value}} returns {{None}}, does not add or to the new dictionary, dropping the entry. + // If {{fn key value}} returns {{Some newValue}}, adds the entry : to the new dictionary. + // This function combines and ." + // fn = + // (function + // | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> + // uply { + // let f (key : string) (data : Dval) : Ply> = + // uply { + // let args = NEList.ofList (DString key) [ data ] + // let! result = Interpreter.applyFnVal state b [] args + + // match result with + // | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "Some", [ o ]) when + // id = PackageIDs.Type.Stdlib.option + // -> + // return Some o + + // | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "None", []) when + // id = PackageIDs.Type.Stdlib.option + // -> + // return None + + // | v -> + // let expectedType = TypeReference.option varB + // return! + // TypeChecker.raiseFnValResultNotExpectedType + // vmState.callStack + // v + // expectedType + // } + + // let! result = Ply.Map.filterMapSequentially f o + // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "dictIsEmpty" 0 @@ -369,32 +369,32 @@ let fns : List = description = "Returns {{true}} if the contains no entries" fn = (function - | _, _, [ DDict(_, dict) ] -> Ply(DBool(Map.isEmpty dict)) + | _, _, _, [ DDict(_, dict) ] -> Ply(DBool(Map.isEmpty dict)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure deprecated = NotDeprecated } - { name = fn "dictMerge" 0 - typeParams = [] - parameters = - [ Param.make "left" (TDict varA) ""; Param.make "right" (TDict varA) "" ] - returnType = TDict varA - description = - "Returns a combined dictionary with both dictionaries' entries. - If the same key exists in both and , - it will have the value from ." - fn = - (function - | _, _, [ DDict(_vtTODO1, l); DDict(_vtTODO2, r) ] -> - Map.mergeFavoringRight l r - |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "dictMerge" 0 + // typeParams = [] + // parameters = + // [ Param.make "left" (TDict varA) ""; Param.make "right" (TDict varA) "" ] + // returnType = TDict varA + // description = + // "Returns a combined dictionary with both dictionaries' entries. + // If the same key exists in both and , + // it will have the value from ." + // fn = + // (function + // | _, _, _, [ DDict(_vtTODO1, l); DDict(_vtTODO2, r) ] -> + // Map.mergeFavoringRight l r + // |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "dictSet" 0 @@ -408,7 +408,7 @@ let fns : List = "Returns a copy of with the set to " fn = (function - | _, _, [ DDict(vt, o); DString k; v ] -> DDict(vt, Map.add k v o) |> Ply + | _, _, _, [ DDict(vt, o); DString k; v ] -> DDict(vt, Map.add k v o) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -423,7 +423,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Float.fs b/backend/src/BuiltinExecution/Libs/Float.fs index 05fd62d277..6ea2d9e415 100644 --- a/backend/src/BuiltinExecution/Libs/Float.fs +++ b/backend/src/BuiltinExecution/Libs/Float.fs @@ -4,7 +4,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs @@ -29,7 +29,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -43,7 +43,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -62,7 +62,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -82,7 +82,7 @@ let fns : List = fn = (function - | _, _, [ DFloat a ] -> a |> System.Math.Floor |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> a |> System.Math.Floor |> int64 |> DInt64 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -96,7 +96,7 @@ 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 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -111,7 +111,8 @@ let fns : List = "Discard the fractional portion of the float, rounding towards zero" fn = (function - | _, _, [ DFloat a ] -> a |> System.Math.Truncate |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Truncate |> int64 |> DInt64 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -125,7 +126,7 @@ let fns : List = description = "Get the square root of a float" fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sqrt a)) + | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sqrt a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -139,7 +140,7 @@ let fns : List = description = "Returns raised to the power of " fn = (function - | _, _, [ DFloat base_; DFloat exp ] -> Ply(DFloat(base_ ** exp)) + | _, _, _, [ DFloat base_; DFloat exp ] -> Ply(DFloat(base_ ** exp)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "^" previewable = Pure @@ -153,7 +154,7 @@ let fns : List = description = "Divide by " fn = (function - | _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a / b)) + | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a / b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "/" previewable = Pure @@ -167,7 +168,7 @@ let fns : List = description = "Add to " fn = (function - | _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a + b)) + | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a + b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "+" previewable = Pure @@ -181,7 +182,7 @@ let fns : List = description = "Multiply by " fn = (function - | _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a * b)) + | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a * b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "*" previewable = Pure @@ -195,7 +196,7 @@ let fns : List = description = "Subtract from " fn = (function - | _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a - b)) + | _, _, _, [ DFloat a; DFloat b ] -> Ply(DFloat(a - b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "-" previewable = Pure @@ -209,7 +210,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">" previewable = Pure @@ -223,7 +224,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp ">=" previewable = Pure @@ -237,7 +238,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<" previewable = Pure @@ -251,7 +252,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<=" previewable = Pure @@ -266,7 +267,8 @@ let fns : List = "Discard the fractional portion of , rounding towards zero." fn = (function - | _, _, [ DFloat a ] -> a |> System.Math.Truncate |> int64 |> DInt64 |> Ply + | _, _, _, [ DFloat a ] -> + a |> System.Math.Truncate |> int64 |> DInt64 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -290,7 +292,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.floatParseError let resultError = Dval.resultError KTFloat (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try float (s) |> DFloat |> resultOk with :? System.FormatException -> @@ -308,7 +310,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DFloat f ] -> + | _, _, _, [ DFloat f ] -> // TODO add tests from DvalRepr.Tests let result = if System.Double.IsPositiveInfinity f then @@ -334,7 +336,7 @@ let fns : List = description = "Returns true if is NaN" fn = (function - | _, _, [ DFloat f ] -> Ply(DBool(System.Double.IsNaN f)) + | _, _, _, [ DFloat f ] -> Ply(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 b78c41c9c9..804056596b 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -10,7 +10,8 @@ open FSharp.Control.Tasks open Prelude open LibExecution open LibExecution.RuntimeTypes -module VT = ValueType +module VT = LibExecution.ValueType +module RTE = RuntimeError type Method = HttpMethod @@ -414,7 +415,8 @@ let fns (config : Configuration) : List = FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError let resultError = Dval.resultError responseType (KTCustomType(typeName, [])) (function - | state, + | _, + vmState, _, [ DString method; DString uri; DList(_, reqHeaders); DList(_, reqBody) ] -> uply { @@ -426,23 +428,24 @@ let fns (config : Configuration) : List = | DTuple(DString k, DString v, []) -> let k = String.trim k if k = "" then + // CLEANUP reconsider if we should error here return Error BadHeader.BadHeader.EmptyKey else return Ok((k, v)) | notAPair -> - let context = - TypeChecker.Context.FunctionCallParameter( - FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, - ({ name = "headers"; typ = headersType }), - 2 - ) return! - TypeChecker.raiseValueNotExpectedType - state.tracing.callStack - notAPair - (TList(TTuple(TString, TString, []))) - context + RuntimeError.ValueNotExpectedType( + notAPair, + TList(TTuple(TString, TString, [])), + RTE.TypeChecker.Context.FunctionCallParameter( + FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, + ({ name = "headers"; typ = headersType }), + 2 + ) + ) + |> raiseRTE vmState.callStack + }) |> Ply.map (Result.collect) @@ -460,7 +463,7 @@ let fns (config : Configuration) : List = { url = uri method = method headers = reqHeaders - body = Dval.DlistToByteArray reqBody } + body = Dval.dlistToByteArray reqBody } let! response = makeRequest config httpClient request diff --git a/backend/src/BuiltinExecution/Libs/Int128.fs b/backend/src/BuiltinExecution/Libs/Int128.fs index e055f5e29f..1c83f7f04e 100644 --- a/backend/src/BuiltinExecution/Libs/Int128.fs +++ b/backend/src/BuiltinExecution/Libs/Int128.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -44,17 +44,11 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DInt128 v; DInt128 m ] -> + | _, vm, _, [ DInt128 v; DInt128 m ] -> if m = System.Int128.Zero then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else if m < System.Int128.Zero then - IntRuntimeError.Error.NegativeModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < System.Int128.Zero then m + result else result @@ -82,15 +76,12 @@ let fns : List = fn = let resultOk r = Dval.resultOk KTInt128 KTString r |> Ply (function - | state, _, [ DInt128 v; DInt128 d ] -> + | _, vm, _, [ DInt128 v; DInt128 d ] -> (try v % d |> DInt128 |> resultOk with e -> if d = System.Int128.Zero then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else Exception.raiseInternal "unexpected failure case in Int128.remainder" @@ -109,16 +100,12 @@ let fns : List = description = "Adds two 128-bit signed integers together" fn = (function - | state, _, [ DInt128 a; DInt128 b ] -> + | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedAddition (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -132,15 +119,12 @@ let fns : List = description = "Subtracts two 128-bit signed integers" fn = (function - | state, _, [ DInt128 a; DInt128 b ] -> + | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedSubtraction (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -155,15 +139,12 @@ let fns : List = description = "Multiplies two 128-bit signed integers" fn = (function - | state, _, [ DInt128 a; DInt128 b ] -> + | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_CheckedMultiply (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -180,21 +161,15 @@ let fns : List = description = "Divides two 128-bit signed integers" fn = (function - | state, _, [ DInt128 a; DInt128 b ] -> + | _, vm, _, [ DInt128 a; DInt128 b ] -> try let result = System.Int128.op_Division (a, b) Ply(DInt128(result)) with | :? System.DivideByZeroException -> - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack | :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -208,15 +183,12 @@ let fns : List = description = "Returns the negation of , {{-a}}" fn = (function - | state, _, [ DInt128 a ] -> + | _, vm, _, [ DInt128 a ] -> try let result = System.Int128.op_CheckedUnaryNegation a Ply(DInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -230,7 +202,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -245,7 +217,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -259,7 +231,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -274,7 +246,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -288,7 +260,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt128 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt128 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -302,7 +274,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt128 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt128 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -316,7 +288,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DInt128 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt128 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -339,7 +311,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int128ParseError let resultError = Dval.resultError KTInt128 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Int128.Parse |> DInt128 |> resultOk |> Ply with @@ -360,7 +332,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -374,7 +346,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -388,7 +360,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -402,7 +374,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -416,7 +388,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -430,7 +402,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -444,7 +416,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -458,7 +430,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int16.fs b/backend/src/BuiltinExecution/Libs/Int16.fs index c60af2f3d2..f1a9f9c376 100644 --- a/backend/src/BuiltinExecution/Libs/Int16.fs +++ b/backend/src/BuiltinExecution/Libs/Int16.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = type ParseError = @@ -44,21 +44,15 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DInt16 v; DInt16 m ] -> + | _, vm, _, [ DInt16 v; DInt16 m ] -> if m = 0s then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else if m < 0s then - IntRuntimeError.Error.NegativeModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < 0s then m + result else result - Ply(DInt16(result)) + Ply(DInt16 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -82,15 +76,12 @@ let fns : List = fn = let resultOk r = Dval.resultOk KTInt16 KTString r |> Ply (function - | state, _, [ DInt16 v; DInt16 d ] -> + | _, vm, _, [ DInt16 v; DInt16 d ] -> (try v % d |> DInt16 |> resultOk with e -> if d = 0s then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else Exception.raiseInternal "unexpected failure case in Int16.remainder" @@ -109,16 +100,12 @@ let fns : List = description = "Adds two 16-bit signed integers together" fn = (function - | state, _, [ DInt16 a; DInt16 b ] -> + | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(+) a b Ply(DInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -132,16 +119,12 @@ let fns : List = description = "Subtracts two 16-bit signed integers" fn = (function - | state, _, [ DInt16 a; DInt16 b ] -> + | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(-) a b Ply(DInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -155,16 +138,12 @@ let fns : List = description = "multiplies two 16-bit signed integers" fn = (function - | state, _, [ DInt16 a; DInt16 b ] -> + | _, vm, _, [ DInt16 a; DInt16 b ] -> try let result = Checked.(*) a b Ply(DInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -181,20 +160,14 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DInt16 number; DInt16 exp ] -> + | _, vm, _, [ DInt16 number; DInt16 exp ] -> (try if exp < 0s then - IntRuntimeError.Error.NegativeExponent - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack else (bigint number) ** (int exp) |> int16 |> DInt16 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -208,24 +181,15 @@ let fns : List = description = "Divides two 16-bit signed integers" fn = (function - | state, _, [ DInt16 a; DInt16 b ] -> + | _, vm, _, [ DInt16 a; DInt16 b ] -> if b = 0s then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else if a = int16 System.Int16.MinValue && b = -1s then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else let result = a / b if result < System.Int16.MinValue || result > System.Int16.MaxValue then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else Ply(DInt16(int16 result)) @@ -242,15 +206,12 @@ let fns : List = description = "Returns the negation of , {{-a}}" fn = (function - | state, _, [ DInt16 a ] -> + | _, vm, _, [ DInt16 a ] -> if a = System.Int16.MinValue then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else let result = -a - Ply(DInt16(result)) + Ply(DInt16 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -265,7 +226,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -280,7 +241,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -294,7 +255,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -309,7 +270,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -323,7 +284,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DInt16 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt16 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -337,7 +298,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt16 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt16 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -352,7 +313,7 @@ let fns : List = "Returns a random integer16 between and (inclusive)" fn = (function - | _, _, [ DInt16 a; DInt16 b ] -> + | _, _, _, [ DInt16 a; DInt16 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let correctRange = 1 @@ -380,7 +341,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int16ParseError let resultError = Dval.resultError KTInt16 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Convert.ToInt16 |> DInt16 |> resultOk |> Ply with @@ -403,7 +364,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -417,7 +378,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -432,7 +393,7 @@ let fns : List = "Converts a UInt16 to a 16-bit signed integer. Returns {{None}} if the value is greater than 32767" fn = (function - | _, _, [ DUInt16 a ] -> + | _, _, _, [ DUInt16 a ] -> if a > uint16 System.Int16.MaxValue then Dval.optionNone KTInt16 |> Ply else @@ -451,7 +412,7 @@ let fns : List = "Converts an Int32 to a 16-bit signed integer. Returns {{None}} if the value is less than -32768 or greater than 32767" fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if a < int32 System.Int16.MinValue || a > int32 System.Int16.MaxValue then Dval.optionNone KTInt16 |> Ply else @@ -470,7 +431,7 @@ let fns : List = "Converts a UInt32 to a 16-bit signed integer. Returns {{None}} if the value is greater than 32767" fn = (function - | _, _, [ DUInt32 a ] -> + | _, _, _, [ DUInt32 a ] -> if a > uint32 System.Int16.MaxValue then Dval.optionNone KTInt16 |> Ply else @@ -489,7 +450,7 @@ let fns : List = "Converts an Int64 to a 16-bit signed integer. Returns {{None}} if the value is less than -32768 or greater than 32767" fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if a < int64 System.Int16.MinValue || a > int64 System.Int16.MaxValue then Dval.optionNone KTInt16 |> Ply else @@ -508,7 +469,7 @@ let fns : List = "Converts a UInt64 to a 16-bit signed integer. Returns {{None}} if the value is greater than 32767" fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if a > uint64 System.Int16.MaxValue then Dval.optionNone KTInt16 |> Ply else @@ -527,7 +488,7 @@ let fns : List = "Converts an Int128 to a 16-bit signed integer. Returns {{None}} if the value is less than -32768 or greater than 32767" fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if a < System.Int128.op_Implicit System.Int16.MinValue || a > System.Int128.op_Implicit System.Int16.MaxValue @@ -549,7 +510,7 @@ let fns : List = "Converts an UInt128 to a 16-bit signed integer. Returns {{None}} if the value is greater than 32767" fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if a > 32767Z then Dval.optionNone KTInt16 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/Int32.fs b/backend/src/BuiltinExecution/Libs/Int32.fs index 5910f50116..b8a4b7a552 100644 --- a/backend/src/BuiltinExecution/Libs/Int32.fs +++ b/backend/src/BuiltinExecution/Libs/Int32.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -44,21 +44,15 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DInt32 v; DInt32 m ] -> + | _, vm, _, [ DInt32 v; DInt32 m ] -> if m = 0 then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else if m < 0 then - IntRuntimeError.Error.NegativeModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < 0 then m + result else result - Ply(DInt32(result)) + Ply(DInt32 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -82,15 +76,12 @@ let fns : List = fn = let resultOk r = Dval.resultOk KTInt32 KTString r |> Ply (function - | state, _, [ DInt32 v; DInt32 d ] -> + | _, vm, _, [ DInt32 v; DInt32 d ] -> (try v % d |> DInt32 |> resultOk with e -> if d = 0 then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else Exception.raiseInternal "unexpected failure case in Int32.remainder" @@ -109,7 +100,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 ] -> Ply(DInt32(a + b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -123,7 +114,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 ] -> Ply(DInt32(a - b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -137,7 +128,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 ] -> Ply(DInt32(a * b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -154,20 +145,14 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DInt32 number; DInt32 exp ] -> + | _, vm, _, [ DInt32 number; DInt32 exp ] -> (try if exp < 0 then - IntRuntimeError.Error.NegativeExponent - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack else (bigint number) ** (int exp) |> int32 |> DInt32 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -181,12 +166,9 @@ let fns : List = description = "Divides two 32-bit signed integers" fn = (function - | state, _, [ DInt32 a; DInt32 b ] -> + | _, vm, _, [ DInt32 a; DInt32 b ] -> if b = 0 then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else Ply(DInt32(a / b)) | _ -> incorrectArgs ()) @@ -202,7 +184,7 @@ let fns : List = description = "Returns the negation of , {{-a}}" fn = (function - | _, _, [ DInt32 a ] -> Ply(DInt32(-a)) + | _, _, _, [ DInt32 a ] -> Ply(DInt32(-a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -216,7 +198,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -231,7 +213,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -245,7 +227,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -260,7 +242,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -275,7 +257,7 @@ let fns : List = "Returns a random integer32 between and (inclusive)" fn = (function - | _, _, [ DInt32 a; DInt32 b ] -> + | _, _, _, [ DInt32 a; DInt32 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let correction : int32 = 1 @@ -294,7 +276,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DInt32 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt32 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -308,7 +290,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt32 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt32 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -328,7 +310,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int32ParseError let resultError = Dval.resultError KTInt32 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Convert.ToInt32 |> DInt32 |> resultOk |> Ply with @@ -349,7 +331,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DInt32 int ] -> Ply(DString(string int)) + | _, _, _, [ DInt32 int ] -> Ply(DString(string int)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -363,7 +345,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -377,7 +359,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -391,7 +373,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -405,7 +387,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -420,7 +402,7 @@ let fns : List = "Converts a UInt32 to a 32-bit signed integer. Returns {{None}} if the value is greater than 2147483647." fn = (function - | _, _, [ DUInt32 a ] -> + | _, _, _, [ DUInt32 a ] -> if (a > uint32 System.Int32.MaxValue) then Dval.optionNone KTInt32 |> Ply else @@ -439,7 +421,7 @@ let fns : List = "Converts an Int64 to a 32-bit signed integer. Returns {{None}} if the value is less than -2147483648 or greater than 2147483647." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if (a < int64 System.Int32.MinValue) || (a > int64 System.Int32.MaxValue) then @@ -460,7 +442,7 @@ let fns : List = "Converts a UInt64 to a 32-bit signed integer. Returns {{None}} if the value is greater than 2147483647." fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.Int32.MaxValue) then Dval.optionNone KTInt32 |> Ply else @@ -479,7 +461,7 @@ let fns : List = "Converts an Int128 to a 32-bit signed integer. Returns {{None}} if the value is less than -2147483648 or greater than 2147483647." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if (a < System.Int128.op_Implicit System.Int32.MinValue) || (a > System.Int128.op_Implicit System.Int32.MaxValue) @@ -501,7 +483,7 @@ let fns : List = "Converts a UInt128 to a 32-bit signed integer. Returns {{None}} if the value is greater than 2147483647." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if (a > 2147483647Z) then Dval.optionNone KTInt32 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 5909d9a8f1..55e8ee2d48 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -9,31 +9,25 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -//module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError -// /// Used for values which are outside the range of expected values for some -// /// reason. Really, any function using this should have a Result type instead. -// let argumentWasntPositive (paramName : string) (dv : Dval) : string = -// let actual = LibExecution.DvalReprDeveloper.toRepr dv -// $"Expected `{paramName}` to be positive, but it was `{actual}`" +module ParseError = + type ParseError = + | BadFormat + | OutOfRange -// module ParseError = -// type ParseError = -// | BadFormat -// | OutOfRange + let toDT (e : ParseError) : Dval = + let (caseName, fields) = + match e with + | BadFormat -> "BadFormat", [] + | OutOfRange -> "OutOfRange", [] -// let toDT (e : ParseError) : Dval = -// let (caseName, fields) = -// match e with -// | BadFormat -> "BadFormat", [] -// | OutOfRange -> "OutOfRange", [] - -// let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError -// DEnum(typeName, typeName, [], caseName, fields) + let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int64ParseError + DEnum(typeName, typeName, [], caseName, fields) @@ -51,23 +45,17 @@ let fns : List = a different behavior for negative numbers." fn = (function - | _state, _, _, [ DInt64 v; DInt64 m ] -> - // if m = 0L then - // IntRuntimeError.Error.ZeroModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else if m < 0L then - // IntRuntimeError.Error.NegativeModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - let result = v % m - let result = if result < 0L then m + result else result - Ply(DInt64(result)) + | _, vm, _, [ DInt64 v; DInt64 m ] -> + if m = 0L then + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + else if m < 0L then + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + else + let result = v % m + let result = if result < 0L then m + result else result + Ply(DInt64 result) | _ -> incorrectArgs ()) - //sqlSpec = SqlBinOp "%" + sqlSpec = SqlBinOp "%" previewable = Pure // TODO: Deprecate this when we can version infix operators // and when infix operators support Result return types @@ -111,41 +99,38 @@ let fns : List = // deprecated = NotDeprecated } - // { name = fn "int64Remainder" 0 - // typeParams = [] - // parameters = [ Param.make "value" TInt64 ""; Param.make "divisor" TInt64 "" ] - // returnType = TypeReference.result TInt64 TString - // description = - // "Returns the integer remainder left over after dividing by - // , as a . + { name = fn "int64Remainder" 0 + typeParams = [] + parameters = [ Param.make "value" TInt64 ""; Param.make "divisor" TInt64 "" ] + returnType = TypeReference.result TInt64 TString + description = + "Returns the integer remainder left over after dividing by + , as a . - // For example, {{Int64.remainder 15 6 == Ok 3}}. The remainder will be - // negative only if {{ < 0}}. + For example, {{Int64.remainder 15 6 == Ok 3}}. The remainder will be + negative only if {{ < 0}}. - // The sign of doesn't influence the outcome. + The sign of doesn't influence the outcome. - // Returns an {{Error}} if is {{0}}." - // fn = - // let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply - // (function - // | state, _, [ DInt64 v; DInt64 d ] -> - // (try - // v % d |> DInt64 |> resultOk - // with e -> - // if d = 0L then - // IntRuntimeError.Error.DivideByZeroError - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - // Exception.raiseInternal - // "unexpected failure case in Int64.remainder" - // [ "v", v; "d", d ] - // e) - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + Returns an {{Error}} if is {{0}}." + fn = + let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply + (function + | _, vm, _, [ DInt64 v; DInt64 d ] -> + (try + v % d |> DInt64 |> resultOk + with e -> + if d = 0L then + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + else + Exception.raiseInternal + "unexpected failure case in Int64.remainder" + [ "v", v; "d", d ] + e) + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } { name = fn "int64Add" 0 @@ -157,212 +142,203 @@ let fns : List = (function | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a + b)) | _ -> incorrectArgs ()) - //sqlSpec = SqlBinOp "+" + sqlSpec = SqlBinOp "+" previewable = Pure deprecated = NotDeprecated } - // { name = fn "int64Subtract" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TInt64 - // description = "Subtracts two integers" - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a - b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "-" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Subtract" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TInt64 + description = "Subtracts two integers" + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a - b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "-" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64Multiply" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TInt64 - // description = "Multiplies two integers" - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a * b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "*" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Multiply" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TInt64 + description = "Multiplies two integers" + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DInt64(a * b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "*" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64Power" 0 - // typeParams = [] - // parameters = [ Param.make "base" TInt64 ""; Param.make "exponent" TInt64 "" ] - // returnType = TInt64 - // description = - // "Raise to the power of . - // must to be positive. - // Return value wrapped in a {{Result}} " - // fn = - // (function - // | state, _, [ DInt64 number; DInt64 exp ] -> - // (try - // if exp < 0L then - // IntRuntimeError.Error.NegativeExponent - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - // (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply - // with :? System.OverflowException -> - // IntRuntimeError.Error.OutOfRange - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "^" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Power" 0 + typeParams = [] + parameters = [ Param.make "base" TInt64 ""; Param.make "exponent" TInt64 "" ] + returnType = TInt64 + description = + "Raise to the power of . + must to be positive. + Return value wrapped in a {{Result}} " + fn = + (function + | _, vm, _, [ DInt64 number; DInt64 exp ] -> + (try + if exp < 0L then + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack + else + (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply + with :? System.OverflowException -> + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "^" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64Divide" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TInt64 - // description = "Divides two integers" - // fn = - // (function - // | state, _, [ DInt64 a; DInt64 b ] -> - // if b = 0L then - // IntRuntimeError.Error.DivideByZeroError - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - // Ply(DInt64(a / b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "/" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Divide" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TInt64 + description = "Divides two integers" + fn = + (function + | _, vm, _, [ DInt64 a; DInt64 b ] -> + if b = 0L then + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + else + Ply(DInt64(a / b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "/" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64Negate" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 "" ] - // returnType = TInt64 - // description = "Returns the negation of , {{-a}}" - // fn = - // (function - // | _, _, [ DInt64 a ] -> Ply(DInt64(-a)) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Negate" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 "" ] + returnType = TInt64 + description = "Returns the negation of , {{-a}}" + fn = + (function + | _, _, _, [ DInt64 a ] -> Ply(DInt64(-a)) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64GreaterThan" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TBool - // description = "Returns {{true}} if is greater than " - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a > b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp ">" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64GreaterThan" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TBool + description = "Returns {{true}} if is greater than " + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a > b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp ">" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64GreaterThanOrEqualTo" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TBool - // description = - // "Returns {{true}} if is greater than or equal to " - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a >= b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp ">=" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64GreaterThanOrEqualTo" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TBool + description = + "Returns {{true}} if is greater than or equal to " + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a >= b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp ">=" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64LessThan" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TBool - // description = "Returns {{true}} if is less than " - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a < b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "<" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64LessThan" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TBool + description = "Returns {{true}} if is less than " + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a < b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "<" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64LessThanOrEqualTo" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TBool - // description = - // "Returns {{true}} if is less than or equal to " - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a <= b)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "<=" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64LessThanOrEqualTo" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TBool + description = + "Returns {{true}} if is less than or equal to " + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> Ply(DBool(a <= b)) + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "<=" + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64Random" 0 - // typeParams = [] - // parameters = [ Param.make "start" TInt64 ""; Param.make "end" TInt64 "" ] - // returnType = TInt64 - // description = - // "Returns a random integer between and (inclusive)" - // fn = - // (function - // | _, _, [ DInt64 a; DInt64 b ] -> - // let lower, upper = if a > b then (b, a) else (a, b) + { name = fn "int64Random" 0 + typeParams = [] + parameters = [ Param.make "start" TInt64 ""; Param.make "end" TInt64 "" ] + returnType = TInt64 + description = + "Returns a random integer between and (inclusive)" + fn = + (function + | _, _, _, [ DInt64 a; DInt64 b ] -> + let lower, upper = if a > b then (b, a) else (a, b) - // // .NET's "nextInt64" is exclusive, - // // but we'd rather an inclusive version of this function - // let correction : int64 = 1 + // .NET's "nextInt64" is exclusive, + // but we'd rather an inclusive version of this function + let correction : int64 = 1 - // lower + randomSeeded().NextInt64(upper - lower + correction) - // |> DInt64 - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Impure - // deprecated = NotDeprecated } + lower + randomSeeded().NextInt64(upper - lower + correction) + |> DInt64 + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Impure + deprecated = NotDeprecated } - // { name = fn "int64Sqrt" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 "" ] - // returnType = TFloat - // description = "Get the square root of an " - // fn = - // (function - // | _, _, [ DInt64 a ] -> Ply(DFloat(sqrt (float a))) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64Sqrt" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 "" ] + returnType = TFloat + description = "Get the square root of an " + fn = + (function + | _, _, _, [ DInt64 a ] -> Ply(DFloat(sqrt (float a))) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64ToFloat" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 "" ] - // returnType = TFloat - // description = "Converts an to a " - // fn = - // (function - // | _, _, [ DInt64 a ] -> Ply(DFloat(float a)) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64ToFloat" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 "" ] + returnType = TFloat + description = "Converts an to a " + fn = + (function + | _, _, _, [ DInt64 a ] -> Ply(DFloat(float a)) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } // { name = fn "int64Parse" 0 @@ -391,163 +367,162 @@ let fns : List = // deprecated = NotDeprecated } - // { name = fn "int64ToString" 0 - // typeParams = [] - // parameters = [ Param.make "int" TInt64 "" ] - // returnType = TString - // description = "Stringify " - // fn = - // (function - // | _, _, [ DInt64 int ] -> Ply(DString(string int)) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64ToString" 0 + typeParams = [] + parameters = [ Param.make "int" TInt64 "" ] + returnType = TString + description = "Stringify " + fn = + (function + | _, _, _, [ DInt64 int ] -> Ply(DString(string int)) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromInt8" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt8 "" ] - // returnType = TInt64 - // description = "Converts an Int8 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DInt8 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromInt8" 0 + typeParams = [] + parameters = [ Param.make "a" TInt8 "" ] + returnType = TInt64 + description = "Converts an Int8 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DInt8 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromUInt8" 0 - // typeParams = [] - // parameters = [ Param.make "a" TUInt8 "" ] - // returnType = TInt64 - // description = "Converts a UInt8 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromUInt8" 0 + typeParams = [] + parameters = [ Param.make "a" TUInt8 "" ] + returnType = TInt64 + description = "Converts a UInt8 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DUInt8 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromInt16" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt16 "" ] - // returnType = TInt64 - // description = "Converts an Int16 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DInt16 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromInt16" 0 + typeParams = [] + parameters = [ Param.make "a" TInt16 "" ] + returnType = TInt64 + description = "Converts an Int16 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DInt16 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromUInt16" 0 - // typeParams = [] - // parameters = [ Param.make "a" TUInt16 "" ] - // returnType = TInt64 - // description = "Converts a UInt16 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromUInt16" 0 + typeParams = [] + parameters = [ Param.make "a" TUInt16 "" ] + returnType = TInt64 + description = "Converts a UInt16 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DUInt16 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromInt32" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt32 "" ] - // returnType = TInt64 - // description = "Converts an Int32 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DInt32 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromInt32" 0 + typeParams = [] + parameters = [ Param.make "a" TInt32 "" ] + returnType = TInt64 + description = "Converts an Int32 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DInt32 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromUInt32" 0 - // typeParams = [] - // parameters = [ Param.make "a" TUInt32 "" ] - // returnType = TInt64 - // description = "Converts a UInt32 to a 64-bit signed integer." - // fn = - // (function - // | _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromUInt32" 0 + typeParams = [] + parameters = [ Param.make "a" TUInt32 "" ] + returnType = TInt64 + description = "Converts a UInt32 to a 64-bit signed integer." + fn = + (function + | _, _, _, [ DUInt32 a ] -> DInt64(int64 a) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromUInt64" 0 - // typeParams = [] - // parameters = [ Param.make "a" TUInt64 "" ] - // returnType = TypeReference.option TInt64 - // description = - // "Converts a UInt64 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." - // fn = - // (function - // | _, _, [ DUInt64 a ] -> - // if (a > uint64 System.Int64.MaxValue) then - // Dval.optionNone KTInt64 |> Ply - // else - // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromUInt64" 0 + typeParams = [] + parameters = [ Param.make "a" TUInt64 "" ] + returnType = TypeReference.option TInt64 + description = + "Converts a UInt64 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." + fn = + (function + | _, _, _, [ DUInt64 a ] -> + if (a > uint64 System.Int64.MaxValue) then + Dval.optionNone KTInt64 |> Ply + else + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromInt128" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt128 "" ] - // returnType = TypeReference.option TInt64 - // description = - // "Converts an Int128 to a 64-bit signed integer. Returns {{None}} if the value is less than -9223372036854775808 or greater than 9223372036854775807." - // fn = - // (function - // | _, _, [ DInt128 a ] -> - // if - // (a < System.Int128.op_Implicit System.Int64.MinValue) - // || (a > System.Int128.op_Implicit System.Int64.MaxValue) - // then - // Dval.optionNone KTInt64 |> Ply - // else - // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "int64FromInt128" 0 + typeParams = [] + parameters = [ Param.make "a" TInt128 "" ] + returnType = TypeReference.option TInt64 + description = + "Converts an Int128 to a 64-bit signed integer. Returns {{None}} if the value is less than -9223372036854775808 or greater than 9223372036854775807." + fn = + (function + | _, _, _, [ DInt128 a ] -> + if + (a < System.Int128.op_Implicit System.Int64.MinValue) + || (a > System.Int128.op_Implicit System.Int64.MaxValue) + then + Dval.optionNone KTInt64 |> Ply + else + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "int64FromUInt128" 0 - // typeParams = [] - // parameters = [ Param.make "a" TUInt128 "" ] - // returnType = TypeReference.option TInt64 - // description = - // "Converts a UInt128 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." - // fn = - // (function - // | _, _, [ DUInt128 a ] -> - // if (a > 9223372036854775807Z) then - // Dval.optionNone KTInt64 |> Ply - // else - // Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - ] + { name = fn "int64FromUInt128" 0 + typeParams = [] + parameters = [ Param.make "a" TUInt128 "" ] + returnType = TypeReference.option TInt64 + description = + "Converts a UInt128 to a 64-bit signed integer. Returns {{None}} if the value is greater than 9223372036854775807." + fn = + (function + | _, _, _, [ DUInt128 a ] -> + if (a > 9223372036854775807Z) then + Dval.optionNone KTInt64 |> Ply + else + Dval.optionSome KTInt64 (DInt64(int64 a)) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } ] -let builtins = LibExecution.Builtin.make fns +let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/Int8.fs b/backend/src/BuiltinExecution/Libs/Int8.fs index 034c500526..722e2b07da 100644 --- a/backend/src/BuiltinExecution/Libs/Int8.fs +++ b/backend/src/BuiltinExecution/Libs/Int8.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -44,21 +44,15 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DInt8 v; DInt8 m ] -> + | _, vm, _, [ DInt8 v; DInt8 m ] -> if m = 0y then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else if m < 0y then - IntRuntimeError.Error.NegativeModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < 0y then m + result else result - Ply(DInt8(result)) + Ply(DInt8 result) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -82,15 +76,12 @@ let fns : List = fn = let resultOk r = Dval.resultOk KTInt8 KTString r |> Ply (function - | state, _, [ DInt8 v; DInt8 d ] -> + | _, vm, _, [ DInt8 v; DInt8 d ] -> (try v % d |> DInt8 |> resultOk with e -> if d = 0y then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else Exception.raiseInternal "unexpected failure case in Int8.remainder" @@ -109,14 +100,11 @@ let fns : List = description = "Adds two 8-bit signed integers together" fn = (function - | state, _, [ DInt8 a; DInt8 b ] -> + | _, vm, _, [ DInt8 a; DInt8 b ] -> try DInt8(Checked.(+) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -130,14 +118,11 @@ let fns : List = description = "Subtracts two 8-bit signed integers" fn = (function - | state, _, [ DInt8 a; DInt8 b ] -> + | _, vm, _, [ DInt8 a; DInt8 b ] -> try DInt8(Checked.(-) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -151,14 +136,11 @@ let fns : List = description = "Multiplies two 8-bit signed integers" fn = (function - | state, _, [ DInt8 a; DInt8 b ] -> + | _, vm, _, [ DInt8 a; DInt8 b ] -> try DInt8(Checked.(*) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -175,20 +157,14 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DInt8 number; DInt8 exp ] -> + | _, vm, _, [ DInt8 number; DInt8 exp ] -> (try if exp < 0y then - IntRuntimeError.Error.NegativeExponent - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack else (bigint number) ** (int exp) |> int8 |> DInt8 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -202,19 +178,13 @@ let fns : List = description = "Divides two 8-bit signed integers" fn = (function - | state, _, [ DInt8 a; DInt8 b ] -> + | _, vm, _, [ DInt8 a; DInt8 b ] -> if b = int8 0 then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else let result = int a / int b if result < -128 || result > 127 then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else Ply(DInt8(int8 result)) | _ -> incorrectArgs ()) @@ -230,13 +200,10 @@ let fns : List = description = "Returns the negation of , {{-a}}" fn = (function - | state, _, [ DInt8 a ] -> + | _, vm, _, [ DInt8 a ] -> let result = -(int a) if result < -128 || result > 127 then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else Ply(DInt8(int8 result)) | _ -> incorrectArgs ()) @@ -252,7 +219,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -267,7 +234,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -281,7 +248,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -296,7 +263,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -310,7 +277,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt8 a ] -> Ply(DString(string a)) + | _, _, _, [ DInt8 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -324,7 +291,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DInt8 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DInt8 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -339,7 +306,7 @@ let fns : List = "Returns a random 8-bit signed integer between and (inclusive)" fn = (function - | _, _, [ DInt8 a; DInt8 b ] -> + | _, _, _, [ DInt8 a; DInt8 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let lowerBound = max lower -128y @@ -365,7 +332,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DInt8 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DInt8 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -384,7 +351,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.int8ParseError let resultError = Dval.resultError KTInt8 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.SByte.Parse |> DInt8 |> resultOk |> Ply with @@ -406,7 +373,7 @@ let fns : List = "Converts a UInt8 to an 8-bit signed integer. Returns {{None}} if the value is greater than 127." fn = (function - | _, _, [ DUInt8 a ] -> + | _, _, _, [ DUInt8 a ] -> if a > 127uy then Dval.optionNone KTInt8 |> Ply else @@ -425,7 +392,7 @@ let fns : List = "Converts an Int16 to an 8-bit signed integer. Returns {{None}} if the value is less than -128 or greater than 127." fn = (function - | _, _, [ DInt16 a ] -> + | _, _, _, [ DInt16 a ] -> if a < -128s || a > 127s then Dval.optionNone KTInt8 |> Ply else @@ -444,7 +411,7 @@ let fns : List = "Converts a UInt16 to an 8-bit signed integer. Returns {{None}} if the value is greater than 127." fn = (function - | _, _, [ DUInt16 a ] -> + | _, _, _, [ DUInt16 a ] -> if a > 127us then Dval.optionNone KTInt8 |> Ply else @@ -463,7 +430,7 @@ let fns : List = "Converts an Int32 to an 8-bit signed integer. Returns {{None}} if the value is less than -128 or greater than 127." fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if a < -128l || a > 127l then Dval.optionNone KTInt8 |> Ply else @@ -482,7 +449,7 @@ let fns : List = "Converts a UInt32 to an 8-bit signed integer. Returns {{None}} if the value is greater than 127." fn = (function - | _, _, [ DUInt32 a ] -> + | _, _, _, [ DUInt32 a ] -> if a > 127ul then Dval.optionNone KTInt8 |> Ply else @@ -501,7 +468,7 @@ let fns : List = "Converts an Int64 to an 8-bit signed integer. Returns {{None}} if the value is less than -128 or greater than 127." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if a < -128L || a > 127L then Dval.optionNone KTInt8 |> Ply else @@ -520,7 +487,7 @@ let fns : List = "Converts a UInt64 to an 8-bit signed integer. Returns {{None}} if the value is greater than 127." fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if a > 127UL then Dval.optionNone KTInt8 |> Ply else @@ -539,7 +506,7 @@ let fns : List = "Converts an Int128 to an 8-bit signed integer. Returns {{None}} if the value is less than -128 or greater than 127." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if a < -128Q || a > 127Q then Dval.optionNone KTInt8 |> Ply else @@ -558,7 +525,7 @@ let fns : List = "Converts a UInt128 to an 8-bit signed integer. Returns {{None}} if the value is greater than 127." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if a > 127Z then Dval.optionNone KTInt8 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index 7e0cd73a77..69003451f9 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -7,7 +7,7 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module DarkDateTime = LibExecution.DarkDateTime -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker module PackageIDs = LibExecution.PackageIDs @@ -763,7 +763,8 @@ let parse // Explicitly not supported | TVariable _, _ | TFn _, _ - | TDB _, _ -> RuntimeError.raiseUnsupportedType callStack typ + //| TDB _, _ + -> RuntimeError.raiseUnsupportedType callStack typ // exhaust TypeReferences @@ -808,60 +809,62 @@ let parse let fns : List = - [ { name = fn "jsonSerialize" 0 - typeParams = [ "a" ] - parameters = [ Param.make "arg" (TVariable "a") "" ] - returnType = TString - description = "Serializes a Dark value to a JSON string." - fn = - (function - | state, [ typeToSerializeAs ], [ arg ] -> - uply { - // TODO: somehow collect list of TVariable -> TypeReference - // "'b = Int", - // so we can Json.serialize<'b>, if 'b is in the surrounding context - let types = ExecutionState.availableTypes state - let! response = - writeJson (fun w -> - serialize state.tracing.callStack types w typeToSerializeAs arg) - return DString response - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "jsonParse" 0 - typeParams = [ "a" ] - parameters = [ Param.make "json" TString "" ] - returnType = - TypeReference.result - (TVariable "a") - (TCustomType(Ok ParseError.typeName, [])) - description = - "Parses a JSON string as a Dark value, matching the type " - fn = - (function - | state, [ typeArg ], [ DString arg ] -> - let callStack = state.tracing.callStack - - let okType = VT.unknownTODO // "a" - let errType = KTCustomType(ParseError.typeName, []) |> VT.known - let resultOk = TypeChecker.DvalCreator.resultOk callStack okType errType - let resultError = - TypeChecker.DvalCreator.resultError callStack okType errType - - let types = ExecutionState.availableTypes state - uply { - match! parse callStack types typeArg arg with - | Ok v -> return resultOk v - | Error e -> return resultError (ParseError.toDT e) - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } ] + [ + // { name = fn "jsonSerialize" 0 + // typeParams = [ "a" ] + // parameters = [ Param.make "arg" (TVariable "a") "" ] + // returnType = TString + // description = "Serializes a Dark value to a JSON string." + // fn = + // (function + // | state, [ typeToSerializeAs ], [ arg ] -> + // uply { + // // TODO: somehow collect list of TVariable -> TypeReference + // // "'b = Int", + // // so we can Json.serialize<'b>, if 'b is in the surrounding context + // let types = ExecutionState.availableTypes state + // let! response = + // writeJson (fun w -> + // serialize state.tracing.callStack types w typeToSerializeAs arg) + // return DString response + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "jsonParse" 0 + // typeParams = [ "a" ] + // parameters = [ Param.make "json" TString "" ] + // returnType = + // TypeReference.result + // (TVariable "a") + // (TCustomType(Ok ParseError.typeName, [])) + // description = + // "Parses a JSON string as a Dark value, matching the type " + // fn = + // (function + // | state, [ typeArg ], [ DString arg ] -> + // let callStack = state.tracing.callStack + + // let okType = VT.unknownTODO // "a" + // let errType = KTCustomType(ParseError.typeName, []) |> VT.known + // let resultOk = TypeChecker.DvalCreator.resultOk callStack okType errType + // let resultError = + // TypeChecker.DvalCreator.resultError callStack okType errType + + // let types = ExecutionState.availableTypes state + // uply { + // match! parse callStack types typeArg arg with + // | Ok v -> return resultOk v + // | Error e -> return resultError (ParseError.toDT e) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + ] let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/LanguageTools.fs b/backend/src/BuiltinExecution/Libs/LanguageTools.fs index b3aa924aa9..92d53d0223 100644 --- a/backend/src/BuiltinExecution/Libs/LanguageTools.fs +++ b/backend/src/BuiltinExecution/Libs/LanguageTools.fs @@ -4,99 +4,97 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter module TypeChecker = LibExecution.TypeChecker -module DvalReprDeveloper = LibExecution.DvalReprDeveloper module PackageIDs = LibExecution.PackageIDs -let typeNameToStr = DvalReprDeveloper.typeName - let fns : List = - [ { name = fn "languageToolsAllBuiltinConstants" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = - TList( - TCustomType( - Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant), - [] - ) - ) - description = - "Returns a list of the Builtin constants (usually not to be accessed directly)." - fn = - (function - | state, _, [ DUnit ] -> - let constTypeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant - - let consts = - state.builtins.constants - |> Map.toList - |> List.map (fun (name, data) -> - let fields = - [ "name", DString(FQConstantName.builtinToString name) - "description", DString data.description - "returnType", DString(typeNameToStr data.typ) ] - - DRecord(constTypeName, constTypeName, [], Map fields)) - - DList(VT.customType constTypeName [], consts) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } - - - { name = fn "languageToolsAllBuiltinFns" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = - TList( - TCustomType( - Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn), - [] - ) - ) - description = - "Returns a list of the Builtin functions (usually not to be accessed directly)." - fn = - (function - | state, _, [ DUnit ] -> - let fnParamTypeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFnParam - let fnTypeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn - - let fns = - state.builtins.fns - |> Map.toList - |> List.map (fun (name, data) -> - let parameters = - data.parameters - |> List.map (fun p -> - let fields = - [ "name", DString p.name - "type", DString(typeNameToStr p.typ) ] - DRecord(fnParamTypeName, fnParamTypeName, [], Map fields)) - |> Dval.list (KTCustomType(fnParamTypeName, [])) - - let fields = - [ "name", DString(FQFnName.builtinToString name) - "description", DString data.description - "parameters", parameters - "returnType", DString(typeNameToStr data.returnType) ] - - DRecord(fnTypeName, fnTypeName, [], Map fields)) - - DList(VT.customType fnTypeName [], fns) |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } + [ + // { name = fn "languageToolsAllBuiltinConstants" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = + // TList( + // TCustomType( + // Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant), + // [] + // ) + // ) + // description = + // "Returns a list of the Builtin constants (usually not to be accessed directly)." + // fn = + // (function + // | exeState, _, _, [ DUnit ] -> + // let constTypeName = + // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant + + // let consts = + // exeState.builtins.constants + // |> Map.toList + // |> List.map (fun (name, data) -> + // let fields = + // [ "name", DString(FQConstantName.builtinToString name) + // "description", DString data.description + // "returnType", DString(typeNameToStr data.typ) ] + + // DRecord(constTypeName, constTypeName, [], Map fields)) + + // DList(VT.customType constTypeName [], consts) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + + + // { name = fn "languageToolsAllBuiltinFns" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = + // TList( + // TCustomType( + // Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn), + // [] + // ) + // ) + // description = + // "Returns a list of the Builtin functions (usually not to be accessed directly)." + // fn = + // (function + // | exeState, _, _, [ DUnit ] -> + // let fnParamTypeName = + // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFnParam + // let fnTypeName = + // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn + + // let fns = + // exeState.fns.builtIn + // |> Map.toList + // |> List.map (fun (name, data) -> + // let parameters = + // data.parameters + // |> List.map (fun p -> + // let fields = + // [ "name", DString p.name + // "type", DString(typeNameToStr p.typ) ] + // DRecord(fnParamTypeName, fnParamTypeName, [], Map fields)) + // |> Dval.list (KTCustomType(fnParamTypeName, [])) + + // let fields = + // [ "name", DString(FQFnName.builtinToString name) + // "description", DString data.description + // "parameters", parameters + // "returnType", DString(typeNameToStr data.returnType) ] + + // DRecord(fnTypeName, fnTypeName, [], Map fields)) + + // DList(VT.customType fnTypeName [], fns) |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } // This exists because the above-defined fn returns a big list, @@ -109,10 +107,10 @@ let fns : List = description = "Returns whether or not some builtin fn exists" fn = (function - | state, _, [ DString name; DInt64 version ] -> + | exeState, _, _, [ DString name; DInt64 version ] -> let name : FQFnName.Builtin = { name = name; version = int version } - let found = state.builtins.fns |> Map.find name |> Option.isSome + let found = exeState.fns.builtIn |> Map.find name |> Option.isSome DBool found |> Ply | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index 983878ae42..a9f04469a4 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -4,7 +4,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter module TypeChecker = LibExecution.TypeChecker @@ -13,137 +13,152 @@ module TypeChecker = LibExecution.TypeChecker // CLEANUP something like type ComparatorResult = Higher | Lower | Same // rather than 0/1/-2 -module DvalComparator = - let rec compareDval (dv1 : Dval) (dv2 : Dval) : int = - match dv1, dv2 with - | DInt64 i1, DInt64 i2 -> compare i1 i2 - | DUInt64 i1, DUInt64 i2 -> compare i1 i2 - | DInt8 i1, DInt8 i2 -> compare i1 i2 - | DUInt8 i1, DUInt8 i2 -> compare i1 i2 - | DInt16 i1, DInt16 i2 -> compare i1 i2 - | DUInt16 i1, DUInt16 i2 -> compare i1 i2 - | DInt32 i1, DInt32 i2 -> compare i1 i2 - | DUInt32 i1, DUInt32 i2 -> compare i1 i2 - | DInt128 i1, DInt128 i2 -> compare i1 i2 - | DUInt128 i1, DUInt128 i2 -> compare i1 i2 - | DFloat f1, DFloat f2 -> compare f1 f2 - | DBool b1, DBool b2 -> compare b1 b2 - | DUnit, DUnit -> 0 - | DString s1, DString s2 -> compare s1 s2 - | DChar c1, DChar c2 -> compare c1 c2 - | DList(_, l1), DList(_, l2) -> compareLists l1 l2 - | DTuple(a1, b1, l1), DTuple(a2, b2, l2) -> - compareLists (a1 :: b1 :: l1) (a2 :: b2 :: l2) - | DFnVal(Lambda l1), DFnVal(Lambda l2) -> - let l1' = NEList.toList l1.parameters - let l2' = NEList.toList l2.parameters - let c = compareLetPatternsLists l1' l2' - if c = 0 then compareExprs l1.body l2.body else c - - | DDB name1, DDB name2 -> compare name1 name2 - | DDateTime dt1, DDateTime dt2 -> compare dt1 dt2 - | DUuid u1, DUuid u2 -> compare u1 u2 - | DDict(_vtTODO1, o1), DDict(_vtTODO2, o2) -> - compareMaps (Map.toList o1) (Map.toList o2) - | DRecord(tn1, _, _typeArgsTODO1, o1), DRecord(tn2, _, _typeArgsTODO2, o2) -> - let c = compare tn1 tn2 - if c = 0 then compareMaps (Map.toList o1) (Map.toList o2) else c - | DEnum(typeName1, _, _typeArgsTODO1, case1, fields1), - DEnum(typeName2, _, _typeArgsTODO2, case2, fields2) -> - let c = compare typeName1 typeName2 - if c = 0 then - let c = compare case1 case2 - if c = 0 then compareLists fields1 fields2 else c - else - c - - // exhaustiveness check - | DInt64 _, _ - | DUInt64 _, _ - | DInt8 _, _ - | DUInt8 _, _ - | DInt16 _, _ - | DUInt16 _, _ - | DInt32 _, _ - | DUInt32 _, _ - | DInt128 _, _ - | DUInt128 _, _ - | DFloat _, _ - | DBool _, _ - | DUnit, _ - | DString _, _ - | DChar _, _ - | DList _, _ - | DTuple _, _ - | DFnVal _, _ - | DDB _, _ - | DDateTime _, _ - | DUuid _, _ - | DDict _, _ - | DRecord _, _ - | DEnum _, _ -> - // TODO: Feels like this should hook into typechecker and ValueTypes somehow - raiseUntargetedString "Comparing different types" [ "dv1", dv1; "dv2", dv2 ] - and compareLetPatternsLists (l1 : List) (l2 : List) : int = - - let rec equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : int = - match pattern1, pattern2 with - | LPVariable(_, name1), LPVariable(_, name2) -> compare name1 name2 - | LPUnit _, LPUnit _ -> 0 - - | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> - let all = first :: second :: theRest - let all' = first' :: second' :: theRest' - if all.Length <> all'.Length then - compare all.Length all'.Length - else - let c = equalsLetPattern first first' - if c = 0 then - let c = equalsLetPattern second second' - if c = 0 then compareLetPatternsLists theRest theRest' else c - else - c - - | LPTuple _, LPVariable _ -> 1 - | LPTuple _, LPUnit _ -> 1 - | LPUnit _, LPVariable _ -> -1 - | LPVariable _, LPUnit _ -> 1 - | LPVariable _, LPTuple _ -> -1 - | _, _ -> -1 - - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | h1 :: t1, h2 :: t2 -> - let c = equalsLetPattern h1 h2 - if c = 0 then compareLetPatternsLists t1 t2 else c - - - - and compareLists (l1 : List) (l2 : List) : int = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | h1 :: t1, h2 :: t2 -> - let c = compareDval h1 h2 - if c = 0 then compareLists t1 t2 else c - - and compareMaps (o1 : List) (o2 : List) : int = - match o1, o2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | (k1, v1) :: t1, (k2, v2) :: t2 -> - let c = compare k1 k2 - if c = 0 then - let c = compareDval v1 v2 - if c = 0 then compareMaps t1 t2 else c - else - c - - and compareExprs (_e1 : Expr) (_e2 : Expr) : int = 0 // CLEANUP +// module DvalComparator = +// let rec compareDval (dv1 : Dval) (dv2 : Dval) : int = +// match dv1, dv2 with +// | DUnit, DUnit -> 0 + +// | DBool b1, DBool b2 -> compare b1 b2 + +// | DInt8 i1, DInt8 i2 -> compare i1 i2 +// | DUInt8 i1, DUInt8 i2 -> compare i1 i2 +// | DInt16 i1, DInt16 i2 -> compare i1 i2 +// | DUInt16 i1, DUInt16 i2 -> compare i1 i2 +// | DInt32 i1, DInt32 i2 -> compare i1 i2 +// | DUInt32 i1, DUInt32 i2 -> compare i1 i2 +// | DInt64 i1, DInt64 i2 -> compare i1 i2 +// | DUInt64 i1, DUInt64 i2 -> compare i1 i2 +// | DInt128 i1, DInt128 i2 -> compare i1 i2 +// | DUInt128 i1, DUInt128 i2 -> compare i1 i2 + +// | DFloat f1, DFloat f2 -> compare f1 f2 + +// | DChar c1, DChar c2 -> compare c1 c2 +// | DString s1, DString s2 -> compare s1 s2 + +// | DDateTime dt1, DDateTime dt2 -> compare dt1 dt2 + +// | DUuid u1, DUuid u2 -> compare u1 u2 + +// | DList(_, l1), DList(_, l2) -> compareLists l1 l2 + +// | DTuple(a1, b1, l1), DTuple(a2, b2, l2) -> +// compareLists (a1 :: b1 :: l1) (a2 :: b2 :: l2) + + +// | DDict(_vtTODO1, o1), DDict(_vtTODO2, o2) -> +// compareMaps (Map.toList o1) (Map.toList o2) + +// | DRecord(tn1, _, _typeArgsTODO1, o1), DRecord(tn2, _, _typeArgsTODO2, o2) -> +// let c = compare tn1 tn2 +// if c = 0 then compareMaps (Map.toList o1) (Map.toList o2) else c + +// | DEnum(typeName1, _, _typeArgsTODO1, case1, fields1), +// DEnum(typeName2, _, _typeArgsTODO2, case2, fields2) -> +// let c = compare typeName1 typeName2 +// if c = 0 then +// let c = compare case1 case2 +// if c = 0 then compareLists fields1 fields2 else c +// else +// c + +// // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> +// // let l1' = NEList.toList l1.parameters +// // let l2' = NEList.toList l2.parameters +// // let c = compareLetPatternsLists l1' l2' +// // if c = 0 then compareExprs l1.body l2.body else c + +// //| DDB name1, DDB name2 -> compare name1 name2 + +// // exhaustiveness check +// | DUnit, _ +// | DBool _, _ +// | DInt8 _, _ +// | DUInt8 _, _ +// | DInt16 _, _ +// | DUInt16 _, _ +// | DInt32 _, _ +// | DUInt32 _, _ +// | DInt64 _, _ +// | DUInt64 _, _ +// | DInt128 _, _ +// | DUInt128 _, _ +// | DFloat _, _ +// | DChar _, _ +// | DString _, _ +// | DList _, _ +// | DDict _, _ +// | DTuple _, _ +// | DDateTime _, _ +// | DUuid _, _ +// | DRecord _, _ +// | DEnum _, _ +// | DFnVal _, _ +// //| DDB _, _ +// -> +// // TODO: Feels like this should hook into typechecker and ValueTypes somehow +// raiseUntargetedString "Comparing different types" [ "dv1", dv1; "dv2", dv2 ] + + +// // and compareLetPatternsLists (l1 : List) (l2 : List) : int = +// // let rec equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : int = +// // match pattern1, pattern2 with +// // | LPVariable(_, name1), LPVariable(_, name2) -> compare name1 name2 +// // | LPUnit _, LPUnit _ -> 0 + +// // | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> +// // let all = first :: second :: theRest +// // let all' = first' :: second' :: theRest' +// // if all.Length <> all'.Length then +// // compare all.Length all'.Length +// // else +// // let c = equalsLetPattern first first' +// // if c = 0 then +// // let c = equalsLetPattern second second' +// // if c = 0 then compareLetPatternsLists theRest theRest' else c +// // else +// // c + +// // | LPTuple _, LPVariable _ -> 1 +// // | LPTuple _, LPUnit _ -> 1 +// // | LPUnit _, LPVariable _ -> -1 +// // | LPVariable _, LPUnit _ -> 1 +// // | LPVariable _, LPTuple _ -> -1 +// // | _, _ -> -1 + +// // match l1, l2 with +// // | [], [] -> 0 +// // | [], _ -> -1 +// // | _, [] -> 1 +// // | h1 :: t1, h2 :: t2 -> +// // let c = equalsLetPattern h1 h2 +// // if c = 0 then compareLetPatternsLists t1 t2 else c + + + +// and compareLists (l1 : List) (l2 : List) : int = +// match l1, l2 with +// | [], [] -> 0 +// | [], _ -> -1 +// | _, [] -> 1 +// | h1 :: t1, h2 :: t2 -> +// let c = compareDval h1 h2 +// if c = 0 then compareLists t1 t2 else c + +// and compareMaps (o1 : List) (o2 : List) : int = +// match o1, o2 with +// | [], [] -> 0 +// | [], _ -> -1 +// | _, [] -> 1 +// | (k1, v1) :: t1, (k2, v2) :: t2 -> +// let c = compare k1 k2 +// if c = 0 then +// let c = compareDval v1 v2 +// if c = 0 then compareMaps t1 t2 else c +// else +// c + +// //and compareExprs (_e1 : Expr) (_e2 : Expr) : int = 0 // CLEANUP @@ -264,43 +279,44 @@ let varC = TVariable "c" let fns : List = - [ { name = fn "listUniqueBy" 0 - typeParams = [] - parameters = - [ Param.make "list" (TList varA) "" - Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] - returnType = TList varA - description = - "Returns the passed list, with only unique values, where uniqueness is based - on the result of . Only one of each value will be returned, but the - order will not be maintained." - fn = - (function - | state, _, [ DList(vt, l); DFnVal b ] -> - uply { - let! projected = - Ply.List.mapSequentially - (fun dv -> - uply { - let args = NEList.singleton dv - let! key = Interpreter.applyFnVal state b [] args - - // TODO: type check to ensure `varB` is "comparable" - return (dv, key) - }) - l - - return - projected - |> List.distinctBy snd - |> List.map fst - |> List.sortWith DvalComparator.compareDval - |> fun l -> DList(vt, l) - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + [ + // { name = fn "listUniqueBy" 0 + // typeParams = [] + // parameters = + // [ Param.make "list" (TList varA) "" + // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] + // returnType = TList varA + // description = + // "Returns the passed list, with only unique values, where uniqueness is based + // on the result of . Only one of each value will be returned, but the + // order will not be maintained." + // fn = + // (function + // | state, _, _, [ DList(vt, l); DFnVal b ] -> + // uply { + // let! projected = + // Ply.List.mapSequentially + // (fun dv -> + // uply { + // let args = NEList.singleton dv + // let! key = Interpreter.applyFnVal state b [] args + + // // TODO: type check to ensure `varB` is "comparable" + // return (dv, key) + // }) + // l + + // return + // projected + // |> List.distinctBy snd + // |> List.map fst + // |> List.sortWith DvalComparator.compareDval + // |> fun l -> DList(vt, l) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "listLength" 0 @@ -310,165 +326,165 @@ let fns : List = description = "Returns the number of values in " fn = (function - | _, _, [ DList(_, l) ] -> Ply(Dval.int64 (l.Length)) + | _, _, _, [ DList(_, l) ] -> Ply(Dval.int64 (l.Length)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure deprecated = NotDeprecated } - { name = fn "listUnique" 0 - typeParams = [] - parameters = [ Param.make "list" (TList varA) "" ] - returnType = TList varA - description = - "Returns the passed list, with only unique values. - Only one of each value will be returned, but the - order will not be maintained." - fn = - (function - | _, _, [ DList(vt, l) ] -> - List.distinct l - |> List.sortWith DvalComparator.compareDval - |> fun l -> DList(vt, l) - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "listSort" 0 - typeParams = [] - parameters = [ Param.make "list" (TList varA) "" ] - returnType = TList varA - description = - "Returns a copy of with every value sorted in ascending order. - - Use this if the values have types Dark knows how to sort. - - Consider or if you need more - control over the sorting process." - fn = - (function - | _, _, [ DList(vt, list) ] -> - list - |> List.sortWith DvalComparator.compareDval - |> (fun l -> DList(vt, l)) - |> Ply - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "listSortBy" 0 - typeParams = [] - parameters = - [ Param.make "list" (TList varA) "" - Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] - returnType = TList varA - description = - "Returns a copy of , sorted in ascending order, as if each value - evaluated to {{fn val}}. - - For example, {{List.sortBy [\"x\",\"jkl\",\"ab\"] \\val -> String.length - val}} returns {{[ \"x\", \"ab\", \"jkl\" ]}}. - - Consider if the list values can be directly compared, or if you want more control over the sorting process." - fn = - (function - | state, _, [ DList(vt, list); DFnVal b ] -> - uply { - let fn dv = - let args = NEList.singleton dv - Interpreter.applyFnVal state b [] args - let! withKeys = - list - |> Ply.List.mapSequentially (fun v -> - uply { - let! key = fn v - return (key, v) - }) - - return - withKeys - |> List.sortWith (fun (k1, _) (k2, _) -> - DvalComparator.compareDval k1 k2) - |> List.map snd - |> fun l -> DList(vt, l) - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "listSortByComparator" 0 - typeParams = [] - parameters = - [ Param.make "list" (TList varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.doubleton varA varA, TInt64)) - "" - [ "a"; "b" ] ] - returnType = TypeReference.result varA TString - description = - "Returns a copy of , sorted using {{fn a b}} to compare values - and . - - must return {{-1}} if should appear before , {{1}} - if should appear after , and {{0}} if the order of - and doesn't matter. - - Consider or if you don't need this level - of control." - fn = - - (function - | state, _, [ DList(vt, list); DFnVal f ] -> - let okType = VT.unknownTODO - let resultOk = - TypeChecker.DvalCreator.resultOk state.tracing.callStack okType VT.string - let resultError = - TypeChecker.DvalCreator.resultError - state.tracing.callStack - okType - VT.string - - - let fn (dv1 : Dval) (dv2 : Dval) : Ply = - uply { - let args = NEList.doubleton dv1 dv2 - let! result = Interpreter.applyFnVal state f [] args - - match result with - | DInt64 i when i = 1L || i = 0L || i = -1L -> return int i - | DInt64 i -> return raise (Sort.InvalidSortComparatorInt i) - | v -> - return! - TypeChecker.raiseFnValResultNotExpectedType - state.tracing.callStack - v - TInt64 - } - - uply { - try - let array = List.toArray list - do! Sort.sort fn array - return array |> Array.toList |> (fun l -> DList(vt, l)) |> resultOk - with Sort.InvalidSortComparatorInt i -> - let message = - $"Expected comparator function to return -1, 0, or 1, but it returned {i}" - return resultError (DString message) - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "listUnique" 0 + // typeParams = [] + // parameters = [ Param.make "list" (TList varA) "" ] + // returnType = TList varA + // description = + // "Returns the passed list, with only unique values. + // Only one of each value will be returned, but the + // order will not be maintained." + // fn = + // (function + // | _, _, _, [ DList(vt, l) ] -> + // List.distinct l + // |> List.sortWith DvalComparator.compareDval + // |> fun l -> DList(vt, l) + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "listSort" 0 + // typeParams = [] + // parameters = [ Param.make "list" (TList varA) "" ] + // returnType = TList varA + // description = + // "Returns a copy of with every value sorted in ascending order. + + // Use this if the values have types Dark knows how to sort. + + // Consider or if you need more + // control over the sorting process." + // fn = + // (function + // | _, _, _, [ DList(vt, list) ] -> + // list + // |> List.sortWith DvalComparator.compareDval + // |> (fun l -> DList(vt, l)) + // |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "listSortBy" 0 + // typeParams = [] + // parameters = + // [ Param.make "list" (TList varA) "" + // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] + // returnType = TList varA + // description = + // "Returns a copy of , sorted in ascending order, as if each value + // evaluated to {{fn val}}. + + // For example, {{List.sortBy [\"x\",\"jkl\",\"ab\"] \\val -> String.length + // val}} returns {{[ \"x\", \"ab\", \"jkl\" ]}}. + + // Consider if the list values can be directly compared, or if you want more control over the sorting process." + // fn = + // (function + // | state, _, _, [ DList(vt, list); DFnVal b ] -> + // uply { + // let fn dv = + // let args = NEList.singleton dv + // Interpreter.applyFnVal state b [] args + // let! withKeys = + // list + // |> Ply.List.mapSequentially (fun v -> + // uply { + // let! key = fn v + // return (key, v) + // }) + + // return + // withKeys + // |> List.sortWith (fun (k1, _) (k2, _) -> + // DvalComparator.compareDval k1 k2) + // |> List.map snd + // |> fun l -> DList(vt, l) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "listSortByComparator" 0 + // typeParams = [] + // parameters = + // [ Param.make "list" (TList varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.doubleton varA varA, TInt64)) + // "" + // [ "a"; "b" ] ] + // returnType = TypeReference.result varA TString + // description = + // "Returns a copy of , sorted using {{fn a b}} to compare values + // and . + + // must return {{-1}} if should appear before , {{1}} + // if should appear after , and {{0}} if the order of + // and doesn't matter. + + // Consider or if you don't need this level + // of control." + // fn = + + // (function + // | state, _, _, [ DList(vt, list); DFnVal f ] -> + // let okType = VT.unknownTODO + // let resultOk = + // TypeChecker.DvalCreator.resultOk state.tracing.callStack okType VT.string + // let resultError = + // TypeChecker.DvalCreator.resultError + // state.tracing.callStack + // okType + // VT.string + + + // let fn (dv1 : Dval) (dv2 : Dval) : Ply = + // uply { + // let args = NEList.doubleton dv1 dv2 + // let! result = Interpreter.applyFnVal state f [] args + + // match result with + // | DInt64 i when i = 1L || i = 0L || i = -1L -> return int i + // | DInt64 i -> return raise (Sort.InvalidSortComparatorInt i) + // | v -> + // return! + // TypeChecker.raiseFnValResultNotExpectedType + // state.tracing.callStack + // v + // TInt64 + // } + + // uply { + // try + // let array = List.toArray list + // do! Sort.sort fn array + // return array |> Array.toList |> (fun l -> DList(vt, l)) |> resultOk + // with Sort.InvalidSortComparatorInt i -> + // let message = + // $"Expected comparator function to return -1, 0, or 1, but it returned {i}" + // return resultError (DString message) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "listAppend" 0 @@ -481,162 +497,157 @@ let fns : List = preserving the order." fn = (function - | state, _, [ DList(vt1, l1); DList(_vt2, l2) ] -> + | _, 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 - state.tracing.callStack - vt1 - (List.append l1 l2) - ) - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "listIndexedMap" 0 - typeParams = [] - parameters = - [ Param.make "list" (TList varA) "" - Param.makeWithArgs - "fn" - (TFn(NEList.doubleton TInt64 varA, varB)) - "" - [ "index"; "val" ] ] - returnType = TList varB - description = - "Calls on every and its in , - returning a list of the results of those calls. - - Consider if you don't need the index." - fn = - (function - | state, _, [ DList(_vtTODO, l); DFnVal b ] -> - uply { - let list = List.mapi (fun i v -> (i, v)) l - - let! result = - Ply.List.mapSequentially - (fun ((i, dv) : int * Dval) -> - let args = NEList.doubleton (DInt64(int64 i)) dv - Interpreter.applyFnVal state b [] args) - list - - return - TypeChecker.DvalCreator.list - state.tracing.callStack - VT.unknownTODO - result - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "listMap2shortest" 0 - typeParams = [] - parameters = - [ Param.make "as" (TList varA) "" - Param.make "bs" (TList varB) "" - Param.makeWithArgs - "fn" - (TFn(NEList.doubleton varA varB, varC)) - "" - [ "a"; "b" ] ] - returnType = TList varC - description = - "Maps over and in parallel, calling {{fn a - b}} on every pair of values from and . - - If the lists differ in length, values from the longer list are dropped. - - For example, if is {{[1,2]}} and is - {{[\"x\",\"y\",\"z\"]}}, returns {{[(f 1 \"x\"), (f 2 \"y\")]}} - - Use if you want to enforce equivalent lengths for - and ." - fn = - (function - | state, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> - uply { - let len = min (List.length l1) (List.length l2) - let l1 = List.take (int len) l1 - let l2 = List.take (int len) l2 - - let list = List.zip l1 l2 - - let! result = - Ply.List.mapSequentially - (fun ((dv1, dv2) : Dval * Dval) -> - let args = NEList.doubleton dv1 dv2 - Interpreter.applyFnVal state b [] args) - list - - return - TypeChecker.DvalCreator.list - state.tracing.callStack - VT.unknownTODO - result - } + Ply(TypeChecker.DvalCreator.list vm.callStack vt1 (List.append l1 l2)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure deprecated = NotDeprecated } - { name = fn "listMap2" 0 - typeParams = [] - parameters = - [ Param.make "as" (TList varA) "" - Param.make "bs" (TList varB) "" - Param.makeWithArgs - "fn" - (TFn(NEList.doubleton varA varB, varC)) - "" - [ "a"; "b" ] ] - returnType = TypeReference.option varC - description = - "If the lists are the same length, returns {{Some list}} formed by mapping - over and in parallel, calling {{fn a b}} on - every pair of values from and . - - For example, if is {{[1,2,3]}} and is - {{[\"x\",\"y\",\"z\"]}}, returns {{[(fn 1 \"x\"), (f 2 \"y\"), (f 3 - \"z\")]}}. - - If the lists differ in length, returns {{None}} (consider if you want to drop values from the longer list - instead)." - fn = - let optType = VT.unknownTODO - (function - | state, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> - uply { - if List.length l1 <> List.length l2 then - return TypeChecker.DvalCreator.optionNone optType - else - let list = List.zip l1 l2 - - let! result = - Ply.List.mapSequentially - (fun ((dv1, dv2) : Dval * Dval) -> - let args = NEList.doubleton dv1 dv2 - Interpreter.applyFnVal state b [] args) - list - - let callStack = state.tracing.callStack - - return - TypeChecker.DvalCreator.list callStack VT.unknownTODO result - |> TypeChecker.DvalCreator.optionSome callStack optType - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } + // { name = fn "listIndexedMap" 0 + // typeParams = [] + // parameters = + // [ Param.make "list" (TList varA) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.doubleton TInt64 varA, varB)) + // "" + // [ "index"; "val" ] ] + // returnType = TList varB + // description = + // "Calls on every and its in , + // returning a list of the results of those calls. + + // Consider if you don't need the index." + // fn = + // (function + // | state, _, _, [ DList(_vtTODO, l); DFnVal b ] -> + // uply { + // let list = List.mapi (fun i v -> (i, v)) l + + // let! result = + // Ply.List.mapSequentially + // (fun ((i, dv) : int * Dval) -> + // let args = NEList.doubleton (DInt64(int64 i)) dv + // Interpreter.applyFnVal state b [] args) + // list + + // return + // TypeChecker.DvalCreator.list + // state.tracing.callStack + // VT.unknownTODO + // result + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "listMap2shortest" 0 + // typeParams = [] + // parameters = + // [ Param.make "as" (TList varA) "" + // Param.make "bs" (TList varB) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.doubleton varA varB, varC)) + // "" + // [ "a"; "b" ] ] + // returnType = TList varC + // description = + // "Maps over and in parallel, calling {{fn a + // b}} on every pair of values from and . + + // If the lists differ in length, values from the longer list are dropped. + + // For example, if is {{[1,2]}} and is + // {{[\"x\",\"y\",\"z\"]}}, returns {{[(f 1 \"x\"), (f 2 \"y\")]}} + + // Use if you want to enforce equivalent lengths for + // and ." + // fn = + // (function + // | state, _, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> + // uply { + // let len = min (List.length l1) (List.length l2) + // let l1 = List.take (int len) l1 + // let l2 = List.take (int len) l2 + + // let list = List.zip l1 l2 + + // let! result = + // Ply.List.mapSequentially + // (fun ((dv1, dv2) : Dval * Dval) -> + // let args = NEList.doubleton dv1 dv2 + // Interpreter.applyFnVal state b [] args) + // list + + // return + // TypeChecker.DvalCreator.list + // state.tracing.callStack + // VT.unknownTODO + // result + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "listMap2" 0 + // typeParams = [] + // parameters = + // [ Param.make "as" (TList varA) "" + // Param.make "bs" (TList varB) "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.doubleton varA varB, varC)) + // "" + // [ "a"; "b" ] ] + // returnType = TypeReference.option varC + // description = + // "If the lists are the same length, returns {{Some list}} formed by mapping + // over and in parallel, calling {{fn a b}} on + // every pair of values from and . + + // For example, if is {{[1,2,3]}} and is + // {{[\"x\",\"y\",\"z\"]}}, returns {{[(fn 1 \"x\"), (f 2 \"y\"), (f 3 + // \"z\")]}}. + + // If the lists differ in length, returns {{None}} (consider if you want to drop values from the longer list + // instead)." + // fn = + // let optType = VT.unknownTODO + // (function + // | state, _, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> + // uply { + // if List.length l1 <> List.length l2 then + // return TypeChecker.DvalCreator.optionNone optType + // else + // let list = List.zip l1 l2 + + // let! result = + // Ply.List.mapSequentially + // (fun ((dv1, dv2) : Dval * Dval) -> + // let args = NEList.doubleton dv1 dv2 + // Interpreter.applyFnVal state b [] args) + // list + + // let callStack = state.tracing.callStack + + // return + // TypeChecker.DvalCreator.list callStack VT.unknownTODO result + // |> TypeChecker.DvalCreator.optionSome callStack optType + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "listRandomElement" 0 @@ -650,15 +661,16 @@ let fns : List = fn = let optType = VT.unknownTODO (function - | _, _, [ DList(_, []) ] -> TypeChecker.DvalCreator.optionNone optType |> Ply - | state, _, [ DList(_, l) ] -> + | _, _, _, [ DList(_, []) ] -> + TypeChecker.DvalCreator.optionNone optType |> Ply + | _, vm, _, [ DList(_, l) ] -> // Will return <= (length - 1) // Maximum value is Int64.MaxValue which is half of UInt64.MaxValue, but // that won't affect this as we won't have a list that big for a long long // long time. let index = RNG.GetInt32(l.Length) (List.tryItem index l) - |> TypeChecker.DvalCreator.option state.tracing.callStack optType + |> TypeChecker.DvalCreator.option vm.callStack optType |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -666,55 +678,56 @@ let fns : List = deprecated = NotDeprecated } - { name = fn "listGroupByWithKey" 0 - typeParams = [] - parameters = - [ Param.make "list" (TList varA) "" - Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "item" ] ] - returnType = TList(TTuple(varB, TList varA, [])) - description = - "Groups into tuples (key, elements), where the key is computed by applying - to each element in the list. - - For example, if is {{[1, 2, 3, 4, 5]}} and - is {{fn item -> Int64.mod item 2}}, returns {{[(1, [1, 3, 5]), (0, [2, 4])]}}. - - Preserves the order of values and of the keys." - fn = - (function - | state, _, [ DList(listType, l); DFnVal fn ] -> - uply { - let applyFn (dval : Dval) : DvalTask = - let args = NEList.singleton dval - Interpreter.applyFnVal state fn [] args - - // apply the function to each element in the list - let! result = - Ply.List.mapSequentially - (fun dval -> - uply { - let! key = applyFn dval - return (key, dval) - }) - l - - return - result - |> Seq.groupBy fst - |> Seq.toList - |> List.map (fun (key, elementsWithKey) -> - DTuple( - key, - DList(listType, Seq.map snd elementsWithKey |> Seq.toList), - [] - )) - |> fun pairs -> - DList(VT.tuple VT.unknownTODO (VT.list listType) [], pairs) - } - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } ] + // { name = fn "listGroupByWithKey" 0 + // typeParams = [] + // parameters = + // [ Param.make "list" (TList varA) "" + // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "item" ] ] + // returnType = TList(TTuple(varB, TList varA, [])) + // description = + // "Groups into tuples (key, elements), where the key is computed by applying + // to each element in the list. + + // For example, if is {{[1, 2, 3, 4, 5]}} and + // is {{fn item -> Int64.mod item 2}}, returns {{[(1, [1, 3, 5]), (0, [2, 4])]}}. + + // Preserves the order of values and of the keys." + // fn = + // (function + // | state, _, _, [ DList(listType, l); DFnVal fn ] -> + // uply { + // let applyFn (dval : Dval) : DvalTask = + // let args = NEList.singleton dval + // Interpreter.applyFnVal state fn [] args + + // // apply the function to each element in the list + // let! result = + // Ply.List.mapSequentially + // (fun dval -> + // uply { + // let! key = applyFn dval + // return (key, dval) + // }) + // l + + // return + // result + // |> Seq.groupBy fst + // |> Seq.toList + // |> List.map (fun (key, elementsWithKey) -> + // DTuple( + // key, + // DList(listType, Seq.map snd elementsWithKey |> Seq.toList), + // [] + // )) + // |> fun pairs -> + // DList(VT.tuple VT.unknownTODO (VT.list listType) [], pairs) + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotYetImplemented + // previewable = Pure + // deprecated = NotDeprecated } + ] let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/Math.fs b/backend/src/BuiltinExecution/Libs/Math.fs index 46446f460f..9152041177 100644 --- a/backend/src/BuiltinExecution/Libs/Math.fs +++ b/backend/src/BuiltinExecution/Libs/Math.fs @@ -9,7 +9,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval let varA = TVariable "a" @@ -28,7 +28,7 @@ let fns : List = hypotenuse." fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cos a)) + | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cos a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -46,7 +46,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 ] -> Ply(DFloat(System.Math.Sin a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -65,7 +65,7 @@ let fns : List = adjacent to the angle." fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Tan a)) + | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Tan a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -86,7 +86,7 @@ let fns : List = This function is the inverse of ." fn = (function - | _, _, [ DFloat r ] -> + | _, _, _, [ DFloat r ] -> let res = System.Math.Acos r in if System.Double.IsNaN res then @@ -113,7 +113,7 @@ let fns : List = This function is the inverse of ." fn = (function - | _, _, [ DFloat r ] -> + | _, _, _, [ DFloat r ] -> let res = System.Math.Asin r in if System.Double.IsNaN res then @@ -138,7 +138,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 ] -> Ply(DFloat(System.Math.Atan a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -159,7 +159,7 @@ let fns : List = individual values and ." fn = (function - | _, _, [ DFloat y; DFloat x ] -> Ply(DFloat(System.Math.Atan2(y, x))) + | _, _, _, [ DFloat y; DFloat x ] -> Ply(DFloat(System.Math.Atan2(y, x))) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -173,7 +173,7 @@ let fns : List = description = "Returns the hyperbolic cosine of " fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cosh a)) + | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Cosh a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -187,7 +187,7 @@ let fns : List = description = "Returns the hyperbolic sine of " fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sinh a)) + | _, _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sinh a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -201,7 +201,7 @@ let fns : List = description = "Returns the hyperbolic tangent of " fn = (function - | _, _, [ DFloat a ] -> Ply(DFloat(System.Math.Sinh a)) + | _, _, _, [ DFloat a ] -> Ply(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 08c8104167..5edd04920e 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -2,15 +2,21 @@ module BuiltinExecution.Libs.NoModule open Prelude -module DvalReprDeveloper = LibExecution.DvalReprDeveloper - open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module PackageIDs = LibExecution.PackageIDs module Dval = LibExecution.Dval +module ValueType = LibExecution.ValueType +module RTE = RuntimeError +/// Note that type errors should be handled by the caller, +/// by using `Dval.toValueType`, attempting to merge the types, +/// and raising an RTE if the merge fails. +/// Any type mis-matches found in this fn will just return `false`. let rec equals (a : Dval) (b : Dval) : bool = + let r = equals + match a, b with | DUnit, DUnit -> true @@ -39,35 +45,38 @@ let rec equals (a : Dval) (b : Dval) : bool = | DList(typA, a), DList(typB, b) -> Result.isOk (ValueType.merge typA typB) && a.Length = b.Length - && List.forall2 equals a b + && List.forall2 r a b | DTuple(a1, a2, a3), DTuple(b1, b2, b3) -> if a3.Length <> b3.Length then // special case - this is a type error - raiseUntargetedString "tuples must be the same length" + false else - equals a1 b1 && equals a2 b2 && List.forall2 equals a3 b3 + r a1 b1 && r a2 b2 && List.forall2 r a3 b3 | DDict(_vtTODO1, a), DDict(_vtTODO2, b) -> Map.count a = Map.count b && Map.forall - (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) + (fun k v -> Map.find k b |> Option.map (r v) |> Option.defaultValue false) a - // | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> - // tn1 = tn2 // these should be the fully resolved type - // && Map.count a = Map.count b - // && Map.forall - // (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) - // a + | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> + tn1 = tn2 // these should be the fully resolved type + && Map.count a = Map.count b + && Map.forall + (fun k v -> Map.find k b |> Option.map (r v) |> Option.defaultValue false) + a + + | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type + a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 r a3 b3 + | DFnVal a, DFnVal b -> match a, b with // | Lambda a, Lambda b -> equalsLambdaImpl a b | NamedFn a, NamedFn b -> a = b // | Lambda _, _ + //| NamedFn _, _ -> false // | DDB a, DDB b -> a = b - // | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type - // a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 equals a3 b3 // exhaustiveness check | DUnit, _ @@ -83,18 +92,20 @@ let rec equals (a : Dval) (b : Dval) : bool = | DInt128 _, _ | DUInt128 _, _ | DFloat _, _ - | DString _, _ | DChar _, _ + | DString _, _ + | DDateTime _, _ + | DUuid _, _ | DList _, _ | DTuple _, _ | DDict _, _ - //| DRecord _, _ + | DRecord _, _ + | DEnum _, _ | DFnVal _, _ - | DDateTime _, _ - | DUuid _, _ // | DDB _, _ - // | DEnum _, _ - -> raiseUntargetedString "Both values must be the same type" + -> + // type errors; should be caught above by the caller + false // and equalsLambdaImpl (impl1 : LambdaImpl) (impl2 : LambdaImpl) : bool = // // TODO what to do for TypeSymbolTable @@ -343,25 +354,35 @@ let fns : List = description = "Returns true if the two value are equal" fn = (function - | _, _, _, [ a; b ] -> equals a b |> DBool |> Ply + | _, vm, _, [ a; b ] -> + let (vtA, vtB) = (Dval.toValueType a, Dval.toValueType b) + match ValueType.merge vtA vtB with + | Error _ -> + raiseRTE vm.callStack (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) + | Ok _ -> equals a b |> DBool |> Ply | _ -> incorrectArgs ()) - //sqlSpec = SqlBinOp "=" + sqlSpec = SqlBinOp "=" previewable = Pure deprecated = NotDeprecated } - // { name = fn "notEquals" 0 - // typeParams = [] - // parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] - // returnType = TBool - // description = "Returns true if the two value are not equal" - // fn = - // (function - // | _, _, [ a; b ] -> equals a b |> not |> DBool |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "<>" - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "notEquals" 0 + typeParams = [] + parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] + returnType = TBool + description = "Returns true if the two value are not equal" + fn = + (function + | _, vm, _, [ a; b ] -> + let (vtA, vtB) = (Dval.toValueType a, Dval.toValueType b) + match ValueType.merge vtA vtB with + | Error _ -> + raiseRTE vm.callStack (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) + | Ok _ -> equals a b |> not |> DBool |> Ply + | _ -> incorrectArgs ()) + sqlSpec = SqlBinOp "<>" + previewable = Pure + deprecated = NotDeprecated } // { name = fn "unwrap" 0 @@ -428,7 +449,7 @@ let fns : List = // description = "Prints the given to the standard output" // fn = // (function - // | _, _, [ DString label; value ] -> + // | _, _, _, [ DString label; value ] -> // // TODO: call upon the Dark equivalent fn instead of rlying on DvalReprDeveloper // print $"DEBUG: {label} - {DvalReprDeveloper.toRepr value}" // Ply DUnit @@ -460,4 +481,4 @@ let fns : List = ] -let builtins = LibExecution.Builtin.make fns +let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/Parser.fs b/backend/src/BuiltinExecution/Libs/Parser.fs index 2db91dbbb4..080f769e23 100644 --- a/backend/src/BuiltinExecution/Libs/Parser.fs +++ b/backend/src/BuiltinExecution/Libs/Parser.fs @@ -10,7 +10,7 @@ open LibExecution.Builtin.Shortcuts open LibTreeSitter -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module IDs = LibExecution.PackageIDs.Type.LanguageTools.Parser @@ -28,7 +28,7 @@ let fns : List = description = "Parses some Darklang code" fn = (function - | _, _, [ DString sourceCode ] -> + | _, _, _, [ DString sourceCode ] -> // This was added to handle EGCs correctly let byteIndexToCharIndex (byteIndex : int) (text : string) : int = let bytes = Encoding.UTF8.GetBytes(text) diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index e005fb5fa0..3f7d7c6f96 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -12,49 +12,50 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker module Interpreter = LibExecution.Interpreter let fns : List = - [ { name = fn "stringMap" 0 - typeParams = [] - parameters = - [ Param.make "s" TString "" - Param.makeWithArgs - "fn" - (TFn(NEList.singleton TChar, TChar)) - "" - [ "character" ] ] - returnType = TString - description = - "Iterate over each Char (EGC, not byte) in the string, performing the - operation in on each one." - fn = - (function - | state, _, [ DString s; DFnVal b ] -> - (String.toEgcSeq s - |> Seq.toList - |> Ply.List.mapSequentially (fun te -> - let args = NEList.singleton (DChar te) - Interpreter.applyFnVal state b [] args) - |> Ply.bind (fun dvals -> - dvals - |> Ply.List.mapSequentially (function - | DChar c -> Ply c - | dv -> - TypeChecker.raiseFnValResultNotExpectedType - state.tracing.callStack - dv - TChar) - |> Ply.map (fun parts -> - parts |> String.concat "" |> String.normalize |> DString))) - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Pure - deprecated = NotDeprecated } + [ + // { name = fn "stringMap" 0 + // typeParams = [] + // parameters = + // [ Param.make "s" TString "" + // Param.makeWithArgs + // "fn" + // (TFn(NEList.singleton TChar, TChar)) + // "" + // [ "character" ] ] + // returnType = TString + // description = + // "Iterate over each Char (EGC, not byte) in the string, performing the + // operation in on each one." + // fn = + // (function + // | state, _, _, [ DString s; DFnVal b ] -> + // (String.toEgcSeq s + // |> Seq.toList + // |> Ply.List.mapSequentially (fun te -> + // let args = NEList.singleton (DChar te) + // Interpreter.applyFnVal state b [] args) + // |> Ply.bind (fun dvals -> + // dvals + // |> Ply.List.mapSequentially (function + // | DChar c -> Ply c + // | dv -> + // TypeChecker.raiseFnValResultNotExpectedType + // state.tracing.callStack + // dv + // TChar) + // |> Ply.map (fun parts -> + // parts |> String.concat "" |> String.normalize |> DString))) + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } { name = fn "stringToList" 0 @@ -64,7 +65,7 @@ let fns : List = description = "Returns the list of Characters (EGC, not byte) in the string" fn = (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> s |> String.toEgcSeq |> Seq.map (fun c -> DChar c) @@ -89,7 +90,7 @@ let fns : List = replaceWith>" fn = (function - | _, _, [ DString s; DString search; DString replace ] -> + | _, _, _, [ DString s; DString search; DString replace ] -> if search = "" then if s = "" then Ply(DString replace) @@ -117,7 +118,7 @@ let fns : List = description = "Returns the string, uppercased" fn = (function - | _, _, [ DString s ] -> Ply(DString(String.toUppercase s)) + | _, _, _, [ DString s ] -> Ply(DString(String.toUppercase s)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "upper" previewable = Pure @@ -131,7 +132,7 @@ let fns : List = description = "Returns the string, lowercased" fn = (function - | _, _, [ DString s ] -> Ply(DString(String.toLowercase s)) + | _, _, _, [ DString s ] -> Ply(DString(String.toLowercase s)) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "lower" previewable = Pure @@ -145,7 +146,7 @@ let fns : List = description = "Returns the length of the string" fn = (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> s |> String.lengthInEgcs |> int64 |> Dval.int64 |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented // there isn't a unicode version of length @@ -163,7 +164,7 @@ let fns : List = fn = (function // TODO add fuzzer to ensure all strings are normalized no matter what we do to them. - | _, _, [ DString s1; DString s2 ] -> + | _, _, _, [ DString s1; DString s2 ] -> (s1 + s2) |> String.normalize |> DString |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -182,7 +183,7 @@ let fns : List = alphanumeric characters, joined by hyphens" fn = (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> // Should work the same as https://blog.tersmitten.nl/slugify/ // explicitly limit to (roman) alphanumeric for pretty urls let toRemove = "([^a-z0-9\\s_-]|\x0b)+" @@ -211,7 +212,7 @@ let fns : List = description = "Reverses " fn = (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> String.toEgcSeq s |> Seq.rev |> String.concat "" |> DString |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunction "reverse" @@ -228,7 +229,7 @@ let fns : List = If the separator is not present, returns a list containing only the initial string." fn = (function - | _, _, [ DString s; DString sep ] -> + | _, _, _, [ DString s; DString sep ] -> let ecgStringSplit str sep = let startsWithSeparator str = sep = (str |> List.truncate sep.Length) @@ -271,7 +272,7 @@ let fns : List = description = "Combines a list of strings with the provided separator" fn = (function - | _, _, [ DList(_, l); DString sep ] -> + | _, _, _, [ DList(_, l); DString sep ] -> l |> List.map (fun s -> match s with @@ -299,7 +300,7 @@ let fns : List = Negative indices start counting from the end of ." fn = (function - | _, _, [ DString s; DInt64 first; DInt64 last ] -> + | _, _, _, [ DString s; DInt64 first; DInt64 last ] -> let getLengthInTextElements s = System.Globalization.StringInfo(s).LengthInTextElements @@ -347,7 +348,7 @@ let fns : List = {{\"\\n\"}}" fn = (function - | _, _, [ DString toTrim ] -> toTrim.Trim() |> DString |> Ply + | _, _, _, [ DString toTrim ] -> toTrim.Trim() |> DString |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlFunction "trim" previewable = Pure @@ -364,7 +365,7 @@ let fns : List = includes {{\" \"}}, {{\"\\t\"}} and {{\"\\n\"}}" fn = (function - | _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimStart())) + | _, _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimStart())) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "ltrim" previewable = Pure @@ -381,7 +382,7 @@ let fns : List = property, which includes {{\" \"}}, {{\"\\t\"}} and {{\"\\n\"}}." fn = (function - | _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimEnd())) + | _, _, _, [ DString toTrim ] -> Ply(DString(toTrim.TrimEnd())) | _ -> incorrectArgs ()) sqlSpec = SqlFunction "rtrim" previewable = Pure @@ -396,7 +397,7 @@ let fns : List = "Converts the given unicode string to a UTF8-encoded byte sequence." fn = (function - | _, _, [ DString str ] -> + | _, _, _, [ DString str ] -> let theBytes = System.Text.Encoding.UTF8.GetBytes str Ply(Dval.byteArrayToDvalList theBytes) | _ -> incorrectArgs ()) @@ -413,8 +414,8 @@ let fns : List = "Converts the UTF8-encoded byte sequence into a string. Errors will be ignored by replacing invalid characters" fn = (function - | _, _, [ DList(_vt, bytes) ] -> - let bytes = Dval.DlistToByteArray bytes + | _, _, _, [ DList(_vt, bytes) ] -> + let bytes = Dval.dlistToByteArray bytes let str = System.Text.Encoding.UTF8.GetString bytes Ply(DString str) | _ -> incorrectArgs ()) @@ -431,9 +432,9 @@ let fns : List = "Converts the UTF8-encoded byte sequence into a string. Errors will be ignored by replacing invalid characters" fn = (function - | _, _, [ DList(_vt, bytes) ] -> + | _, _, _, [ DList(_vt, bytes) ] -> try - let bytes = Dval.DlistToByteArray bytes + let bytes = Dval.dlistToByteArray bytes let str = System.Text.UTF8Encoding(false, true).GetString bytes Dval.optionSome KTString (DString str) |> Ply with e -> @@ -457,7 +458,7 @@ let fns : List = "Returns the index of the first occurrence of in , or returns -1 if does not occur." fn = (function - | _, _, [ DString str; DString search ] -> + | _, _, _, [ DString str; DString search ] -> let index = str.IndexOf(search) Ply(DInt64 index) | _ -> incorrectArgs ()) @@ -474,7 +475,7 @@ let fns : List = "Returns {{Some char}} of the first character of , or returns {{None}} if is empty." fn = (function - | _, _, [ DString str ] -> + | _, _, _, [ DString str ] -> if str = "" then Dval.optionNone KTChar |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/UInt128.fs b/backend/src/BuiltinExecution/Libs/UInt128.fs index 6b991376dc..722ec4812f 100644 --- a/backend/src/BuiltinExecution/Libs/UInt128.fs +++ b/backend/src/BuiltinExecution/Libs/UInt128.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -44,12 +44,9 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DUInt128 v; DUInt128 m ] -> + | _, vm, _, [ DUInt128 v; DUInt128 m ] -> if m = System.UInt128.Zero then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < System.UInt128.Zero then m + result else result @@ -67,15 +64,12 @@ let fns : List = description = "Adds two 128-bit unsigned integers together" fn = (function - | state, _, [ DUInt128 a; DUInt128 b ] -> + | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedAddition (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -89,15 +83,12 @@ let fns : List = description = "Subtracts two 128-bit unsigned integers" fn = (function - | state, _, [ DUInt128 a; DUInt128 b ] -> + | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedSubtraction (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -112,15 +103,12 @@ let fns : List = description = "Multiplies two 128-bit unsigned integers" fn = (function - | state, _, [ DUInt128 a; DUInt128 b ] -> + | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_CheckedMultiply (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -137,21 +125,15 @@ let fns : List = description = "Divides two 128-bit unsigned integers" fn = (function - | state, _, [ DUInt128 a; DUInt128 b ] -> + | _, vm, _, [ DUInt128 a; DUInt128 b ] -> try let result = System.UInt128.op_Division (a, b) Ply(DUInt128(result)) with | :? System.DivideByZeroException -> - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack | :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -165,7 +147,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -180,7 +162,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -194,7 +176,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -209,7 +191,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -223,7 +205,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt128 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt128 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -237,7 +219,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt128 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt128 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -251,7 +233,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DUInt128 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt128 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -274,7 +256,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uint128ParseError let resultError = Dval.resultError KTUInt128 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.UInt128.Parse |> DUInt128 |> resultOk |> Ply with @@ -295,7 +277,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -309,7 +291,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -323,7 +305,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -337,7 +319,7 @@ 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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt16.fs b/backend/src/BuiltinExecution/Libs/UInt16.fs index f9d14d3de4..8c1617c239 100644 --- a/backend/src/BuiltinExecution/Libs/UInt16.fs +++ b/backend/src/BuiltinExecution/Libs/UInt16.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -45,12 +45,9 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DUInt16 v; DUInt16 m ] -> + | _, vm, _, [ DUInt16 v; DUInt16 m ] -> if m = 0us then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack |> Ply else let result = v % m let result = if result < 0us then m + result else result @@ -68,15 +65,12 @@ let fns : List = description = "Adds two 16-bit unsigned integers together" fn = (function - | state, _, [ DUInt16 a; DUInt16 b ] -> + | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(+) a b Ply(DUInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -91,15 +85,12 @@ let fns : List = description = "Subtracts two 16-bit unsigned integers" fn = (function - | state, _, [ DUInt16 a; DUInt16 b ] -> + | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(-) a b Ply(DUInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -114,15 +105,12 @@ let fns : List = description = "Multiplies two 16-bit unsigned integers" fn = (function - | state, _, [ DUInt16 a; DUInt16 b ] -> + | _, vm, _, [ DUInt16 a; DUInt16 b ] -> try let result = Checked.(*) a b Ply(DUInt16(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -140,14 +128,11 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DUInt16 number; DUInt16 exp ] -> + | _, vm, _, [ DUInt16 number; DUInt16 exp ] -> (try (bigint number) ** (int exp) |> uint16 |> DUInt16 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -161,21 +146,15 @@ let fns : List = description = "Divides two 16-bit unsigned integers" fn = (function - | state, _, [ DUInt16 a; DUInt16 b ] -> + | _, vm, _, [ DUInt16 a; DUInt16 b ] -> if b = 0us then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack |> Ply else let result = a / b if result < System.UInt16.MinValue || result > System.UInt16.MaxValue then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply else Ply(DUInt16(uint16 result)) @@ -192,7 +171,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -207,7 +186,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -221,7 +200,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -236,7 +215,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -250,7 +229,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DUInt16 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt16 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -264,7 +243,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt16 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt16 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -279,7 +258,7 @@ let fns : List = "Returns a random integer16 between and (inclusive)" fn = (function - | _, _, [ DUInt16 a; DUInt16 b ] -> + | _, _, _, [ DUInt16 a; DUInt16 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let lowerBound = max lower 0us @@ -306,7 +285,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DUInt16 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt16 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -325,7 +304,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uint16ParseError let resultError = Dval.resultError KTUInt16 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Convert.ToUInt16 |> DUInt16 |> resultOk |> Ply with @@ -349,7 +328,7 @@ let fns : List = "Converts an Int8 to a 16-bit unsigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt8 a ] -> + | _, _, _, [ DInt8 a ] -> if (a < 0y) then Dval.optionNone KTUInt16 |> Ply else @@ -367,7 +346,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -382,7 +361,7 @@ let fns : List = "Converts an Int16 to a 16-bit unsigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt16 a ] -> + | _, _, _, [ DInt16 a ] -> if (a < 0s) then Dval.optionNone KTUInt16 |> Ply else @@ -401,7 +380,7 @@ let fns : List = "Converts an Int32 to a 16-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 65535." fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if (a < int32 System.UInt16.MinValue) || (a > int32 System.UInt16.MaxValue) then @@ -422,7 +401,7 @@ let fns : List = "Converts a UInt32 to a 16-bit unsigned integer. Returns {{None}} if the value is greater than 65535." fn = (function - | _, _, [ DUInt32 a ] -> + | _, _, _, [ DUInt32 a ] -> if (a > uint32 System.UInt16.MaxValue) then Dval.optionNone KTUInt16 |> Ply else @@ -441,7 +420,7 @@ let fns : List = "Converts an Int64 to a 16-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 65535." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if (a < int64 System.UInt16.MinValue) || (a > int64 System.UInt16.MaxValue) then @@ -462,7 +441,7 @@ let fns : List = "Converts a UInt64 to a 16-bit unsigned integer. Returns {{None}} if the value is greater than 65535." fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.UInt16.MaxValue) then Dval.optionNone KTUInt16 |> Ply else @@ -481,7 +460,7 @@ let fns : List = "Converts an Int128 to a 16-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 65535." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if (a < System.Int128.op_Implicit System.UInt16.MinValue) || (a > System.Int128.op_Implicit System.UInt16.MaxValue) @@ -503,7 +482,7 @@ let fns : List = "Converts a UInt128 to a 16-bit unsigned integer. Returns {{None}} if the value is greater than 65535." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt16.MaxValue) then Dval.optionNone KTUInt16 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/UInt32.fs b/backend/src/BuiltinExecution/Libs/UInt32.fs index c3449ab67a..a1fe36520d 100644 --- a/backend/src/BuiltinExecution/Libs/UInt32.fs +++ b/backend/src/BuiltinExecution/Libs/UInt32.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -45,12 +45,9 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DUInt32 v; DUInt32 m ] -> + | _, vm, _, [ DUInt32 v; DUInt32 m ] -> if m = 0ul then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < 0ul then m + result else result @@ -68,16 +65,12 @@ let fns : List = description = "Adds two 32-bit unsigned integers together" fn = (function - | state, _, [ DUInt32 a; DUInt32 b ] -> + | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(+) a b Ply(DUInt32(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -91,16 +84,12 @@ let fns : List = description = "Subtracts two 32-bit unsigned integers" fn = (function - | state, _, [ DUInt32 a; DUInt32 b ] -> + | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(-) a b Ply(DUInt32(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -114,16 +103,12 @@ let fns : List = description = "Multiplies two 32-bit unsigned integers" fn = (function - | state, _, [ DUInt32 a; DUInt32 b ] -> + | _, vm, _, [ DUInt32 a; DUInt32 b ] -> try let result = Checked.(*) a b Ply(DUInt32(result)) with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply - + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -140,14 +125,11 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DUInt32 number; DUInt32 exp ] -> + | _, vm, _, [ DUInt32 number; DUInt32 exp ] -> (try (bigint number) ** (int exp) |> uint32 |> DUInt32 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -161,21 +143,15 @@ let fns : List = description = "Divides two 32-bit unsigned integers" fn = (function - | state, _, [ DUInt32 a; DUInt32 b ] -> + | _, vm, _, [ DUInt32 a; DUInt32 b ] -> if b = 0ul then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else let result = a / b if result < System.UInt32.MinValue || result > System.UInt32.MaxValue then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else Ply(DUInt32(uint32 result)) @@ -192,7 +168,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -207,7 +183,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -221,7 +197,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -236,7 +212,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -250,7 +226,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DUInt32 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt32 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -264,7 +240,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt32 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt32 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -279,7 +255,7 @@ let fns : List = "Returns a random integer32 between and (inclusive)" fn = (function - | _, _, [ DUInt32 a; DUInt32 b ] -> + | _, _, _, [ DUInt32 a; DUInt32 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let lowerBound = max lower 0ul @@ -306,7 +282,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DUInt32 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt32 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -325,7 +301,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uint32ParseError let resultError = Dval.resultError KTUInt32 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Convert.ToUInt32 |> DUInt32 |> resultOk |> Ply with @@ -350,7 +326,7 @@ let fns : List = Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt8 a ] -> + | _, _, _, [ DInt8 a ] -> if (a < 0y) then Dval.optionNone KTUInt32 |> Ply else @@ -368,7 +344,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -384,7 +360,7 @@ let fns : List = Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt16 a ] -> + | _, _, _, [ DInt16 a ] -> if (a < 0s) then Dval.optionNone KTUInt32 |> Ply else @@ -402,7 +378,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -418,7 +394,7 @@ let fns : List = Returns {{None}} if the value is less than 0" fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if (a < 0l) then Dval.optionNone KTUInt32 |> Ply else @@ -438,7 +414,7 @@ let fns : List = Returns {{None}} if the value is less than 0 or greater than 4294967295." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if (a < int64 System.UInt32.MinValue) || (a > int64 System.UInt32.MaxValue) then @@ -460,7 +436,7 @@ let fns : List = Returns {{None}} if the value is greater than 4294967295." fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if (a > uint64 System.UInt32.MaxValue) then Dval.optionNone KTUInt32 |> Ply else @@ -479,7 +455,7 @@ let fns : List = "Converts an Int128 to a 32-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 4294967295." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if (a < System.Int128.op_Implicit System.UInt32.MinValue) || (a > System.Int128.op_Implicit System.UInt32.MaxValue) @@ -502,7 +478,7 @@ let fns : List = Returns {{None}} if the value is greater than 4294967295." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt32.MaxValue) then Dval.optionNone KTUInt32 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/UInt64.fs b/backend/src/BuiltinExecution/Libs/UInt64.fs index 6a09086a93..6ad3846b89 100644 --- a/backend/src/BuiltinExecution/Libs/UInt64.fs +++ b/backend/src/BuiltinExecution/Libs/UInt64.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -45,12 +45,9 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DUInt64 v; DUInt64 m ] -> + | _, vm, _, [ DUInt64 v; DUInt64 m ] -> if m = 0UL then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack else let result = v % m let result = if result < 0UL then m + result else result @@ -68,14 +65,11 @@ let fns : List = description = "Adds 64-bit unsigned integers together" fn = (function - | state, _, [ DUInt64 a; DUInt64 b ] -> + | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try DUInt64(Checked.(+) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -89,14 +83,11 @@ let fns : List = description = "Subtracts 64-bit unsigned integers" fn = (function - | state, _, [ DUInt64 a; DUInt64 b ] -> + | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try DUInt64(Checked.(-) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -110,14 +101,11 @@ let fns : List = description = "Multiplies 64-bit unsigned integers" fn = (function - | state, _, [ DUInt64 a; DUInt64 b ] -> + | _, vm, _, [ DUInt64 a; DUInt64 b ] -> try DUInt64(Checked.(*) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -134,14 +122,11 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DUInt64 number; DUInt64 exp ] -> + | _, vm, _, [ DUInt64 number; DUInt64 exp ] -> (try (bigint number) ** (int exp) |> uint64 |> DUInt64 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -155,21 +140,15 @@ let fns : List = description = "Divides 64-bit unsigned integers" fn = (function - | state, _, [ DUInt64 a; DUInt64 b ] -> + | _, vm, _, [ DUInt64 a; DUInt64 b ] -> if b = 0UL then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack else let result = a / b if result < System.UInt64.MinValue || result > System.UInt64.MaxValue then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack else Ply(DUInt64(result)) | _ -> incorrectArgs ()) @@ -185,7 +164,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -200,7 +179,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -214,7 +193,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -229,7 +208,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -244,7 +223,7 @@ let fns : List = "Returns a random integer between and (inclusive)" fn = (function - | _, _, [ DUInt64 a; DUInt64 b ] -> + | _, _, _, [ DUInt64 a; DUInt64 b ] -> let lower, upper = if a > b then (b, a) else (a, b) // .NET's "nextUInt64" is exclusive, @@ -274,7 +253,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DUInt64 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt64 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -288,7 +267,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt64 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt64 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -311,7 +290,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uint64ParseError let resultError = Dval.resultError KTUInt64 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Convert.ToUInt64 |> DUInt64 |> resultOk |> Ply with @@ -332,7 +311,7 @@ let fns : List = description = "Stringify " fn = (function - | _, _, [ DUInt64 int ] -> Ply(DString(string int)) + | _, _, _, [ DUInt64 int ] -> Ply(DString(string int)) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -347,7 +326,7 @@ let fns : List = "Converts an Int8 to a 64-bit usigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt8 a ] -> + | _, _, _, [ DInt8 a ] -> if (a < 0y) then Dval.optionNone KTUInt64 |> Ply else @@ -365,7 +344,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -380,7 +359,7 @@ let fns : List = "Converts an Int16 to a 64-bit usigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt16 a ] -> + | _, _, _, [ DInt16 a ] -> if (a < 0s) then Dval.optionNone KTUInt64 |> Ply else @@ -398,7 +377,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -413,7 +392,7 @@ let fns : List = "Converts an Int32 to a 64-bit usigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if (a < 0l) then Dval.optionNone KTUInt64 |> Ply else @@ -431,7 +410,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) |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -446,7 +425,7 @@ let fns : List = "Converts an Int64 to a 64-bit usigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if (a < 0L) then Dval.optionNone KTUInt64 |> Ply else @@ -465,7 +444,7 @@ let fns : List = "Converts an Int128 to a 64-bit usigned integer. Returns {{None}} if the value is less than 0 or greater than 18446744073709551615." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if (a < System.Int128.op_Implicit System.UInt64.MinValue) || (a > System.Int128.op_Implicit System.UInt64.MaxValue) @@ -487,7 +466,7 @@ let fns : List = "Converts a UInt128 to a 64-bit usigned integer. Returns {{None}} if the value is greater than 18446744073709551615." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if (a > System.UInt128.op_Implicit System.UInt64.MaxValue) then Dval.optionNone KTUInt64 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/UInt8.fs b/backend/src/BuiltinExecution/Libs/UInt8.fs index 2de69f6367..a30063cca7 100644 --- a/backend/src/BuiltinExecution/Libs/UInt8.fs +++ b/backend/src/BuiltinExecution/Libs/UInt8.fs @@ -9,10 +9,10 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs -module IntRuntimeError = BuiltinExecution.IntRuntimeError +module RTE = RuntimeError module ParseError = @@ -45,12 +45,9 @@ let fns : List = a different behavior for negative numbers." fn = (function - | state, _, [ DUInt8 v; DUInt8 m ] -> + | _, vm, _, [ DUInt8 v; DUInt8 m ] -> if m = 0uy then - IntRuntimeError.Error.ZeroModulus - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack |> Ply else let result = v % m let result = if result < 0uy then m + result else result @@ -68,14 +65,11 @@ let fns : List = description = "Adds two 8-bit unsigned integers together" fn = (function - | state, _, [ DUInt8 a; DUInt8 b ] -> + | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try DUInt8(Checked.(+) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -89,14 +83,11 @@ let fns : List = description = "Subtracts two 8-bit unsigned integers" fn = (function - | state, _, [ DUInt8 a; DUInt8 b ] -> + | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try DUInt8(Checked.(-) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -110,14 +101,11 @@ let fns : List = description = "Multiplies two 8-bit unsigned integers" fn = (function - | state, _, [ DUInt8 a; DUInt8 b ] -> + | _, vm, _, [ DUInt8 a; DUInt8 b ] -> try DUInt8(Checked.(*) a b) |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -134,14 +122,11 @@ let fns : List = Return value wrapped in a {{Result}} " fn = (function - | state, _, [ DUInt8 number; DUInt8 exp ] -> + | _, vm, _, [ DUInt8 number; DUInt8 exp ] -> (try (bigint number) ** (int exp) |> uint8 |> DUInt8 |> Ply with :? System.OverflowException -> - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -155,19 +140,13 @@ let fns : List = description = "Divides two 8-bit unsigned integers" fn = (function - | state, _, [ DUInt8 a; DUInt8 b ] -> + | _, vm, _, [ DUInt8 a; DUInt8 b ] -> if b = 0uy then - IntRuntimeError.Error.DivideByZeroError - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack |> Ply else let result = int a / int b if result < 0 || result > 255 then - IntRuntimeError.Error.OutOfRange - |> IntRuntimeError.RTE.toRuntimeError - |> raiseRTE state.tracing.callStack - |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply else Ply(DUInt8(uint8 result)) | _ -> incorrectArgs ()) @@ -183,7 +162,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 ] -> Ply(DBool(a > b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -198,7 +177,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 ] -> Ply(DBool(a >= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -212,7 +191,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 ] -> Ply(DBool(a < b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -227,7 +206,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 ] -> Ply(DBool(a <= b)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -241,7 +220,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt8 a ] -> Ply(DString(string a)) + | _, _, _, [ DUInt8 a ] -> Ply(DString(string a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -255,7 +234,7 @@ let fns : List = description = "Converts an to a " fn = (function - | _, _, [ DUInt8 a ] -> Ply(DFloat(float a)) + | _, _, _, [ DUInt8 a ] -> Ply(DFloat(float a)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -270,7 +249,7 @@ let fns : List = "Returns a random 8-bit unsigned integer (uint8) between and (inclusive)" fn = (function - | _, _, [ DUInt8 a; DUInt8 b ] -> + | _, _, _, [ DUInt8 a; DUInt8 b ] -> let lower, upper = if a > b then (b, a) else (a, b) let lowerBound = max lower 0uy @@ -296,7 +275,7 @@ let fns : List = description = "Get the square root of an " fn = (function - | _, _, [ DUInt8 a ] -> Ply(DFloat(sqrt (float a))) + | _, _, _, [ DUInt8 a ] -> Ply(DFloat(sqrt (float a))) | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Pure @@ -315,7 +294,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uint8ParseError let resultError = Dval.resultError KTUInt8 (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> try s |> System.Byte.Parse |> DUInt8 |> resultOk |> Ply with @@ -337,7 +316,7 @@ let fns : List = "Converts an Int8 to an 8-bit unsigned integer. Returns {{None}} if the value is less than 0." fn = (function - | _, _, [ DInt8 a ] -> + | _, _, _, [ DInt8 a ] -> if a < 0y then Dval.optionNone KTUInt8 |> Ply else @@ -356,7 +335,7 @@ let fns : List = "Converts an Int16 to an 8-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 255." fn = (function - | _, _, [ DInt16 a ] -> + | _, _, _, [ DInt16 a ] -> if a < 0s || a > 255s then Dval.optionNone KTUInt8 |> Ply else @@ -375,7 +354,7 @@ let fns : List = "Converts a UInt16 to an 8-bit unsigned integer. Returns {{None}} if the value is greater than 255." fn = (function - | _, _, [ DUInt16 a ] -> + | _, _, _, [ DUInt16 a ] -> if a > 255us then Dval.optionNone KTUInt8 |> Ply else @@ -394,7 +373,7 @@ let fns : List = "Converts an Int32 to an 8-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 255." fn = (function - | _, _, [ DInt32 a ] -> + | _, _, _, [ DInt32 a ] -> if a < 0l || a > 255l then Dval.optionNone KTUInt8 |> Ply else @@ -413,7 +392,7 @@ let fns : List = "Converts a UInt32 to an 8-bit unsigned integer. Returns {{None}} if the value is greater than 255." fn = (function - | _, _, [ DUInt32 a ] -> + | _, _, _, [ DUInt32 a ] -> if a > 255ul then Dval.optionNone KTUInt8 |> Ply else @@ -432,7 +411,7 @@ let fns : List = "Converts an Int64 to an 8-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 255." fn = (function - | _, _, [ DInt64 a ] -> + | _, _, _, [ DInt64 a ] -> if a < 0L || a > 255L then Dval.optionNone KTUInt8 |> Ply else @@ -451,7 +430,7 @@ let fns : List = "Converts a UInt64 to an 8-bit unsigned integer. Returns {{None}} if the value is greater than 255." fn = (function - | _, _, [ DUInt64 a ] -> + | _, _, _, [ DUInt64 a ] -> if a > 255UL then Dval.optionNone KTUInt8 |> Ply else @@ -470,7 +449,7 @@ let fns : List = "Converts an Int128 to an 8-bit unsigned integer. Returns {{None}} if the value is less than 0 or greater than 255." fn = (function - | _, _, [ DInt128 a ] -> + | _, _, _, [ DInt128 a ] -> if a < 0Q || a > 255Q then Dval.optionNone KTUInt8 |> Ply else @@ -489,7 +468,7 @@ let fns : List = "Converts a UInt128 to an 8-bit unsigned integer. Returns {{None}} if the value is greater than 255." fn = (function - | _, _, [ DUInt128 a ] -> + | _, _, _, [ DUInt128 a ] -> if a > 255Z then Dval.optionNone KTUInt8 |> Ply else diff --git a/backend/src/BuiltinExecution/Libs/Uuid.fs b/backend/src/BuiltinExecution/Libs/Uuid.fs index 3d11451cdd..125cd7dd34 100644 --- a/backend/src/BuiltinExecution/Libs/Uuid.fs +++ b/backend/src/BuiltinExecution/Libs/Uuid.fs @@ -7,7 +7,7 @@ open FSharp.Control.Tasks open LibExecution.RuntimeTypes open Prelude open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PackageIDs = LibExecution.PackageIDs @@ -32,7 +32,7 @@ let fns : List = description = "Generate a new v4 according to RFC 4122" fn = (function - | _, _, [ DUnit ] -> Ply(DUuid(System.Guid.NewGuid())) + | _, _, _, [ DUnit ] -> Ply(DUuid(System.Guid.NewGuid())) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented // similarly to DateTime.now, it's not particularly fun for this to change @@ -58,7 +58,7 @@ let fns : List = let typeName = FQTypeName.fqPackage PackageIDs.Type.Stdlib.uuidParseError let resultError = Dval.resultError KTUuid (KTCustomType(typeName, [])) (function - | _, _, [ DString s ] -> + | _, _, _, [ DString s ] -> match System.Guid.TryParse s with | true, x -> x |> DUuid |> resultOk |> Ply | _ -> ParseError.BadFormat |> ParseError.toDT |> resultError |> Ply @@ -76,7 +76,7 @@ let fns : List = "Stringify to the format XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX" fn = (function - | _, _, [ DUuid uuid ] -> Ply(DString(string uuid)) + | _, _, _, [ DUuid uuid ] -> Ply(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 1b80720553..aea797b41b 100644 --- a/backend/src/BuiltinExecution/Libs/X509.fs +++ b/backend/src/BuiltinExecution/Libs/X509.fs @@ -7,7 +7,7 @@ open System.Security.Cryptography.X509Certificates open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval @@ -25,7 +25,7 @@ let fns : List = let resultOk = Dval.resultOk KTString KTString let resultError = Dval.resultError KTString KTString (function - | _, _, [ DString certString ] -> + | _, _, _, [ DString certString ] -> try let cert = new X509Certificates.X509Certificate2(UTF8.toBytes certString) // Workaround to support ECC certs diff --git a/backend/src/LibExecution/DvalReprInternalHash.fs b/backend/src/LibCloud/DvalReprInternalHash.fs similarity index 100% rename from backend/src/LibExecution/DvalReprInternalHash.fs rename to backend/src/LibCloud/DvalReprInternalHash.fs diff --git a/backend/src/LibExecution/DvalReprInternalQueryable.fs b/backend/src/LibCloud/DvalReprInternalQueryable.fs similarity index 100% rename from backend/src/LibExecution/DvalReprInternalQueryable.fs rename to backend/src/LibCloud/DvalReprInternalQueryable.fs diff --git a/backend/src/LibExecution/DvalReprInternalRoundtrippable.fs b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs similarity index 100% rename from backend/src/LibExecution/DvalReprInternalRoundtrippable.fs rename to backend/src/LibCloud/DvalReprInternalRoundtrippable.fs diff --git a/backend/src/LibCloud/Init.fs b/backend/src/LibCloud/Init.fs index f9b2731eba..76806d647d 100644 --- a/backend/src/LibCloud/Init.fs +++ b/backend/src/LibCloud/Init.fs @@ -36,9 +36,14 @@ let init (shouldWaitForDB : WaitForDB) (serviceName : string) : Task = printTime $"Initing LibCloud in {serviceName}" let dbTask = waitForDB shouldWaitForDB - let queueTask = Queue.init () - let traceStorageTask = TraceCloudStorage.init () - let! (_ : List) = Task.flatten [ queueTask; traceStorageTask; dbTask ] + //let queueTask = Queue.init () + //let traceStorageTask = TraceCloudStorage.init () + let! (_ : List) = + Task.flatten + [ + // queueTask + // traceStorageTask + dbTask ] printTime $" Inited LibCloud in {serviceName}" } diff --git a/backend/src/LibCloud/LibCloud.fsproj b/backend/src/LibCloud/LibCloud.fsproj index edbab39fb2..948afea83e 100644 --- a/backend/src/LibCloud/LibCloud.fsproj +++ b/backend/src/LibCloud/LibCloud.fsproj @@ -14,28 +14,32 @@ - + + + + + - - - - - + + + + + - - - - + + + + diff --git a/backend/src/LibExecution/Builtin.fs b/backend/src/LibExecution/Builtin.fs index 8f1ee37549..3392e1622e 100644 --- a/backend/src/LibExecution/Builtin.fs +++ b/backend/src/LibExecution/Builtin.fs @@ -51,26 +51,22 @@ let combine (libs : List) (fnRenames : FnRenames) : Builtins = fns |> List.iter checkFn - { - // constants = - // libs - // |> List.map _.constants - // |> List.collect Map.values - // |> Map.fromListBy _.name + { constants = + libs + |> List.map _.constants + |> List.collect Map.values + |> Map.fromListBy _.name fns = fns |> renameFunctions fnRenames |> Map.fromListBy _.name } -let make - //(constants : List) - (fns : List) - : Builtins = - { //constants = constants |> Map.fromListBy _.name +let make (constants : List) (fns : List) : Builtins = + { constants = constants |> Map.fromListBy _.name fns = fns |> Map.fromListBy _.name } module Shortcuts = let fn = FQFnName.builtin - //let constant = FQConstantName.builtin + let constant = FQConstantName.builtin let incorrectArgs = RuntimeTypes.incorrectArgs type Param = BuiltInParam diff --git a/backend/src/LibExecution/Dval.fs b/backend/src/LibExecution/Dval.fs index 472e222d5f..b7bba1f407 100644 --- a/backend/src/LibExecution/Dval.fs +++ b/backend/src/LibExecution/Dval.fs @@ -7,106 +7,89 @@ open LibExecution.RuntimeTypes module VT = ValueType -// let int8 (i : int8) = DInt8(i) -// let uint8 (i : uint8) = DUInt8(i) -// let int16 (i : int16) = DInt16(i) -// let uint16 (i : uint16) = DUInt16(i) -// let int32 (i : int32) = DInt32(i) -// let uint32 (i : uint32) = DUInt32(i) -let int64 (i : int64) = DInt64(i) -// let uint64 (i : uint64) = DUInt64(i) -// let int128 (i : System.Int128) = DInt128(i) -// let uint128 (i : System.UInt128) = DUInt128(i) - -// let list (typ : KnownType) (list : List) : Dval = DList(VT.known typ, list) - -// let dict (typ : KnownType) (entries : List) : Dval = -// DDict(VT.known typ, Map entries) - -// let dictFromMap (typ : KnownType) (entries : Map) : Dval = -// DDict(VT.known typ, entries) - - -// /// VTTODO -// /// the interpreter "throws away" any valueTypes currently, -// /// so while these .option and .result functions are great in that they -// /// return the correct typeArgs, they conflict with what the interpreter will do -// /// -// /// So, to make some tests happy, let's ignore these for now. -// /// -// /// (might need better explanation^) -// let ignoreAndUseEmpty (_ignoredForNow : List) = [] - - - -// let optionType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.option - - -// let optionSome (innerType : KnownType) (dv : Dval) : Dval = -// DEnum( -// optionType, -// optionType, -// ignoreAndUseEmpty [ VT.known innerType ], -// "Some", -// [ dv ] -// ) - -// let optionNone (innerType : KnownType) : Dval = -// DEnum(optionType, optionType, ignoreAndUseEmpty [ VT.known innerType ], "None", []) - -// let option (innerType : KnownType) (dv : Option) : Dval = -// match dv with -// | Some dv -> optionSome innerType dv -// | None -> optionNone innerType - - - -// let resultType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.result - - -// let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = -// DEnum( -// resultType, -// resultType, -// ignoreAndUseEmpty [ ValueType.Known okType; ValueType.Known errorType ], -// "Ok", -// [ dvOk ] -// ) - -// let resultError -// (okType : KnownType) -// (errorType : KnownType) -// (dvError : Dval) -// : Dval = - -// DEnum( -// resultType, -// resultType, -// ignoreAndUseEmpty [ ValueType.known okType; ValueType.known errorType ], -// "Error", -// [ dvError ] -// ) - -// let result -// (okType : KnownType) -// (errorType : KnownType) -// (dv : Result) -// : Dval = -// match dv with -// | Ok dv -> resultOk okType errorType dv -// | Error dv -> resultError okType errorType dv - - -// let byteArrayToDvalList (bytes : byte[]) : Dval = -// bytes -// |> Array.toList -// |> List.map (fun b -> DUInt8(byte b)) -// |> fun dvalList -> DList(VT.uint8, dvalList) - -// let DlistToByteArray (dvalList : List) : byte[] = -// dvalList -// |> List.map (fun dval -> -// match dval with -// | DUInt8 b -> b -// | _ -> (Exception.raiseInternal "Invalid type in byte list") []) -// |> Array.ofList +let int8 (i : int8) = DInt8 i +let uint8 (i : uint8) = DUInt8 i +let int16 (i : int16) = DInt16 i +let uint16 (i : uint16) = DUInt16 i +let int32 (i : int32) = DInt32 i +let uint32 (i : uint32) = DUInt32 i +let int64 (i : int64) = DInt64 i +let uint64 (i : uint64) = DUInt64 i +let int128 (i : System.Int128) = DInt128 i +let uint128 (i : System.UInt128) = DUInt128 i + +let string (s : string) = DString s + +let list (typ : KnownType) (list : List) : Dval = DList(VT.known typ, list) + +let dict (typ : KnownType) (entries : List) : Dval = + DDict(VT.known typ, Map entries) + +let dictFromMap (typ : KnownType) (entries : Map) : Dval = + DDict(VT.known typ, entries) + + +let optionType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.option + +let optionSome (innerType : KnownType) (dv : Dval) : Dval = + DEnum(optionType, optionType, [ VT.known innerType ], "Some", [ dv ]) + +let optionNone (innerType : KnownType) : Dval = + DEnum(optionType, optionType, [ VT.known innerType ], "None", []) + +let option (innerType : KnownType) (dv : Option) : Dval = + match dv with + | Some dv -> optionSome innerType dv + | None -> optionNone innerType + + + +let resultType = FQTypeName.fqPackage PackageIDs.Type.Stdlib.result + + +let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = + DEnum( + resultType, + resultType, + [ ValueType.Known okType; ValueType.Known errorType ], + "Ok", + [ dvOk ] + ) + +let resultError + (okType : KnownType) + (errorType : KnownType) + (dvError : Dval) + : Dval = + + DEnum( + resultType, + resultType, + [ ValueType.known okType; ValueType.known errorType ], + "Error", + [ dvError ] + ) + +let result + (okType : KnownType) + (errorType : KnownType) + (dv : Result) + : Dval = + match dv with + | Ok dv -> resultOk okType errorType dv + | Error dv -> resultError okType errorType dv + + +let byteArrayToDvalList (bytes : byte[]) : Dval = + bytes + |> Array.toList + |> List.map (fun b -> DUInt8(byte b)) + |> fun dvalList -> DList(VT.uint8, dvalList) + +let dlistToByteArray (dvalList : List) : byte[] = + dvalList + |> List.map (fun dval -> + match dval with + | DUInt8 b -> b + | _ -> (Exception.raiseInternal "Invalid type in byte list") []) + |> Array.ofList diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/LibExecution/DvalDecoder.fs index 0fc61b89ec..0200c4528b 100644 --- a/backend/src/LibExecution/DvalDecoder.fs +++ b/backend/src/LibExecution/DvalDecoder.fs @@ -7,99 +7,201 @@ open Prelude open RuntimeTypes -let unwrap = Exception.unwrapOptionInternal + +let f (expected : string) (dv : Dval) = Exception.raiseInternal expected [ "dv", dv ] + +let unwrap opt msg = + match opt with + | Some v -> v + | None -> Exception.raiseInternal msg [] + +let int8 (dv : Dval) : int8 = + match dv with + | DInt8 i -> i + | _ -> f "int8" dv + +let uInt8 (dv : Dval) : uint8 = + match dv with + | DUInt8 i -> i + | _ -> f "uint8" dv + +let int16 (dv : Dval) : int16 = + match dv with + | DInt16 i -> i + | _ -> f "int16" dv + +let uInt16 (dv : Dval) : uint16 = + match dv with + | DUInt16 i -> i + | _ -> f "uint16" dv + +let int32 (dv : Dval) : int32 = + match dv with + | DInt32 i -> i + | _ -> f "int32" dv + +let uInt32 (dv : Dval) : uint32 = + match dv with + | DUInt32 i -> i + | _ -> f "uint32" dv + +let int64 (dv : Dval) : int64 = + match dv with + | DInt64 i -> i + | _ -> f "int64" dv + +let uInt64 (dv : Dval) : uint64 = + match dv with + | DUInt64 i -> i + | _ -> f "uint64" dv + +let int128 (dv : Dval) : System.Int128 = + match dv with + | DInt128 i -> i + | _ -> f "System.Int128" dv + +let uInt128 (dv : Dval) : System.UInt128 = + match dv with + | DUInt128 i -> i + | _ -> f "System.UInt128" dv + +let float (dv : Dval) : double = + match dv with + | DFloat f -> f + | _ -> f "double" dv + +let bool (dv : Dval) : bool = + match dv with + | DBool b -> b + | _ -> f "bool" dv + +let uuid (dv : Dval) : System.Guid = + match dv with + | DUuid u -> u + | _ -> f "System.Guid" dv + +let string (dv : Dval) : string = + match dv with + | DString s -> s + | _ -> f "string" dv + + + + +let tuple2 (dv : Dval) : Dval * Dval = + match dv with + | DTuple(first, second, _) -> (first, second) + | _ -> f "('a * 'b)" dv + +let tuple3 (dv : Dval) : Dval * Dval * Dval = + match dv with + | DTuple(first, second, [ third ]) -> (first, second, third) + | _ -> f "('a * 'b * 'c)" dv + + +let list (m : Dval -> 'a) (dv : Dval) : List<'a> = + match dv with + | DList(_, l) -> List.map m l + | _ -> f "list" dv + +let dict (dv : Dval) : Map = + match dv with + | DDict(_, d) -> d + | _ -> f "dict" dv + let field (name : string) (m : DvalMap) : Dval = - m |> Map.get name |> unwrap $"Expected {name}' field" [] + match m |> Map.get name with + | Some dv -> dv + | None -> Exception.raiseInternal $"Expected '{name}' field" [] -let stringField (name : string) (m : DvalMap) : string = - m - |> field name - |> Dval.asString - |> unwrap $"Expected '{name}' field to be a string" [] +// let stringField (name : string) (m : DvalMap) : string = +// m +// |> field name +// |> getString +// |> unwrap $"Expected '{name}' field to be a string" [] // let listField (name : string) (m : DvalMap) : List = // m // |> field name -// |> Dval.asList +// |> getList // |> unwrap $"Expected '{name}' field to be a list" [] // let stringListField (name : string) (m : DvalMap) : List = // m // |> listField name // |> List.map (fun s -> -// s |> Dval.asString |> unwrap $"Expected string values in '{name}' list" []) - -let int64Field (name : string) (m : DvalMap) : int64 = - m - |> field name - |> Dval.asInt64 - |> unwrap $"Expected '{name}' field to be an int64" [] - -// let uint64Field (name : string) (m : DvalMap) : uint64 = -// m -// |> field name -// |> Dval.asUInt64 -// |> unwrap $"Expected '{name}' field to be an uint64" [] +// s |> getString |> unwrap $"Expected string values in '{name}' list" []) -let intField (name : string) (m : DvalMap) : int = m |> int64Field name |> int // let int8Field (name : string) (m : DvalMap) : int8 = // m // |> field name -// |> Dval.asInt8 +// |> getInt8 // |> unwrap $"Expected '{name}' field to be an int8" [] // let uint8Field (name : string) (m : DvalMap) : uint8 = // m // |> field name -// |> Dval.asUInt8 +// |> getUInt8 // |> unwrap $"Expected '{name}' field to be a uint8" [] // let int16Field (name : string) (m : DvalMap) : int16 = // m // |> field name -// |> Dval.asInt16 +// |> getInt16 // |> unwrap $"Expected '{name}' field to be an int16" [] // let uint16Field (name : string) (m : DvalMap) : uint16 = // m // |> field name -// |> Dval.asUInt16 +// |> getUInt16 // |> unwrap $"Expected '{name}' field to be a uint16" [] // let int32Field (name : string) (m : DvalMap) : int32 = // m // |> field name -// |> Dval.asInt32 +// |> getInt32 // |> unwrap $"Expected '{name}' field to be an int32" [] // let uint32Field (name : string) (m : DvalMap) : uint32 = // m // |> field name -// |> Dval.asUInt32 +// |> getUInt32 // |> unwrap $"Expected '{name}' field to be a uint32" [] +// let int64Field (name : string) (m : DvalMap) : int64 = +// m +// |> field name +// |> getInt64 +// |> unwrap $"Expected '{name}' field to be an int64" [] + +// let uint64Field (name : string) (m : DvalMap) : uint64 = +// m +// |> field name +// |> getUInt64 +// |> unwrap $"Expected '{name}' field to be an uint64" [] + // let int128Field (name : string) (m : DvalMap) : System.Int128 = // m // |> field name -// |> Dval.asInt128 +// |> getInt128 // |> unwrap $"Expected '{name}' field to be an int128" [] // let uint128Field (name : string) (m : DvalMap) : System.UInt128 = // m // |> field name -// |> Dval.asUInt128 +// |> getUInt128 // |> unwrap $"Expected '{name}' field to be a uint128" [] // let uuidField (name : string) (m : DvalMap) : System.Guid = // m // |> field name -// |> Dval.asUuid +// |> getUuid // |> unwrap $"Expected '{name}' field to be a uuid" [] -// let mapField (name : string) (m : DvalMap) : Map = +// let dictField (name : string) (m : DvalMap) : Map = // m // |> field name -// |> Dval.asDict +// |> getDict // |> unwrap $"Expected '{name}' field to be a dict" [] diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs deleted file mode 100644 index 9107e735fa..0000000000 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ /dev/null @@ -1,248 +0,0 @@ -/// Ways of converting Dvals to strings, intended for developers to read -module LibExecution.DvalReprDeveloper - -open Prelude - -open RuntimeTypes - -let rec typeName (t : TypeReference) : string = - match t with - | TUnit -> "Unit" - | TBool -> "Bool" - - | TInt8 -> "Int8" - | TUInt8 -> "UInt8" - | TInt16 -> "Int16" - | TUInt16 -> "UInt16" - | TInt32 -> "Int32" - | TUInt32 -> "UInt32" - | TInt64 -> "Int64" - | TUInt64 -> "UInt64" - | TInt128 -> "Int128" - | TUInt128 -> "UInt128" - - | TFloat -> "Float" - | TChar -> "Char" - | TString -> "String" - - | TDateTime -> "DateTime" - | TUuid -> "Uuid" - - | TList nested -> $"List<{typeName nested}>" - | TDict nested -> $"Dict<{typeName nested}>" - | TTuple(n1, n2, rest) -> - let nested = (n1 :: n2 :: rest) |> List.map typeName |> String.concat ", " - $"({nested})" - - | TFn _ -> "Function" - - // | TCustomType(Error _nre, _) -> "(Error during function resolution)" - // | TCustomType(Ok t, typeArgs) -> - // let typeArgsPortion = - // match typeArgs with - // | [] -> "" - // | args -> - // args - // |> List.map (fun t -> typeName t) - // |> String.concat ", " - // |> fun betweenBrackets -> "<" + betweenBrackets + ">" - // FQTypeName.toString t + typeArgsPortion - - // | TDB _ -> "Datastore" - | TVariable varname -> $"'{varname}" - - -let rec private knownTypeName (vt : KnownType) : string = - match vt with - | KTUnit -> "Unit" - - | KTBool -> "Bool" - - | KTInt8 -> "Int8" - | KTUInt8 -> "UInt8" - | KTInt16 -> "Int16" - | KTUInt16 -> "UInt16" - | KTInt32 -> "Int32" - | KTUInt32 -> "UInt32" - | KTInt64 -> "Int64" - | KTUInt64 -> "UInt64" - | KTInt128 -> "Int128" - | KTUInt128 -> "UInt128" - - | KTFloat -> "Float" - - | KTChar -> "Char" - | KTString -> "String" - - | KTDateTime -> "DateTime" - | KTUuid -> "Uuid" - - | KTList typ -> $"List<{valueTypeName typ}>" - | KTDict typ -> $"Dict<{valueTypeName typ}>" - | KTTuple(t1, t2, trest) -> - t1 :: t2 :: trest - |> List.map valueTypeName - |> String.concat ", " - |> fun s -> $"({s})" - -// | KTCustomType(name, typeArgs) -> -// let typeArgsPortion = -// match typeArgs with -// | [] -> "" -// | args -> -// args -// |> List.map (fun t -> valueTypeName t) -// |> String.concat ", " -// |> fun betweenBrackets -> "<" + betweenBrackets + ">" - -// FQTypeName.toString name + typeArgsPortion - -// | KTFn(argTypes, retType) -> -// (NEList.toList argTypes) @ [ retType ] -// |> List.map valueTypeName -// |> String.concat " -> " - -// | KTDB typ -> $"Datastore<{valueTypeName typ}>" - -and private valueTypeName (typ : ValueType) : string = - match typ with - | ValueType.Known typ -> knownTypeName typ - | ValueType.Unknown -> "_" - - -let toTypeName (dv : Dval) : string = dv |> Dval.toValueType |> valueTypeName - - -// SERIALIZER_DEF Custom DvalReprDeveloper.toRepr -/// For printing something for the developer to read, as a live-value, error -/// message, etc. -/// -/// Customers should not come to rely on this format. Do not use in stdlib fns -/// or other places a developer could rely on it (i.e. telemetry and error -/// messages are OK) -let toRepr (dv : Dval) : string = - let rec toRepr_ (indent : int) (dv : Dval) : string = - let makeSpaces len = "".PadRight(len, ' ') - let nl = "\n" + makeSpaces indent - let inl = "\n" + makeSpaces (indent + 2) - // let indent = indent + 2 - let typename = toTypeName dv - let wrap str = $"<{typename}: {str}>" - - match dv with - | DUnit -> "()" - - | DBool true -> "true" - | DBool false -> "false" - - | DInt8 i -> string i - | DUInt8 i -> string i - | DInt16 i -> string i - | DUInt16 i -> string i - | DInt32 i -> string i - | DUInt32 i -> string i - | DInt64 i -> string i - | DUInt64 i -> string i - | DInt128 i -> string i - | DUInt128 i -> string i - - | DFloat f -> - if System.Double.IsPositiveInfinity f then - "Infinity" - else if System.Double.IsNegativeInfinity f then - "-Infinity" - else if System.Double.IsNaN f then - "NaN" - else - let result = sprintf "%.12g" f - if result.Contains "." then result else $"{result}.0" - - | DChar c -> $"'{c}'" - | DString s -> $"\"{s}\"" - - | DDateTime d -> wrap (DarkDateTime.toIsoString d) - // | DDB name -> wrap name - | DUuid uuid -> wrap (string uuid) - - | DList(_, l) -> - if List.isEmpty l then - wrap "[]" - else - let elems = String.concat ", " (List.map (toRepr_ indent) l) - $"[{inl}{elems}{nl}]" - - | DTuple(first, second, theRest) -> - let l = [ first; second ] @ theRest - let short = String.concat ", " (List.map (toRepr_ indent) l) - - if String.length short <= 80 then - $"({short})" - else - let long = String.concat $"{inl}, " (List.map (toRepr_ indent) l) - $"({inl}{long}{nl})" - - - | DDict(_valueTypeTODO, o) -> - if Map.isEmpty o then - "{}" - else - let strs = - o - |> Map.toList - |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) - - let elems = String.concat $",{inl}" strs - "{" + $"{inl}{elems}{nl}" + "}" - - // | DRecord(_, typeName, _typeArgsTODO, fields) -> - // let fields = - // fields - // |> Map.toList - // |> List.map (fun (key, value) -> ($"{key}: {toRepr_ indent value}")) - - // let elems = String.concat $",{inl}" fields - // let typeStr = FQTypeName.toString typeName - // $"{typeStr} {{" + $"{inl}{elems}{nl}" + "}" - - - // | DEnum(_, typeName, typeArgs, caseName, fields) -> - // let typeArgsPart = - // match typeArgs with - // | [] -> "" - // | typeArgs -> - // typeArgs - // |> List.map ValueType.toString - // |> String.concat ", " - // |> fun parts -> $"<{parts}>" - - // let short = - // let fieldStr = - // fields - // |> List.map (fun value -> toRepr_ indent value) - // |> String.concat ", " - - // let fieldStr = if fieldStr = "" then "" else $"({fieldStr})" - - // let typeStr = FQTypeName.toString typeName - // $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" - - // if String.length short <= 80 then - // short - // else - // let fieldStr = - // fields - // |> List.map (fun value -> toRepr_ indent value) - // |> String.concat $",{inl}" - - // let fieldStr = if fieldStr = "" then "" else $"({inl}{fieldStr}{nl})" - - // let typeStr = FQTypeName.toString typeName - // $"{typeStr}{typeArgsPart}.{caseName}{fieldStr}" - - | DFnVal fnVal -> - // TODO we can do better here. - match fnVal with - //| Lambda _impl -> "" - | NamedFn name -> $"" - - toRepr_ 0 dv diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 3a8267ee5a..7ad1e1a836 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -6,13 +6,13 @@ open FSharp.Control.Tasks open Prelude module RT = RuntimeTypes +module RTE = RT.RuntimeError -let noTracing (callStack : RT.CallStack) : RT.Tracing = +let noTracing : RT.Tracing = { traceDval = fun _ _ -> () traceExecutionPoint = fun _ -> () loadFnResult = fun _ _ -> None - storeFnResult = fun _ _ _ -> () - callStack = callStack } + storeFnResult = fun _ _ _ -> () } let noTestContext : RT.TestContext = { sideEffectCount = 0 @@ -36,8 +36,10 @@ let createState program = program - types = { typeSymbolTable = Map.empty } - fns = { builtIn = builtins.fns; package = packageManager.getFn } } + types = { typeSymbolTable = Map.empty; package = packageManager.getType } + fns = { builtIn = builtins.fns; package = packageManager.getFn } + constants = + { builtIn = builtins.constants; package = packageManager.getConstant } } @@ -48,75 +50,78 @@ let executeExpr : Task = task { let registersNeeded, instructions, resultReg = instructionsWithContext - try - try - let vmState : RT.VMState = - { instructions = List.toArray instructions - registers = Array.zeroCreate registersNeeded - resultReg = resultReg + let vmState : RT.VMState = + { pc = 0 + instructions = List.toArray instructions + registers = Array.zeroCreate registersNeeded + resultReg = resultReg - symbolTable = inputVars - typeSymbolTable = Map.empty } + callStack = RT.CallStack.fromEntryPoint RT.ExecutionPoint.Script // TODO - let vmState = - //{ state with symbolTable = Interpreter.withGlobals state inputVars } - { vmState with symbolTable = inputVars } + symbolTable = inputVars + typeSymbolTable = Map.empty } + try + try + vmState.symbolTable <- + // todo + //Interpreter.withGlobals state inputVars + inputVars let! result = Interpreter.eval exeState vmState return Ok result with - | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) + | RT.RuntimeErrorException(callStack, rte) -> return Error(callStack, rte) | ex -> let context : Metadata = //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] [] exeState.reportException exeState context ex - return - RT.raiseRTE - exeState.tracing.callStack - (RT.RuntimeError.oldError "Unknown error") + let id = System.Guid.NewGuid() + // TODO: log the error and details or something + return (RTE.UncaughtException id) |> RT.raiseRTE vmState.callStack + finally // Does nothing in non-tests exeState.test.postTestExecutionHook exeState.test } -let executeFunction - (exeState : RT.ExecutionState) - (name : RT.FQFnName.FQFnName) - (typeArgs : List) - (args : NEList) - : Task = - task { - try - try - let exeState = - { exeState with - tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } - let! result = - Interpreter.call - exeState - RT.VMState.empty // ok? - (RT.DFnVal(RT.NamedFn name)) - typeArgs - args - return Ok result - with - | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) - | ex -> - let context : Metadata = - //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] - [] - exeState.reportException exeState context ex - return - RT.raiseRTE - exeState.tracing.callStack - (RT.RuntimeError.oldError "Unknown error") - finally - // Does nothing in non-tests - exeState.test.postTestExecutionHook exeState.test - } +// let executeFunction +// (exeState : RT.ExecutionState) +// (name : RT.FQFnName.FQFnName) +// (typeArgs : List) +// (args : NEList) +// : Task = +// task { +// try +// try +// let exeState = +// { exeState with +// tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } +// let! result = +// Interpreter.call +// exeState +// RT.VMState.empty // ok? +// (RT.DFnVal(RT.NamedFn name)) +// typeArgs +// args +// return Ok result +// with +// | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) +// | ex -> +// let context : Metadata = +// //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] +// [] +// exeState.reportException exeState context ex +// return +// RT.raiseRTE +// exeState.tracing.callStack +// (RT.RuntimeError.oldError "Unknown error") +// finally +// // Does nothing in non-tests +// exeState.test.postTestExecutionHook exeState.test +// } // let runtimeErrorToString diff --git a/backend/src/LibExecution/Interpreter.Old.fs b/backend/src/LibExecution/Interpreter.Old.fs deleted file mode 100644 index 9f22bdab2a..0000000000 --- a/backend/src/LibExecution/Interpreter.Old.fs +++ /dev/null @@ -1,1073 +0,0 @@ -/// Interprets Dark expressions resulting in (tasks of) Dvals -module LibExecution.Interpreter - -open System.Threading.Tasks -open FSharp.Control.Tasks -open FSharp.Control.Tasks.Affine.Unsafe - -open Prelude -open RuntimeTypes -module VT = ValueType - -/// Gathers any global data (Secrets, DBs, etc.) -/// that may be needed to evaluate an expression -let globalsFor (_state : ExecutionState) : Symtable = - let secrets = - // state.program.secrets - // |> List.map (fun (s : Secret.T) -> (s.name, DString s.value)) - // |> Map.ofList - Map.empty - - let dbs = - //Map.map (fun (db : DB.T) -> DDB db.name) state.program.dbs - Map.empty - - Map.mergeFavoringLeft secrets dbs - - -let withGlobals (state : ExecutionState) (symtable : Symtable) : Symtable = - let globals = globalsFor state - Map.mergeFavoringRight globals symtable - - -module ExecutionError = - //module RT2DT = RuntimeTypesToDarkTypes - - type Error = - // | MatchExprEnumPatternWrongCount of string * int * int - // | MatchExprPatternWrongType of string * Dval - // | MatchExprUnmatched of Dval - | NonStringInStringInterpolation of Dval - //| ConstDoesntExist of FQConstantName.FQConstantName - // | FieldAccessFieldDoesntExist of - // typeName : FQTypeName.FQTypeName * - // invalidFieldName : string - // | RecordConstructionFieldDoesntExist of - // FQTypeName.FQTypeName * - // invalidFieldName : string - // | RecordConstructionMissingField of - // FQTypeName.FQTypeName * - // missingFieldName : string - // | RecordConstructionDuplicateField of - // FQTypeName.FQTypeName * - // duplicateFieldName : string - // | FieldAccessNotRecord of ValueType * string - // | EnumConstructionCaseNotFound of FQTypeName.FQTypeName * string - | WrongNumberOfFnArgs of - fn : FQFnName.FQFnName * - expectedTypeArgs : int * - expectedArgs : int * - actualTypeArgs : int * - actualArgs : int - - let toDT (_e : Error) : RuntimeError = - // let typeName = - // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.Execution.error - - // let case (caseName : string) (fields : List) : RuntimeError = - // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.executionError - - // let (caseName, fields) = - // match e with - // | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> - // "MatchExprEnumPatternWrongCount", - // [ DString caseName; DInt64 expected; DInt64 actual ] - - // | MatchExprPatternWrongType(expected, actual) -> - // "MatchExprPatternWrongType", [ DString expected; RT2DT.Dval.toDT actual ] - - // | MatchExprUnmatched dv -> "MatchExprUnmatched", [ RT2DT.Dval.toDT dv ] - - // | NonStringInStringInterpolation dv -> - // "NonStringInStringInterpolation", [ RT2DT.Dval.toDT dv ] - - // | ConstDoesntExist name -> - // "ConstDoesntExist", [ RT2DT.FQConstantName.toDT name ] - - // | FieldAccessFieldDoesntExist(typeName, invalidFieldName) -> - // "FieldAccessFieldDoesntExist", - // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - - // | FieldAccessNotRecord(vt, fieldName) -> - // "FieldAccessNotRecord", [ RT2DT.ValueType.toDT vt; DString fieldName ] - - // | EnumConstructionCaseNotFound(typeName, caseName) -> - // "EnumConstructionCaseNotFound", - // [ RT2DT.FQTypeName.toDT typeName; DString caseName ] - - // | WrongNumberOfFnArgs(fn, - // expectedTypeArgs, - // expectedArgs, - // actualTypeArgs, - // actualArgs) -> - // "WrongNumberOfFnArgs", - // [ RT2DT.FQFnName.toDT fn - // DInt64 expectedTypeArgs - // DInt64 expectedArgs - // DInt64 actualTypeArgs - // DInt64 actualArgs ] - - // | RecordConstructionFieldDoesntExist(typeName, invalidFieldName) -> - // "RecordConstructionFieldDoesntExist", - // [ RT2DT.FQTypeName.toDT typeName; DString invalidFieldName ] - - // | RecordConstructionMissingField(typeName, missingFieldName) -> - // "RecordConstructionMissingField", - // [ RT2DT.FQTypeName.toDT typeName; DString missingFieldName ] - - // | RecordConstructionDuplicateField(typeName, duplicateFieldName) -> - // "RecordConstructionDuplicateField", - // [ RT2DT.FQTypeName.toDT typeName; DString duplicateFieldName ] - - // case caseName fields - RuntimeError.oldError "TODO" - - let raise (callStack : CallStack) (e : Error) : 'a = toDT e |> raiseRTE callStack - - -// let rec evalConst (callStack : CallStack) (c : Const) : Dval = -// let r = evalConst callStack - -// match c with -// | CUnit -> DUnit -// | CBool b -> DBool b - -// | CInt8 i -> DInt8 i -// | CUInt8 i -> DUInt8 i -// | CInt16 i -> DInt16 i -// | CUInt16 i -> DUInt16 i -// | CInt32 i -> DInt32 i -// | CUInt32 i -> DUInt32 i -// | CInt64 i -> DInt64 i -// | CUInt64 i -> DUInt64 i -// | CInt128 i -> DInt128 i -// | CUInt128 i -> DUInt128 i - -// | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) - -// | CChar c -> DChar c -// | CString s -> DString s - -// | CList items -> DList(ValueType.Unknown, (List.map r items)) -// | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) -// | CDict items -> -// DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) - -// | CEnum(Ok typeName, caseName, fields) -> -// // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the -// DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) - -// | CEnum(Error msg, _caseName, _fields) -> -// raiseRTE callStack (RuntimeError.oldError $"Invalid const name: {msg}") - - - -// /// Used in the ELet and ELambda evals -// /// Answers: does the `dval` "match" the given pattern? -// /// -// /// Returns: -// /// - whether or not the expr 'matches' the pattern -// /// - new vars (name * value) -// let rec checkPattern -// (callStack : CallStack) -// (dv : Dval) -// (pattern : LetPattern) -// : List = - -// let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) -// let chPat = checkPattern callStack - -// match pattern with - -// | LPVariable(_, varName) -> [ (varName, dv) ] - -// | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] - -// | LPTuple(_, firstPat, secondPat, theRestPat) -> -// let allPatterns = firstPat :: secondPat :: theRestPat - -// match dv with -// | DTuple(first, second, theRest) -> -// let allVals = first :: second :: theRest - -// if List.length allVals = List.length allPatterns then -// List.zip allVals allPatterns -// |> List.map (fun (dv, pat) -> chPat dv pat) -// |> List.concat -// else -// errStr "Tuple pattern has wrong number of elements" -// | _ -> errStr "Tuple pattern does not match" - -// fsharplint:disable FL0039 - - -let typeResolutionError - (callStack : CallStack) - (errorType : NameResolutionError.ErrorType) - : Ply<'a> = - let error : NameResolutionError.Error = - { errorType = errorType; nameType = NameResolutionError.Type } - error |> NameResolutionError.RTE.toRuntimeError |> raiseRTE callStack - - -// let recordMaybe -// (callStack : CallStack) -// (types : Types) -// (typeName : FQTypeName.FQTypeName) -// // TypeName, typeParam list, fully-resolved (except for typeParam) field list -// : Ply * List> = -// let rec inner (typeName : FQTypeName.FQTypeName) = -// uply { -// match! Types.find typeName types with -// | Some({ typeParams = outerTypeParams -// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), -// outerTypeArgs)) }) -> -// // Here we have found an alias, so we need to combine the type's -// // typeArgs with the aliased type's typeParams. -// // e.g. in -// // `type Var = Result` -// // we need to combine Var's typeArgs () with Result's -// // typeParams (<`Ok, `Error>) -// // -// // To do this, we use typeArgs from the alias definition -// // (outerTypeArgs) and apply them to the aliased type -// // (innerTypeName)'s params (which are returned from the lookup and -// // used as innerTypeParams below). -// // Example: suppose we have -// // type Outer<'a> = Inner<'a, Int> -// // type Inner<'x, 'y> = { x : 'x; y : 'y } -// // The recursive search for Inner will get: -// // innerTypeName = "Inner" -// // innerTypeParams = ["x"; "y"] -// // fields = [("x", TVar "x"); ("y", TVar "y")] -// // The Outer definition provides: -// // outerTypeArgs = [TVar "a"; TInt64] -// // We combine this with innerTypeParams to get: -// // fields = [("x", TVar "a"); ("y", TInt64)] -// // outerTypeParams = ["a"] -// // So the effective result of this is: -// // type Outer<'a> = { x : 'a; y : Int } -// let! (innerTypeName, innerTypeParams, fields) = inner innerTypeName -// return -// (innerTypeName, -// outerTypeParams, -// fields -// |> List.map (fun (k, v) -> -// (k, Types.substitute innerTypeParams outerTypeArgs v))) - -// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> -// return raiseRTE callStack e - -// | Some({ typeParams = typeParams; definition = TypeDeclaration.Record fields }) -> -// return -// (typeName, -// typeParams, -// fields |> NEList.toList |> List.map (fun f -> f.name, f.typ)) - -// | Some({ definition = TypeDeclaration.Alias(_) }) -// | Some({ definition = TypeDeclaration.Enum _ }) -> -// let packageTypeID = -// match typeName with -// | FQTypeName.FQTypeName.Package id -> id -// return! -// typeResolutionError -// callStack -// (NameResolutionError.ExpectedRecordButNot packageTypeID) - -// | None -> -// return! typeResolutionError callStack (NameResolutionError.NotFound []) -// } -// inner typeName - - -// let enumMaybe -// (callStack : CallStack) -// (types : Types) -// (typeName : FQTypeName.FQTypeName) -// : Ply * NEList> = -// let rec inner (typeName : FQTypeName.FQTypeName) = -// uply { -// match! Types.find typeName types with -// | Some({ typeParams = outerTypeParams -// definition = TypeDeclaration.Alias(TCustomType(Ok(innerTypeName), -// outerTypeArgs)) }) -> -// let! (innerTypeName, innerTypeParams, cases) = inner innerTypeName -// return -// (innerTypeName, -// outerTypeParams, -// cases -// |> NEList.map (fun (c : TypeDeclaration.EnumCase) -> -// { c with -// fields = -// List.map -// (Types.substitute innerTypeParams outerTypeArgs) -// c.fields })) - -// | Some({ definition = TypeDeclaration.Alias(TCustomType(Error e, _)) }) -> -// return raiseRTE callStack e - -// | Some({ typeParams = typeParams; definition = TypeDeclaration.Enum cases }) -> -// return (typeName, typeParams, cases) - -// | Some({ definition = TypeDeclaration.Alias _ }) -// | Some({ definition = TypeDeclaration.Record _ }) -> -// let packageTypeID = -// match typeName with -// | FQTypeName.FQTypeName.Package id -> id -// return! -// typeResolutionError -// callStack -// (NameResolutionError.ExpectedEnumButNot packageTypeID) -// | None -> -// return! typeResolutionError callStack (NameResolutionError.NotFound []) // typeName -// } -// inner typeName - - -/// Interprets an expression and reduces it to a Dark value -/// (or a task that should result in such) -let rec eval (state : ExecutionState) (e : Instructions) : DvalTask = - // Some helper fns to make it easier to update the state's callstack - // for a given expr, match pattern, etc. - let callStackID (id : id) = - { state.tracing.callStack with - lastCalled = (fst state.tracing.callStack.lastCalled, Some id) } - let stateWithUpdatedCallStack id = - { state with tracing.callStack = callStackID id } - - // Update the state's callStack with the id of the expr we're evaluating - let state = stateWithUpdatedCallStack (Expr.toID e) - let callStack = state.tracing.callStack - - // Some helper fns to make it easier to raise RTEs - let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) - //let err callStack rte : 'a = raiseRTE callStack rte - let raiseExeRTE callStack (e : ExecutionError.Error) : Ply<'a> = - ExecutionError.raise callStack e - - uply { - match e with - | EString(_, [ StringText s ]) -> - // We expect strings to be normalized during parsing - return DString(s) - | EString(_, segments) -> - let! segments = - segments - |> Ply.List.mapSequentially (fun seg -> - uply { - match seg with - | StringText text -> return text - | StringInterpolation expr -> - match! eval state expr with - | DString s -> return s - | dv -> - // TODO: maybe better with a type error here - return! - raiseExeRTE - callStack - (ExecutionError.NonStringInStringInterpolation dv) - }) - return segments |> String.concat "" |> String.normalize |> DString - - - // | EConstant(_, name) -> - // match name with - // | FQConstantName.Builtin c -> - // match Map.find c state.builtins.constants with - // | None -> - // return! - // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - // | Some constant -> return constant.body - - // | FQConstantName.Package c -> - // match! state.packageManager.getConstant c with - // | None -> - // return! - // ExecutionError.raise callStack (ExecutionError.ConstDoesntExist name) - // | Some constant -> return evalConst callStack constant.body - - - // | ELet(_, pattern, rhs, body) -> - // let! rhs = eval state rhs - // let newDefs = checkPattern callStack rhs pattern - // let newSymtable = Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - - // return! eval { state with symbolTable = newSymtable } body - - // | ETuple(_, first, second, theRest) -> - // let! firstResult = eval state first - // let! secondResult = eval state second - // let! otherResults = Ply.List.mapSequentially (eval state) theRest - // return DTuple(firstResult, secondResult, otherResults) - - - // | ERecord(_, typeName, fields) -> - // let types = ExecutionState.availableTypes state - - // let! (aliasTypeName, _typeParams, expectedFields) = - // recordMaybe callStack types typeName - // let expectedFields = Map expectedFields - - // let! fields = - // fields - // |> NEList.toList - // |> Ply.List.foldSequentially - // (fun fields (fieldName, expr) -> - // uply { - // match Map.find fieldName expectedFields with - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionFieldDoesntExist( - // typeName, - // fieldName - // )) - // | Some fieldType -> - // let! v = eval state expr - // if Map.containsKey fieldName fields then - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionDuplicateField( - // typeName, - // fieldName - // )) - - // else - // let context = - // TypeChecker.RecordField(typeName, fieldName, fieldType) - // let check = TypeChecker.unify context types Map.empty fieldType v - // match! check with - // | Ok() -> return Map.add fieldName v fields - // | Error e -> return err callStack e - // }) - // Map.empty - - // if Map.count fields = Map.count expectedFields then - // return DRecord(aliasTypeName, typeName, VT.typeArgsTODO, fields) - // else - // let expectedFields = Map.keys expectedFields - // let fieldName = - // Seq.find (fun k -> not (Map.containsKey k fields)) expectedFields - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionMissingField(typeName, fieldName)) - - - // | ERecordUpdate(_, baseRecord, updates) -> - // // CLEANUP refactor this impl - // // namely, focus more on the `fields` and don't pass around DRecord so much - - // let! baseRecord = eval state baseRecord - // match baseRecord with - // | DRecord(typeName, _, typ, _) -> - // let typeStr = FQTypeName.toString typeName - // let types = ExecutionState.availableTypes state - - // let! (_, _, expected) = recordMaybe callStack types typeName - // let expectedFields = Map expected - // return! - // updates - // |> NEList.toList - // |> Ply.List.foldSequentially - // (fun record (fieldName, expr) -> - // uply { - // let! dv = eval state expr - - // match record, fieldName, dv with - // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" - // | _, _, _ when not (Map.containsKey fieldName expectedFields) -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.RecordConstructionFieldDoesntExist( - // typeName, - // fieldName - // )) - - // | DRecord(typeName, original, _, m), fieldName, dv -> - // let fieldType = Map.findUnsafe fieldName expectedFields - - // let context = - // TypeChecker.RecordField(typeName, fieldName, fieldType) - - // match! TypeChecker.unify context types Map.empty fieldType dv with - // | Ok() -> - // return DRecord(typeName, original, typ, Map.add fieldName dv m) - // | Error rte -> return raiseRTE callStack rte - - // | _ -> - // return - // errStr - // callStack - // $"Expected a record but {typeStr} is something else" - // }) - // baseRecord - // | _ -> return errStr callStack "Expected a record in record update" - - // | EDict(_, fields) -> - // let! fields = - // fields - // |> Ply.List.mapSequentially (fun (k, v) -> - // uply { - // let! v = eval state v - // return (k, v) - // }) - // return TypeChecker.DvalCreator.dict ValueType.Unknown fields - - | EFnName(_, name) -> return DFnVal(NamedFn name) - - | EApply(_, fnTarget, typeArgs, exprs) -> - match! eval state fnTarget with - | DFnVal fnVal -> - let! args = Ply.NEList.mapSequentially (eval state) exprs - return! applyFnVal state fnVal typeArgs args - | other -> - return - errStr - callStack - $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" - - - // | ERecordFieldAccess(_, e, fieldName) -> - // let! obj = eval state e - - // if fieldName = "" then - // return errStr callStack "Field name is empty" - // else - // match obj with - // | DRecord(_, typeName, _, fields) -> - // match Map.find fieldName fields with - // | Some v -> return v - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.FieldAccessFieldDoesntExist(typeName, fieldName)) - // | DDB _ -> - // let msg = - // $"Attempting to access field '{fieldName}' of a Datastore " - // + "(use `DB.*` standard library functions to interact with Datastores. " - // + "Field access only work with records)" - // return errStr callStack msg - // | _ -> - - // return - // ExecutionError.raise - // callStack - // (ExecutionError.FieldAccessNotRecord(Dval.toValueType obj, fieldName)) - - - // | ELambda(_, parameters, body) -> - // // It is the responsibility of wherever executes the DBlock to pass in - // // args and execute the body. - // return - // DFnVal( - // Lambda - // { typeSymbolTable = state.typeSymbolTable - // symtable = state.symbolTable - // parameters = parameters - // body = body } - // ) - - - // | EMatch(_, matchExpr, cases) -> - // /// Does the dval 'match' the given pattern? - // /// - // /// Returns: - // /// - whether or not the expr 'matches' the pattern - // /// - new vars (name * value) - // let rec checkPattern - // (dv : Dval) - // (pattern : MatchPattern) - // : Ply> = - // uply { - // // CLEANUP things down the line assume that the `id` in the callStack is an _Expression_ ID. - // // It might be nice to also allow for MP IDs. This would require a change in the callStack here. - // // let state = stateWithUpdatedCallStack (MatchPattern.toID pattern) - // // let callStack = state.tracing.callStack - - // let errWrongType expected = - // raiseExeRTE - // callStack - // (ExecutionError.MatchExprPatternWrongType(expected, dv)) - - // match pattern with - // | MPUnit(_) -> - // match dv with - // | DUnit -> return true, [] - // | _ -> return! errWrongType "Unit" - - // | MPBool(_, pb) -> - // match dv with - // | DBool db -> return (db = pb), [] - // | _ -> return! errWrongType "Bool" - - // | MPInt8(_, pi) -> - // match dv with - // | DInt8 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int8" - // | MPUInt8(_, pi) -> - // match dv with - // | DUInt8 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt8" - // | MPInt16(_, pi) -> - // match dv with - // | DInt16 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int16" - // | MPUInt16(_, pi) -> - // match dv with - // | DUInt16 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt16" - // | MPInt32(_, pi) -> - // match dv with - // | DInt32 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int32" - // | MPUInt32(_, pi) -> - // match dv with - // | DUInt32 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt32" - // | MPInt64(_, pi) -> - // match dv with - // | DInt64 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int64" - // | MPUInt64(_, pi) -> - // match dv with - // | DUInt64 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt64" - // | MPInt128(_, pi) -> - // match dv with - // | DInt128 di -> return (di = pi), [] - // | _ -> return! errWrongType "Int128" - // | MPUInt128(_, pi) -> - // match dv with - // | DUInt128 di -> return (di = pi), [] - // | _ -> return! errWrongType "UInt128" - - // | MPFloat(_, pf) -> - // match dv with - // | DFloat df -> return (df = pf), [] - // | _ -> return! errWrongType "Float" - - // | MPChar(_, pc) -> - // match dv with - // | DChar dc -> return (dc = pc), [] - // | _ -> return! errWrongType "Char" - // | MPString(_, ps) -> - // match dv with - // | DString ds -> return (ds = ps), [] - // | _ -> return! errWrongType "String" - - // | MPEnum(_, caseName, fieldPats) -> - // match dv with - // | DEnum(_dTypeName, _oTypeName, _typeArgsDEnumTODO, dCaseName, dFields) -> - // if caseName <> dCaseName then - // return false, [] - // else - // let dvFieldLength = List.length dFields - // match fieldPats with - // // wildcard - // | [ MPVariable(_, "_") ] when dvFieldLength > 0 -> return true, [] - // | _ -> - // let patFieldLength = List.length fieldPats - // if dvFieldLength <> patFieldLength then - // return! - // raiseExeRTE - // callStack - // (ExecutionError.MatchExprEnumPatternWrongCount( - // dCaseName, - // patFieldLength, - // dvFieldLength - // )) - // else - // let! (passResults, newVarResults) = - // List.zip dFields fieldPats - // |> Ply.List.mapSequentially (fun (dv, pat) -> - // checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - - // | _dv -> return! errWrongType caseName - - - // | MPTuple(_, firstPat, secondPat, theRestPat) -> - // let allPatterns = firstPat :: secondPat :: theRestPat - - // match dv with - // | DTuple(first, second, theRest) -> - // let allVals = first :: second :: theRest - - // if List.length allVals = List.length allPatterns then - // let! (passResults, newVarResults) = - // List.zip allVals allPatterns - // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - // else - // return false, [] - // | _ -> - // // TODO: specify length? - // return! errWrongType "Tuple" - - - // | MPListCons(_, headPat, tailPat) -> - // match dv with - // | DList(_, []) -> return false, [] - // | DList(vt, headVal :: tailVals) -> - // let! (headPass, headVars) = checkPattern headVal headPat - // let! (tailPass, tailVars) = - // checkPattern - // (TypeChecker.DvalCreator.list callStack vt tailVals) - // tailPat - - // let allSubVars = headVars @ tailVars - // let pass = headPass && tailPass - // return pass, allSubVars - // | _ -> return! errWrongType "List" - - // | MPList(_, pats) -> - // match dv with - // | DList(_, vals) -> - // if List.length vals = List.length pats then - // let! (passResults, newVarResults) = - // List.zip vals pats - // |> Ply.List.mapSequentially (fun (dv, pat) -> checkPattern dv pat) - // |> Ply.map List.unzip - - // let allPass = List.forall identity passResults - // let allVars = newVarResults |> List.collect identity - // return allPass, allVars - // else - // return false, [] - // | _ -> return! errWrongType "List" - - // | MPVariable(_, varName) -> return true, [ (varName, dv) ] - // } - - - // // The value we're matching against - // let! matchVal = eval state matchExpr - - // let mutable matchResult = None - - // for case in NEList.toList cases do - // if Option.isSome matchResult then - // () - // else - // let! passesPattern, newDefs = checkPattern matchVal case.pat - // let newSymtable = - // Map.mergeFavoringRight state.symbolTable (Map.ofList newDefs) - // let state = { state with symbolTable = newSymtable } - // let! passesWhenCondition = - // uply { - // match case.whenCondition with - // | Some whenCondition when passesPattern -> - // match! eval state whenCondition with - // | DBool b -> return b - // | _ -> return errStr callStack "When condition should be a boolean" - // | _ -> return true - // } - // if passesPattern && passesWhenCondition then - // let! r = eval state case.rhs - // matchResult <- Some r - - // match matchResult with - // | Some r -> return r - // | None -> - // return! raiseExeRTE callStack (ExecutionError.MatchExprUnmatched matchVal) - - - // | EIf(_, cond, thenBody, elseBody) -> - // match! eval state cond with - // | DBool false -> - // match elseBody with - // | None -> return DUnit - // | Some eb -> return! eval state eb - // | DBool true -> return! eval state thenBody - // | _ -> return errStr callStack "If only supports Booleans" - - - // | EOr(_, left, right) -> - // match! eval state left with - // | DBool true -> return DBool true - // | DBool false -> - // match! eval state right with - // | DBool _ as b -> return b - // | _ -> return errStr callStack "|| only supports Booleans" - // | _ -> return errStr callStack "|| only supports Booleans" - - - // | EAnd(_, left, right) -> - // match! eval state left with - // | DBool false -> return DBool false - // | DBool true -> - // match! eval state right with - // | DBool _ as b -> return b - // | _ -> return errStr callStack "&& only supports Booleans" - // | _ -> return errStr callStack "&& only supports Booleans" - - - // | EEnum(_, sourceTypeName, caseName, fields) -> - // let types = ExecutionState.availableTypes state - - // let! (resolvedTypeName, _, cases) = enumMaybe callStack types sourceTypeName - // let case = cases |> NEList.find (fun c -> c.name = caseName) - - // match case with - // | None -> - // return - // ExecutionError.raise - // callStack - // (ExecutionError.EnumConstructionCaseNotFound(sourceTypeName, caseName)) - - // | Some case -> - // if case.fields.Length <> fields.Length then - // let msg = - // $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" - // return errStr callStack msg - // else - // let! (fields : List) = - // Ply.List.foldSequentiallyWithIndex - // (fun - // fieldIndex - // fieldsSoFar - // ((enumFieldType : TypeReference), fieldExpr) -> - // uply { - // let! v = eval state fieldExpr - - // let context = - // TypeChecker.EnumField( - // sourceTypeName, - // case.name, - // fieldIndex, - // List.length fields, - // enumFieldType - // ) - - // // VTTODO: we should be passing in a proper tst, not Map.empty - right? - // match! - // TypeChecker.unify context types Map.empty enumFieldType v - // with - // | Ok() -> return (List.append fieldsSoFar [ v ]) - // | Error rte -> return raiseRTE callStack rte - // }) - // [] - // (List.zip case.fields fields) - - // return! - // TypeChecker.DvalCreator.enum - // resolvedTypeName - // sourceTypeName - // caseName - // fields - - | EError(_, rte, exprs) -> - let! (_ : List) = Ply.List.mapSequentially (eval state) exprs - return raiseRTE callStack rte - } - - -and applyFnVal - (state : ExecutionState) - (fnVal : FnValImpl) - (typeArgs : List) - (args : NEList) - : DvalTask = - match fnVal with - //| Lambda l -> executeLambda state l args - | NamedFn fn -> callFn state fn typeArgs args - -// and executeLambda -// (state : ExecutionState) -// (l : LambdaImpl) -// (args : NEList) -// : DvalTask = - -// // One of the reasons to take a separate list of params and args is to -// // provide this error message here. We don't have this information in -// // other places, and the alternative is just to provide incompletes -// // with no context -// let expectedLength = NEList.length l.parameters -// let actualLength = NEList.length args -// if expectedLength <> actualLength then -// raiseRTE -// state.tracing.callStack -// (RuntimeError.oldError -// $"Expected {expectedLength} arguments, got {actualLength}") - -// else -// let checkPattern' = checkPattern state.tracing.callStack - -// let paramSyms = -// NEList.map2 checkPattern' args l.parameters -// |> NEList.toList -// |> List.flatten -// |> Map - -// let state = -// { state with symbolTable = Map.mergeFavoringRight l.symtable paramSyms } - -// eval state l.body - -and callFn - (state : ExecutionState) - (fnToCall : FQFnName.FQFnName) - (typeArgs : List) - (args : NEList) - : DvalTask = - uply { - let! fn = - match fnToCall with - | FQFnName.Builtin std -> - Map.find std state.builtins.fns |> Option.map builtInFnToFn |> Ply - - | FQFnName.Package pkg -> - uply { - let! fn = state.packageManager.getFn pkg - return Option.map packageFnToFn fn - } - - match fn with - | Some fn -> - let expectedTypeParams = List.length fn.typeParams - let expectedArgs = NEList.length fn.parameters - - let actualTypeArgs = List.length typeArgs - let actualArgs = NEList.length args - - if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then - ExecutionError.raise - state.tracing.callStack - (ExecutionError.WrongNumberOfFnArgs( - fnToCall, - expectedTypeParams, - expectedArgs, - actualTypeArgs, - actualArgs - )) - - let state = - let boundArgs = - NEList.map2 (fun (p : Param) actual -> (p.name, actual)) fn.parameters args - |> NEList.toList - |> Map - { state with - symbolTable = Map.mergeFavoringRight state.symbolTable boundArgs } - - let state = - let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map - { state with - typeSymbolTable = - Map.mergeFavoringRight state.typeSymbolTable newlyBoundTypeArgs } - - return! execFn state fnToCall fn typeArgs args - - | None -> - // Functions which aren't available in the runtime (for whatever reason) - // may have results available in traces. (use case: inspecting a cloud-run trace locally) - let fnResult = - state.tracing.loadFnResult - (state.tracing.callStack.lastCalled, fnToCall) - args - - match fnResult with - | Some(result, _ts) -> return result - | None -> - return - raiseRTE - state.tracing.callStack - (RuntimeError.oldError - $"Function {FQFnName.toString fnToCall} is not found") - } - - -and execFn - (state : ExecutionState) - (fnDesc : FQFnName.FQFnName) - (fn : Fn) - (typeArgs : List) - (args : NEList) - : DvalTask = - uply { - let types = ExecutionState.availableTypes state - - let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map - let typeSymbolTable = - Map.mergeFavoringRight state.typeSymbolTable typeArgsResolvedInFn - - match! TypeChecker.checkFunctionCall types typeSymbolTable fn args with - | Error rte -> return raiseRTE state.tracing.callStack rte - | Ok() -> - let! result = - match fn.fn with - | BuiltInFunction f -> - let executionPoint = ExecutionPoint.Function fn.name - - state.tracing.traceExecutionPoint executionPoint - - let state = - { state with tracing.callStack.lastCalled = (executionPoint, None) } - - uply { - let! result = - uply { - try - return! f (state, typeArgs, NEList.toList args) - with e -> - match e with - | RuntimeErrorException(None, rte) -> - // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack - // So we catch the exception here and add the callStack to it so it's handy in error-reporting - return raiseRTE state.tracing.callStack rte - - | RuntimeErrorException _ -> return Exception.reraise e - - | e -> - let context : Metadata = - [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] - state.reportException state context e - // These are arbitrary errors, and could include sensitive - // information, so best not to show it to the user. If we'd - // like to show it to the user, we should catch it where it happens - // and give them a known safe error via a RuntimeError - return - raiseRTE - state.tracing.callStack - (RuntimeError.oldError "Unknown error") - } - - if fn.previewable <> Pure then - // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath - state.tracing.storeFnResult - (state.tracing.callStack.lastCalled, fnDesc) - args - result - - return result - } - - | PackageFunction(id, body) -> - // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? - // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) - let executionPoint = ExecutionPoint.Function(FQFnName.Package id) - - state.tracing.traceExecutionPoint executionPoint - - let state = - { state with - tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } - - eval state body - - match! TypeChecker.checkFunctionReturnType types typeSymbolTable fn result with - | Error rte -> return raiseRTE state.tracing.callStack rte - | Ok() -> return result - } diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 9027d9c9a4..6979fb211d 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -7,6 +7,7 @@ open FSharp.Control.Tasks.Affine.Unsafe open Prelude open RuntimeTypes +module RTE = RuntimeError module VT = ValueType @@ -104,6 +105,7 @@ let rec checkAndExtractMatchPattern // Dval didn't match the pattern even in a basic sense | _ -> false, [] + /// TODO: don't pass ExecutionState around so much? /// The parts that change, (e.g. `st` and `tst`) should probably all be part of VMState /// @@ -111,337 +113,366 @@ let rec checkAndExtractMatchPattern /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec private execute - (exeState : ExecutionState) - (initialVmState : VMState) - : Ply = +let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = uply { - let mutable vmState = initialVmState - let mutable counter = 0 // what instruction (by index) we're on + let mutable counter = vm.pc // what instruction (by index) we're on + + let raiseRTE rte = raiseRTE vm.callStack rte - // if we encounter a runtime error, we store it here and then `raise` it at the end - let mutable rte : Option = None + while counter < vm.instructions.Length do - while counter < vmState.instructions.Length && Option.isNone rte do - let instruction = vmState.instructions[counter] + match vm.instructions[counter] with - match instruction with - // put a static Dval into a register + // == Simple register operations == | LoadVal(reg, value) -> - vmState.registers[reg] <- value + vm.registers[reg] <- value counter <- counter + 1 - // `let x = 1` - | SetVar(varName, loadFrom) -> - let value = vmState.registers[loadFrom] - vmState <- - { vmState with symbolTable = Map.add varName value vmState.symbolTable } + | CopyVal(copyTo, copyFrom) -> + vm.registers[copyTo] <- vm.registers[copyFrom] counter <- counter + 1 - // later, `x` + + // == Working with Variables == | GetVar(loadTo, varName) -> - match Map.find varName vmState.symbolTable with + match Map.find varName vm.symbolTable with | Some value -> - vmState.registers[loadTo] <- value + vm.registers[loadTo] <- value counter <- counter + 1 - | None -> - rte <- Some(RuntimeError.oldError ("Variable not found: " + varName)) - - - // `add (increment 1L) (3L)` and store results in `putResultIn` - // At this point, the 'increment' has already been evaluated. - // But maybe that's something we should change, (CLEANUP) - // so that we don't execute things until they're needed - | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> - // should we instead pass in register indices? probably... - let args = argRegs |> NEList.map (fun r -> vmState.registers[r]) - //debuG "args" (NEList.length args) - let thingToCall = vmState.registers[thingToCallReg] - let! result = call exeState vmState thingToCall typeArgs args - vmState.registers[putResultIn] <- result + | None -> raiseRTE (RTE.Error.VariableNotFound varName) + + | CheckLetPatternAndExtractVars(valueReg, pat) -> + let dv = vm.registers[valueReg] + let matches, vars = checkAndExtractLetPattern pat dv + + if matches then + vm.symbolTable <- + List.fold + (fun symbolTable (varName, value) -> Map.add varName value symbolTable) + vm.symbolTable + vars + counter <- counter + 1 + else + raiseRTE (RTE.Let(RTE.Lets.PatternDoesNotMatch(dv, pat))) + + // == Working with Basic Types == + | CreateString(targetReg, segments) -> + let sb = new System.Text.StringBuilder() + + segments + |> List.iter (fun seg -> + match seg with + | StringSegment.Text s -> sb.Append s |> ignore + | StringSegment.Interpolated reg -> + match vm.registers[reg] with + | DString s -> sb.Append s |> ignore + | _ -> raiseRTE (RTE.String RTE.Strings.Error.InvalidStringAppend)) + + vm.registers[targetReg] <- DString(sb.ToString()) counter <- counter + 1 + + // == Flow Control == + // -- Jumps -- + | JumpBy jumpBy -> counter <- counter + jumpBy + 1 + + | JumpByIfFalse(jumpBy, condReg) -> + match vm.registers[condReg] with + | DBool false -> counter <- counter + jumpBy + 1 + | DBool true -> counter <- counter + 1 + | dv -> + let vt = Dval.toValueType dv + raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) + + // -- Match -- + | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> + let matches, vars = checkAndExtractMatchPattern pat vm.registers[valueReg] + + if matches then + vm.symbolTable <- + List.fold + (fun symbolTable (varName, value) -> Map.add varName value symbolTable) + vm.symbolTable + vars + counter <- counter + 1 + else + counter <- counter + failJump + 1 + + | MatchUnmatched -> raiseRTE RTE.MatchUnmatched + + + // == Working with Collections == | CreateList(listReg, itemsToAddRegs) -> // CLEANUP reference registers directly in DvalCreator.list, // so we don't have to copy things - let itemsToAdd = itemsToAddRegs |> List.map (fun r -> vmState.registers[r]) - vmState.registers[listReg] <- - TypeChecker.DvalCreator.list - exeState.tracing.callStack - VT.unknown - itemsToAdd + let itemsToAdd = itemsToAddRegs |> List.map (fun r -> vm.registers[r]) + vm.registers[listReg] <- + TypeChecker.DvalCreator.list vm.callStack VT.unknown itemsToAdd counter <- counter + 1 | CreateDict(dictReg, entries) -> // CLEANUP reference registers directly in DvalCreator.dict, // so we don't have to copy things let entries = - entries - |> List.map (fun (key, valueReg) -> (key, vmState.registers[valueReg])) - vmState.registers[dictReg] <- TypeChecker.DvalCreator.dict VT.unknown entries + entries |> List.map (fun (key, valueReg) -> (key, vm.registers[valueReg])) + vm.registers[dictReg] <- + TypeChecker.DvalCreator.dict vm.callStack VT.unknown entries counter <- counter + 1 | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> - let first = vmState.registers[firstReg] - let second = vmState.registers[secondReg] - let theRest = theRestRegs |> List.map (fun r -> vmState.registers[r]) - vmState.registers[tupleReg] <- DTuple(first, second, theRest) + let first = vm.registers[firstReg] + let second = vm.registers[secondReg] + let theRest = theRestRegs |> List.map (fun r -> vm.registers[r]) + vm.registers[tupleReg] <- DTuple(first, second, theRest) counter <- counter + 1 - // I'm not sure, but it also feels like string-creation doesn't need to be so many - // instructions. Maybe we should just have a CreateString instruction. - // Maybe that's a tad more complicated because of interpolation... but maybe not actually. - // If CreateString just references a list of registers, then the interpolation is already - // done by the time we get to CreateString. - // I don't think we need to worry about checking "is this string part really a string" - // before we get to CreateString. - // Oh, that said - if there's nested string interpolation (if that's legal?), would that - // result in nested CreateString instructions? Write out an example. - // OK did some quick search and it seems no language really allows nested string interpolation. - // So we're probably fine. - // That said, let's also consider the _normal_ case of a String with a simple StringText or StringInterpolation - // segment - this shouldn't result in many instructions. - // CreateString itself could contain a list of Text and Interpolation segments, where Interpolation - // segments just refer to a register with some (supposed) string value -- and we only have to cehck those. - | AppendString(targetReg, sourceReg) -> - match vmState.registers[targetReg], vmState.registers[sourceReg] with - | DString target, DString source -> - vmState.registers[targetReg] <- DString(target + source) - counter <- counter + 1 - | _, _ -> - // TODO - rte <- Some(RuntimeError.oldError "Error: Invalid string-append attempt") - + // == Working with Custom Data == + // -- Records -- + | CreateRecord(recordReg, typeName, typeArgs, fields) -> + let fields = + fields |> List.map (fun (name, valueReg) -> (name, vm.registers[valueReg])) - | JumpByIfFalse(jumpBy, condReg) -> - match vmState.registers[condReg] with - | DBool false -> counter <- counter + jumpBy + 1 - | DBool true -> counter <- counter + 1 - | _ -> - // TODO - rte <- - Some(RuntimeError.oldError "Error: Jump condition must be a boolean") - - | JumpBy jumpBy -> counter <- counter + jumpBy + 1 + let! record = + TypeChecker.DvalCreator.record + vm.callStack + exeState.types + typeName + typeArgs + fields - - | CopyVal(copyTo, copyFrom) -> - vmState.registers[copyTo] <- vmState.registers[copyFrom] + vm.registers[recordReg] <- record counter <- counter + 1 - | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> - let matches, vars = - checkAndExtractMatchPattern pat vmState.registers[valueReg] - - if matches then - vmState <- - vars - |> List.fold - (fun vmState (varName, value) -> - { vmState with - symbolTable = Map.add varName value vmState.symbolTable }) - vmState - counter <- counter + 1 - else - counter <- counter + failJump + 1 - + // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> + // let originalRecord = vm.registers[originalRecordReg] + // let updates = + // updates + // |> List.map (fun (fieldName, valueReg) -> + // (fieldName, vm.registers[valueReg])) + // let updatedRecord = + // TypeChecker.DvalCreator.record + // exeState.tracing.callStack + // typeName + // typeArgs + // updates + + // vm.registers[targetReg] <- updatedRecord + // counter <- counter + 1 + + | GetRecordField(targetReg, recordReg, fieldName) -> + match vm.registers[recordReg] with + | DRecord(_, _, _, fields) -> + match Map.find fieldName fields with + | Some value -> + vm.registers[targetReg] <- value + counter <- counter + 1 + | None -> + RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE + | dv -> + RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) + |> RTE.Record + |> raiseRTE + + // -- Enums -- + | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> + // TODO: safe dval creation + let fields = fields |> List.map (fun (valueReg) -> vm.registers[valueReg]) + vm.registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) + counter <- counter + 1 - | CheckLetPatternAndExtractVars(valueReg, pat) -> - let matches, vars = checkAndExtractLetPattern pat vmState.registers[valueReg] - if matches then - vmState <- - vars - |> List.fold - (fun vmState (varName, value) -> - { vmState with - symbolTable = Map.add varName value vmState.symbolTable }) - vmState - counter <- counter + 1 - else - rte <- Some(RuntimeError.oldError "Let Pattern did not match") + // == Working with things that Apply (like fns, lambdas) == + // // `add (increment 1L) (3L)` and store results in `putResultIn` + // // At this point, the 'increment' has already been evaluated. + // // But maybe that's something we should change, (CLEANUP) + // // so that we don't execute things until they're needed + // | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> + // // should we instead pass in register indices? probably... + // let args = argRegs |> NEList.map (fun r -> vm.registers[r]) + // //debuG "args" (NEList.length args) + // let thingToCall = vm.registers[thingToCallReg] + // let! result = call exeState vm thingToCall typeArgs args + // vm.registers[putResultIn] <- result + // counter <- counter + 1 - | Fail _rte -> rte <- Some(RuntimeError.oldError "TODO") - | MatchUnmatched -> rte <- Some(RuntimeError.oldError "match not matched") + | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) // If we've reached the end of the instructions, return the result - match rte with - | None -> return vmState.registers[vmState.resultReg] - | Some rte -> return raiseRTE exeState.tracing.callStack rte + return vm.registers[vm.resultReg] } -and call - (exeState : ExecutionState) - (vmState : VMState) - (thingToCall : Dval) - (typeArgs : List) - (args : NEList) - : Ply = - uply { - match thingToCall with - | DFnVal(NamedFn fnName) -> - let! fn = - match fnName with - | FQFnName.Builtin std -> - Map.find std exeState.fns.builtIn |> Option.map builtInFnToFn |> Ply - - | FQFnName.Package pkg -> - uply { - let! fn = exeState.fns.package pkg - return Option.map packageFnToFn fn - } - - match fn with - | Some fn -> - // let expectedTypeParams = List.length fn.typeParams - // let expectedArgs = NEList.length fn.parameters - - // let actualTypeArgs = List.length typeArgs - // let actualArgs = NEList.length args - - // if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then - // ExecutionError.raise - // state.tracing.callStack - // (ExecutionError.WrongNumberOfFnArgs( - // fnToCall, - // expectedTypeParams, - // expectedArgs, - // actualTypeArgs, - // actualArgs - // )) - - let vmState = - let boundArgs = - NEList.map2 - (fun (p : Param) actual -> (p.name, actual)) - fn.parameters - args - |> NEList.toList - |> Map - { vmState with - symbolTable = Map.mergeFavoringRight vmState.symbolTable boundArgs } - - let vmState = - let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map - { vmState with - typeSymbolTable = - Map.mergeFavoringRight vmState.typeSymbolTable newlyBoundTypeArgs } - - return! execFn exeState vmState fnName fn typeArgs args - - | None -> - // Functions which aren't available in the runtime (for whatever reason) - // may have results available in traces. (use case: inspecting a cloud-run trace locally) - let fnResult = - exeState.tracing.loadFnResult - (exeState.tracing.callStack.lastCalled, fnName) - args - - match fnResult with - | Some(result, _ts) -> return result - | None -> - return - raiseRTE - exeState.tracing.callStack - (RuntimeError.oldError - $"Function {FQFnName.toString fnName} is not found") - - | _ -> - debuG "thingToCall" thingToCall - return DUnit // TODO - } - -and execFn - (exeState : ExecutionState) - (vmState : VMState) - (fnDesc : FQFnName.FQFnName) - (fn : Fn) - (typeArgs : List) - (args : NEList) - : DvalTask = - uply { - let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map - let typeSymbolTable = - Map.mergeFavoringRight vmState.typeSymbolTable typeArgsResolvedInFn - - match! TypeChecker.checkFunctionCall exeState.types typeSymbolTable fn args with - | Error rte -> return raiseRTE exeState.tracing.callStack rte - | Ok() -> - let! result = - match fn.fn with - | BuiltInFunction f -> - let executionPoint = ExecutionPoint.Function fn.name - - exeState.tracing.traceExecutionPoint executionPoint - - let exeState = - { exeState with tracing.callStack.lastCalled = (executionPoint, None) } - - uply { - let! result = - uply { - try - return! f (exeState, vmState, typeArgs, NEList.toList args) - with e -> - match e with - | RuntimeErrorException(None, rte) -> - // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack - // So we catch the exception here and add the callStack to it so it's handy in error-reporting - return raiseRTE exeState.tracing.callStack rte - - | RuntimeErrorException _ -> return Exception.reraise e - - | e -> - let context : Metadata = - [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] - exeState.reportException exeState context e - // These are arbitrary errors, and could include sensitive - // information, so best not to show it to the user. If we'd - // like to show it to the user, we should catch it where it happens - // and give them a known safe error via a RuntimeError - return - raiseRTE - exeState.tracing.callStack - (RuntimeError.oldError "Unknown error") - } - - if fn.previewable <> Pure then - // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath - exeState.tracing.storeFnResult - (exeState.tracing.callStack.lastCalled, fnDesc) - args - result - - return result - } - - | PackageFunction(_id, _instructionsWithContext) -> - //let _registersNeeded, instructions, resultReg = _instructionsWithContext - // // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? - // // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) - // let executionPoint = ExecutionPoint.Function(FQFnName.Package id) - - // state.tracing.traceExecutionPoint executionPoint - - // // let state = - // // { state with - // // tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } - - // and how can we pass the args in? - // maybe fns need some LoadVal instructions frontloaded or something? hmm. - //eval state instructions resultReg - Ply DUnit // TODO - - match! - TypeChecker.checkFunctionReturnType exeState.types typeSymbolTable fn result - with - | Error rte -> return raiseRTE exeState.tracing.callStack rte - | Ok() -> return result - } +// and call +// (exeState : ExecutionState) +// (vmState : VMState) +// (thingToCall : Dval) +// (typeArgs : List) +// (args : NEList) +// : Ply = +// uply { +// match thingToCall with +// | DFnVal(NamedFn fnName) -> +// let! fn = +// match fnName with +// | FQFnName.Builtin std -> +// Map.find std exeState.fns.builtIn |> Option.map builtInFnToFn |> Ply + +// | FQFnName.Package pkg -> +// uply { +// let! fn = exeState.fns.package pkg +// return Option.map packageFnToFn fn +// } + +// match fn with +// | Some fn -> +// // let expectedTypeParams = List.length fn.typeParams +// // let expectedArgs = NEList.length fn.parameters + +// // let actualTypeArgs = List.length typeArgs +// // let actualArgs = NEList.length args + +// // if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then +// // ExecutionError.raise +// // state.tracing.callStack +// // (ExecutionError.WrongNumberOfFnArgs( +// // fnToCall, +// // expectedTypeParams, +// // expectedArgs, +// // actualTypeArgs, +// // actualArgs +// // )) + +// let vmState = +// let boundArgs = +// NEList.map2 +// (fun (p : Param) actual -> (p.name, actual)) +// fn.parameters +// args +// |> NEList.toList +// |> Map +// { vmState with +// symbolTable = Map.mergeFavoringRight vmState.symbolTable boundArgs } + +// let vmState = +// let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map +// { vmState with +// typeSymbolTable = +// Map.mergeFavoringRight vmState.typeSymbolTable newlyBoundTypeArgs } + +// return! execFn exeState vmState fnName fn typeArgs args + +// | None -> +// // Functions which aren't available in the runtime (for whatever reason) +// // may have results available in traces. (use case: inspecting a cloud-run trace locally) +// let fnResult = +// exeState.tracing.loadFnResult +// (exeState.tracing.callStack.lastCalled, fnName) +// args + +// match fnResult with +// | Some(result, _ts) -> return result +// | None -> +// return +// raiseRTE +// exeState.tracing.callStack +// (RuntimeError.oldError +// $"Function {FQFnName.toString fnName} is not found") + +// | _ -> +// debuG "thingToCall" thingToCall +// return DUnit // TODO +// } + +// and execFn +// (exeState : ExecutionState) +// (vmState : VMState) +// (fnDesc : FQFnName.FQFnName) +// (fn : Fn) +// (typeArgs : List) +// (args : NEList) +// : DvalTask = +// uply { +// let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map +// let typeSymbolTable = +// Map.mergeFavoringRight vmState.typeSymbolTable typeArgsResolvedInFn + +// match! TypeChecker.checkFunctionCall exeState.types typeSymbolTable fn args with +// | Error rte -> return raiseRTE exeState.tracing.callStack rte +// | Ok() -> +// let! result = +// match fn.fn with +// | BuiltInFunction f -> +// let executionPoint = ExecutionPoint.Function fn.name + +// exeState.tracing.traceExecutionPoint executionPoint + +// let exeState = +// { exeState with tracing.callStack.lastCalled = (executionPoint, None) } + +// uply { +// let! result = +// uply { +// try +// return! f (exeState, vmState, typeArgs, NEList.toList args) +// with e -> +// match e with +// | RuntimeErrorException(None, rte) -> +// // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack +// // So we catch the exception here and add the callStack to it so it's handy in error-reporting +// return raiseRTE exeState.tracing.callStack rte + +// | RuntimeErrorException _ -> return Exception.reraise e + +// | e -> +// let context : Metadata = +// [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] +// exeState.reportException exeState context e +// // These are arbitrary errors, and could include sensitive +// // information, so best not to show it to the user. If we'd +// // like to show it to the user, we should catch it where it happens +// // and give them a known safe error via a RuntimeError +// return +// raiseRTE +// exeState.tracing.callStack +// (RuntimeError.oldError "Unknown error") +// } + +// if fn.previewable <> Pure then +// // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath +// exeState.tracing.storeFnResult +// (exeState.tracing.callStack.lastCalled, fnDesc) +// args +// result + +// return result +// } + +// | PackageFunction(_id, _instructionsWithContext) -> +// //let _registersNeeded, instructions, resultReg = _instructionsWithContext +// // // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? +// // // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) +// // let executionPoint = ExecutionPoint.Function(FQFnName.Package id) + +// // state.tracing.traceExecutionPoint executionPoint + +// // // let state = +// // // { state with +// // // tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } + +// // and how can we pass the args in? +// // maybe fns need some LoadVal instructions frontloaded or something? hmm. +// //eval state instructions resultReg +// Ply DUnit // TODO + +// match! +// TypeChecker.checkFunctionReturnType exeState.types typeSymbolTable fn result +// with +// | Error rte -> return raiseRTE exeState.tracing.callStack rte +// | Ok() -> return result +// } diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index 1ba0c1813b..b661eb81b2 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -1,4 +1,5 @@ + Library net8.0 @@ -8,33 +9,40 @@ false true + + + + + + + + - + + + - - - - - - - - + - - + + - - - - - + + + + + + + + + + - \ No newline at end of file diff --git a/backend/src/LibExecution/NameResolutionError.fs b/backend/src/LibExecution/NameResolutionError.fs deleted file mode 100644 index 9c3905a470..0000000000 --- a/backend/src/LibExecution/NameResolutionError.fs +++ /dev/null @@ -1,112 +0,0 @@ -module LibExecution.NameResolutionError - -open Prelude - -module RT = RuntimeTypes -module VT = RT.ValueType -//module D = DvalDecoder -//module RT2DT = RuntimeTypesToDarkTypes - - -type ErrorType = - | NotFound of List - | ExpectedEnumButNot of packageTypeID : uuid - | ExpectedRecordButNot of packageTypeID : uuid - | MissingEnumModuleName of caseName : string - | InvalidPackageName of List - -type NameType = - | Function - | Type - | Constant - -type Error = { errorType : ErrorType; nameType : NameType } - -/// to RuntimeError -module RTE = - // module ErrorType = - // let typeName = - // RT.FQTypeName.fqPackage - // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.errorType - - // let toDT (et : ErrorType) : RT.Dval = - // let (caseName, fields) = - // match et with - // | NotFound names -> - // "NotFound", [ RT.DList(VT.string, List.map RT.DString names) ] - // | ExpectedEnumButNot packageTypeID -> - // "ExpectedEnumButNot", [ RT.DUuid packageTypeID ] - // | ExpectedRecordButNot packageTypeID -> - // "ExpectedRecordButNot", [ RT.DUuid packageTypeID ] - // | MissingEnumModuleName caseName -> - // "MissingEnumModuleName", [ RT.DString caseName ] - // | InvalidPackageName names -> - // "InvalidPackageName", [ RT.DList(VT.string, List.map RT.DString names) ] - - // RT.DEnum(typeName, typeName, [], caseName, fields) - - // let fromDT (dv : RT.Dval) : ErrorType = - // let string (dv : RT.Dval) : string = - // match dv with - // | RT.DString s -> s - // | _ -> Exception.raiseInternal "Invalid ErrorType" [] - - // match dv with - // | RT.DEnum(_, _, [], "NotFound", [ RT.DList(_, names) ]) -> - // NotFound(List.map string names) - // | RT.DEnum(_, _, [], "ExpectedEnumButNot", [ RT.DUuid packageTypeID ]) -> - // ExpectedEnumButNot packageTypeID - // | RT.DEnum(_, _, [], "ExpectedRecordButNot", [ RT.DUuid packageTypeID ]) -> - // ExpectedRecordButNot packageTypeID - // | RT.DEnum(_, _, [], "MissingEnumModuleName", [ RT.DString caseName ]) -> - // MissingEnumModuleName caseName - // | RT.DEnum(_, _, [], "InvalidPackageName", [ RT.DList(_, names) ]) -> - // InvalidPackageName(List.map string names) - // | _ -> Exception.raiseInternal "Invalid ErrorType" [] - - // module NameType = - // let typeName = - // RT.FQTypeName.fqPackage - // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.nameType - // let toDT (nt : NameType) : RT.Dval = - // let (caseName, fields) = - // match nt with - // | Function -> "Function", [] - // | Type -> "Type", [] - // | Constant -> "Constant", [] - - // RT.DEnum(typeName, typeName, [], caseName, fields) - - // let fromDT (dv : RT.Dval) : NameType = - // match dv with - // | RT.DEnum(_, _, [], "Function", []) -> Function - // | RT.DEnum(_, _, [], "Type", []) -> Type - // | RT.DEnum(_, _, [], "Constant", []) -> Constant - // | _ -> Exception.raiseInternal "Invalid NameType" [] - - // module Error = - // let typeName = - // RT.FQTypeName.fqPackage - // PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.error - // let toDT (e : Error) : RT.Dval = - // let fields = - // [ ("errorType", ErrorType.toDT e.errorType) - // ("nameType", NameType.toDT e.nameType) ] - // RT.DRecord(typeName, typeName, [], Map fields) - - // let fromDT (dv : RT.Dval) : Error = - // match dv with - // | RT.DRecord(_, _, _, m) -> - // let errorType = m |> D.field "errorType" |> ErrorType.fromDT - // let nameType = m |> D.field "nameType" |> NameType.fromDT - // { errorType = errorType; nameType = nameType } - // | _ -> Exception.raiseInternal "Expected DRecord" [] - - let toRuntimeError (_e : Error) : RT.RuntimeError = - //Error.toDT e |> RT.RuntimeError.nameResolutionError - "TODO" |> RT.RuntimeError.oldError - -// let fromRuntimeError (re : RT.RuntimeError) : Error = -// // TODO: this probably doesn't unwrap the type -// // see above function -// RT.RuntimeError.toDT re |> Error.fromDT diff --git a/backend/src/LibExecution/PackageIDs.fs b/backend/src/LibExecution/PackageIDs.fs index c0f91391c5..a23641e3a0 100644 --- a/backend/src/LibExecution/PackageIDs.fs +++ b/backend/src/LibExecution/PackageIDs.fs @@ -123,33 +123,37 @@ module Type = module RuntimeError = let private p addl = p ("RuntimeErrors" :: addl) - module Error = - let errorMessage = - p [ "Error" ] "ErrorMessage" "3e526964-304f-46a8-919c-6d65bb6ff167" + module Lists = + let private p addl = p ("Lists" :: addl) + let error = p [] "Error" "f327ad98-ec15-4cfe-bcfe-6f0f5a444349" + + // module Error = + // let errorMessage = + // p [ "Error" ] "ErrorMessage" "3e526964-304f-46a8-919c-6d65bb6ff167" - module NameResolution = - let private p addl = p ("NameResolution" :: addl) - let errorType = p [] "ErrorType" "ada30799-1227-4902-b580-76bca80c9e92" - let nameType = p [] "NameType" "aafe54e1-d970-4ce0-81a1-1569af86671f" - let error = p [] "Error" "85dea116-469e-41ca-a166-dc97f5e4fb1d" + // module NameResolution = + // let private p addl = p ("NameResolution" :: addl) + // let errorType = p [] "ErrorType" "ada30799-1227-4902-b580-76bca80c9e92" + // let nameType = p [] "NameType" "aafe54e1-d970-4ce0-81a1-1569af86671f" + // let error = p [] "Error" "85dea116-469e-41ca-a166-dc97f5e4fb1d" - module TypeChecker = - let private p addl = p ("TypeChecker" :: addl) - let context = p [] "Context" "e8c100b9-2944-44db-b6c2-e766e49591b6" - let errorType = p [] "ErrorType" "7281f060-ca34-473c-9529-caa9a28f173e" - let error = p [] "Error" "c1e79fa9-26f8-41f1-be06-6b54a2f496ee" + // module TypeChecker = + // let private p addl = p ("TypeChecker" :: addl) + // let context = p [] "Context" "e8c100b9-2944-44db-b6c2-e766e49591b6" + // let errorType = p [] "ErrorType" "7281f060-ca34-473c-9529-caa9a28f173e" + // let error = p [] "Error" "c1e79fa9-26f8-41f1-be06-6b54a2f496ee" - module Execution = - let error = p [ "Execution" ] "Error" "68dd1300-b7ba-45c8-937c-78fd2ce490ec" + // module Execution = + // let error = p [ "Execution" ] "Error" "68dd1300-b7ba-45c8-937c-78fd2ce490ec" - module Int = - let error = p [ "Int" ] "Error" "8f753bfe-9e35-4a9e-a47e-c1dbb5f83037" + // module Int = + // let error = p [ "Int" ] "Error" "8f753bfe-9e35-4a9e-a47e-c1dbb5f83037" - module Json = - let error = p [ "Json" ] "Error" "595907db-ab8d-4fe5-b9cf-d1bd8041e9bb" + // module Json = + // let error = p [ "Json" ] "Error" "595907db-ab8d-4fe5-b9cf-d1bd8041e9bb" - module Cli = - let error = p [ "Cli" ] "Error" "6756f735-2a6a-41ac-a6a8-6e0b7354ca1b" + // module Cli = + // let error = p [ "Cli" ] "Error" "6756f735-2a6a-41ac-a6a8-6e0b7354ca1b" let error = p [] "Error" "722cd3b3-d6af-4d28-96f2-87afd44c3898" @@ -179,17 +183,21 @@ module Type = let letPattern = p [] "LetPattern" "5ca5d251-0703-49ce-a40d-28c2e4575431" let matchPattern = p [] "MatchPattern" "003c6684-4f9d-4085-bdba-a7f3bea7f587" let matchCase = p [] "MatchCase" "5fb0f282-5f7c-4fb8-b107-b63429080e69" - let stringSegment = p [] "StringSegment" "ccadbf5b-1802-4db7-a30b-7b9073db78cd" - let expr = p [] "Expr" "1f19e838-81f2-4a94-94b8-bad2ce7f7cf7" + //let stringSegment = p [] "StringSegment" "ccadbf5b-1802-4db7-a30b-7b9073db78cd" + //let expr = p [] "Expr" "1f19e838-81f2-4a94-94b8-bad2ce7f7cf7" let dval = p [ "Dval" ] "Dval" "528b682c-a249-4a50-bd93-85e1e8cb529e" let knownType = p [] "KnownType" "50940368-5c6b-4f0b-9966-48b9e9443f5d" let valueType = p [] "ValueType" "eeb27326-120b-4a71-bd13-a6dc545e5ade" - let lambdaImpl = p [] "LambdaImpl" "51a98562-4c44-4999-8673-ce7a370e2cb8" - let fnValImpl = p [] "FnValImpl" "9332be6b-65d7-44eb-bb4c-e89e86b10e33" + //let lambdaImpl = p [] "LambdaImpl" "51a98562-4c44-4999-8673-ce7a370e2cb8" + //let fnValImpl = p [] "FnValImpl" "9332be6b-65d7-44eb-bb4c-e89e86b10e33" module ProgramTypes = let private p addl = p ("ProgramTypes" :: addl) + + let nameResolutionError = + p [] "NameResolutionError" "de779c1d-bebc-43d9-bb3d-4c160cca62eb" + module FQTypeName = let private p addl = p ("FQTypeName" :: addl) let package = p [] "Package" "ad2b1288-5005-4943-a03b-caa8056a2aee" diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 6f6e82fd68..6fe8c75042 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -12,7 +12,7 @@ let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$" //let typeNamePattern = @"^[A-Z][a-z0-9A-Z_]*$" let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$" -//let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" +let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let assertBuiltin (name : string) @@ -23,45 +23,47 @@ let assertBuiltin assert_ "version can't be negative" [ "version", version ] (version >= 0) -// /// Fully-Qualified Type Name -// /// -// /// Used to reference a type defined in a Package or by a User -// module FQTypeName = -// /// The id of a type in the package manager -// type Package = uuid +/// Fully-Qualified Type Name +/// +/// Used to reference a type defined in a Package or by a User +module FQTypeName = + /// The id of a type in the package manager + type Package = uuid -// type FQTypeName = Package of Package + type FQTypeName = Package of Package -// let package (id : uuid) : Package = id + let package (id : uuid) : Package = id + let fqPackage (id : uuid) : FQTypeName = Package id -// /// A Fully-Qualified Constant Name -// /// -// /// Used to reference a constant defined by the runtime, in a Package, or by a User -// module FQConstantName = -// /// A constant built into the runtime -// type Builtin = { name : string; version : int } -// /// The id of a constant in the package manager -// type Package = uuid +/// A Fully-Qualified Constant Name +/// +/// Used to reference a constant defined by the runtime, in a Package, or by a User +module FQConstantName = + /// A constant built into the runtime + type Builtin = { name : string; version : int } -// type FQConstantName = -// | Builtin of Builtin -// | Package of Package + /// The id of a constant in the package manager + type Package = uuid + type FQConstantName = + | Builtin of Builtin + | Package of Package -// let assertConstantName (name : string) : unit = -// assertRe "Constant name must match" constantNamePattern name -// let builtIn (name : string) (version : int) : Builtin = -// assertBuiltin name version assertConstantName -// { name = name; version = version } + let assertConstantName (name : string) : unit = + assertRe "Constant name must match" constantNamePattern name -// let fqBuiltIn (name : string) (version : int) : FQConstantName = -// Builtin(builtIn name version) + let builtIn (name : string) (version : int) : Builtin = + assertBuiltin name version assertConstantName + { name = name; version = version } -// let package (id : uuid) : Package = id + let fqBuiltIn (name : string) (version : int) : FQConstantName = + Builtin(builtIn name version) + + let package (id : uuid) : Package = id @@ -113,7 +115,11 @@ module FQFnName = // resolved name, and the Error case models the text name of the type and some error // information. -type NameResolution<'a> = Result<'a, NameResolutionError.Error> +type NameResolutionError = + | NotFound of List + | InvalidName of List + +type NameResolution<'a> = Result<'a, NameResolutionError> type LetPattern = @@ -174,17 +180,17 @@ type BinaryOperation = type InfixFnName = | ArithmeticPlus | ArithmeticMinus -// | ArithmeticMultiply -// | ArithmeticDivide -// | ArithmeticModulo -// | ArithmeticPower -// | ComparisonGreaterThan -// | ComparisonGreaterThanOrEqual -// | ComparisonLessThan -// | ComparisonLessThanOrEqual -// | ComparisonEquals -// | ComparisonNotEquals -// | StringConcat + | ArithmeticMultiply + | ArithmeticDivide + | ArithmeticModulo + | ArithmeticPower + | ComparisonGreaterThan + | ComparisonGreaterThanOrEqual + | ComparisonLessThan + | ComparisonLessThanOrEqual + | ComparisonEquals + | ComparisonNotEquals + | StringConcat type Infix = | InfixFnCall of InfixFnName @@ -223,20 +229,20 @@ type TypeReference = | TTuple of TypeReference * TypeReference * List | TDict of TypeReference -//| TFn of arguments : NEList * ret : TypeReference + /// A type defined by a standard library module, a canvas/user, or a package + /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` + /// `typeArgs` is the list of type arguments, if any + | TCustomType of + // TODO: this reference should be by-hash + NameResolution * + typeArgs : List -//| TDB of TypeReference -// A named variable, eg `a` in `List`, matches anything + | TFn of arguments : NEList * ret : TypeReference -// /// A type defined by a standard library module, a canvas/user, or a package -// /// e.g. `Result` is represented as `TCustomType("Result", [TInt64, TString])` -// /// `typeArgs` is the list of type arguments, if any -// | TCustomType of -// // TODO: this reference should be by-hash -// NameResolution * -// typeArgs : List + | TVariable of string -//| TVariable of string +//| TDB of TypeReference +// A named variable, eg `a` in `List`, matches anything /// Expressions - the main part of the language. type Expr = @@ -300,65 +306,66 @@ type Expr = | EVariable of id * string - - // -- Basic structures -- | EList of id * List | EDict of id * List | ETuple of id * Expr * Expr * List - - // -- "Applying" args to things, such as fns and lambdas -- - /// This is a function call, the first expression is the value of the function. - /// - `expr (args[0])` - /// - `expr (args[0]) (args[1])` - /// - `expr (args[0])` - | EApply of id * expr : Expr * typeArgs : List * args : NEList + // // -- "Applying" args to things, such as fns and lambdas -- + // /// This is a function call, the first expression is the value of the function. + // /// - `expr (args[0])` + // /// - `expr (args[0]) (args[1])` + // /// - `expr (args[0])` + // | EApply of id * expr : Expr * typeArgs : List * args : NEList /// Reference a function name, _usually_ so we can _apply_ it with args | EFnName of id * NameResolution -// // Composed of a parameters * the expression itself -// // The id in the varname list is the analysis id, used to get a livevalue -// // from the analysis engine -// | ELambda of id * pats : NEList * body : Expr + // // Composed of a parameters * the expression itself + // // The id in the varname list is the analysis id, used to get a livevalue + // // from the analysis engine + // | ELambda of id * pats : NEList * body : Expr -// /// Calls upon an infix function -// | EInfix of id * Infix * lhs : Expr * rhs : Expr + // /// Calls upon an infix function + // | EInfix of id * Infix * lhs : Expr * rhs : Expr -// // -- References to custom types and data -- + // -- References to custom types and data -- + + /// Construct a record + /// `SomeRecord { field1: value; field2: value }` + | ERecord of + id * + // TODO: this reference should be by-hash + typeName : NameResolution * + typeArgs : List * + // User is allowed type `Name {}` even if that's an error + fields : List + + /// Access a field of some record (e.g. `someExpr.fieldName`) + | ERecordFieldAccess of id * record : Expr * fieldName : string + + // /// Clone a record, and update some of its values + // /// `{ r with key = value }` + // | ERecordUpdate of id * record : Expr * updates : NEList -// /// Construct a record -// /// `SomeRecord { field1: value; field2: value }` -// | ERecord of -// id * -// // TODO: this reference should be by-hash -// typeName : NameResolution * -// // User is allowed type `Name {}` even if that's an error -// fields : List - -// | ERecordUpdate of id * record : Expr * updates : NEList - -// /// Access a field of some record (e.g. `someExpr.fieldName`) -// | ERecordFieldAccess of id * record: Expr * fieldName: string - - -// // Enums include `Some`, `None`, `Error`, `Ok`, as well -// // as user-defined enums. -// // -// /// Given an Enum type of: -// /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` -// /// , this is the expression -// /// `C (1, "title")` -// /// represented as -// /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` -// | EEnum of -// id * -// // TODO: this reference should be by-hash -// typeName : NameResolution * -// caseName : string * -// fields : List + + // Enums include `Some`, `None`, `Error`, `Ok`, as well + // as user-defined enums. + // + /// Given an Enum type of: + /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` + /// , this is the expression + /// `C (1, "title")` + /// represented as + /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` + | EEnum of + id * + // TODO: this reference should be by-hash + typeName : NameResolution * + typeArgs : List * + caseName : string * + fields : List // | EConstant of // id * @@ -412,16 +419,16 @@ module Expr = //| EInfix(id, _, _, _) // | ELambda(id, _, _) | EFnName(id, _) - // | ERecordFieldAccess(id, _, _) + | ERecordFieldAccess(id, _, _) | EVariable(id, _) - | EApply(id, _, _, _) + //| EApply(id, _, _, _) | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) // | EPipe(id, _, _) - // | ERecord(id, _, _) + | ERecord(id, _, _, _) // | ERecordUpdate(id, _, _) - // | EEnum(id, _, _, _) + | EEnum(id, _, _, _, _) | EMatch(id, _, _) -> id // module PipeExpr = @@ -434,56 +441,62 @@ module Expr = // | EPipeEnum(id, _, _, _) -> id -// /// A type defined by a package or canvas/user -// module TypeDeclaration = -// type RecordField = { name : string; typ : TypeReference; description : string } +/// A type defined by a package or canvas/user +module TypeDeclaration = + type RecordField = { name : string; typ : TypeReference; description : string } -// type EnumField = -// { typ : TypeReference; label : Option; description : string } + // type EnumField = + // { typ : TypeReference; label : Option; description : string } -// type EnumCase = { name : string; fields : List; description : string } + // type EnumCase = { name : string; fields : List; description : string } -// /// The right-hand-side of the declaration: eg List<'a> -// type Definition = -// /// `type MyAlias = Int64` -// | Alias of TypeReference + /// The right-hand-side of the declaration: eg List<'a> + type Definition = + /// `type MyAlias = Int64` + | Alias of TypeReference -// /// `type MyRecord = { a : int; b : string }` -// | Record of NEList + /// `type MyRecord = { a : int; b : string }` + | Record of NEList -// /// `type MyEnum = A | B of int | C of int * (label: string)` -// | Enum of NEList + // /// `type MyEnum = A | B of int | C of int * (label: string)` + // | Enum of NEList -// /// Combined the RHS definition, with the list of type parameters. Eg type -// /// MyType<'a> = List<'a> -// type T = { typeParams : List; definition : Definition } + /// Combined the RHS definition, with the list of type parameters. Eg type + /// MyType<'a> = List<'a> + type T = { typeParams : List; definition : Definition } -// type Const = -// | CInt64 of int64 -// | CUInt64 of uint64 -// | CInt8 of int8 -// | CUInt8 of uint8 -// | CInt16 of int16 -// | CUInt16 of uint16 -// | CInt32 of int32 -// | CUInt32 of uint32 -// | CInt128 of System.Int128 -// | CUInt128 of System.UInt128 -// | CBool of bool -// | CString of string -// | CChar of string -// | CFloat of Sign * string * string -// | CUnit -// | CTuple of first : Const * second : Const * rest : List +/// Replace this whole concept with just "Package Values" that store Dvals +type Const = + | CUnit -// | CEnum of -// // TODO: this reference should be by-hash -// NameResolution * -// caseName : string * -// fields : List -// | CList of List -// | CDict of List + | CBool of bool + + | CInt8 of int8 + | CUInt8 of uint8 + | CInt16 of int16 + | CUInt16 of uint16 + | CInt32 of int32 + | CUInt32 of uint32 + | CInt64 of int64 + | CUInt64 of uint64 + | CInt128 of System.Int128 + | CUInt128 of System.UInt128 + + | CFloat of Sign * string * string + + | CChar of string + | CString of string + + | CList of List + | CDict of List + | CTuple of first : Const * second : Const * rest : List + + | CEnum of + // TODO: this reference should be by-hash + NameResolution * + caseName : string * + fields : List @@ -524,33 +537,33 @@ type Deprecation<'name> = // nameParts |> String.concat "." -// module PackageType = -// type Name = { owner : string; modules : List; name : string } +module PackageType = + type Name = { owner : string; modules : List; name : string } -// let name (owner : string) (modules : List) (name : string) : Name = -// // TODO: assert OK -// { owner = owner; modules = modules; name = name } + let name (owner : string) (modules : List) (name : string) : Name = + // TODO: assert OK + { owner = owner; modules = modules; name = name } -// type PackageType = -// { id : uuid -// name : Name -// declaration : TypeDeclaration.T -// description : string -// deprecated : Deprecation } + type PackageType = + { id : uuid + name : Name + declaration : TypeDeclaration.T + description : string + deprecated : Deprecation } -// module PackageConstant = -// type Name = { owner : string; modules : List; name : string } +module PackageConstant = + type Name = { owner : string; modules : List; name : string } -// let name (owner : string) (modules : List) (name : string) : Name = -// // TODO: assert OK -// { owner = owner; modules = modules; name = name } + let name (owner : string) (modules : List) (name : string) : Name = + // TODO: assert OK + { owner = owner; modules = modules; name = name } -// type PackageConstant = -// { id : uuid -// name : Name -// description : string -// deprecated : Deprecation -// body : Const } + type PackageConstant = + { id : uuid + name : Name + description : string + deprecated : Deprecation + body : Const } module PackageFn = type Name = { owner : string; modules : List; name : string } @@ -572,13 +585,13 @@ module PackageFn = deprecated : Deprecation } type Packages = - { //types : List - //constants : List + { types : List + constants : List fns : List } static member combine(packages : List) : Packages = - { //types = packages |> List.collect _.types - //constants = packages |> List.collect _.constants + { types = packages |> List.collect _.types + constants = packages |> List.collect _.constants fns = packages |> List.collect _.fns } @@ -588,25 +601,25 @@ type Packages = /// but there's a chance of Local <-> Cloud not being fully in sync, /// for whatever reasons. type PackageManager = - { //findType : PackageType.Name -> Ply> - //findConstant : PackageConstant.Name -> Ply> + { findType : PackageType.Name -> Ply> + findConstant : PackageConstant.Name -> Ply> findFn : PackageFn.Name -> Ply> - //getType : FQTypeName.Package -> Ply> - // getConstant : - // FQConstantName.Package -> Ply> + getType : FQTypeName.Package -> Ply> + getConstant : + FQConstantName.Package -> Ply> getFn : FQFnName.Package -> Ply> init : Ply } static member empty = - { //findType = (fun _ -> Ply None) + { findType = (fun _ -> Ply None) findFn = (fun _ -> Ply None) - //findConstant = (fun _ -> Ply None) + findConstant = (fun _ -> Ply None) - //getType = (fun _ -> Ply None) + getType = (fun _ -> Ply None) getFn = (fun _ -> Ply None) - //getConstant = (fun _ -> Ply None) + getConstant = (fun _ -> Ply None) init = uply { return () } } @@ -615,37 +628,36 @@ type PackageManager = /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras (pm : PackageManager) - //(types : List) - //(constants : List) + (types : List) + (constants : List) (fns : List) : PackageManager = - { - // findType = - // fun name -> - // match types |> List.tryFind (fun t -> t.name = name) with - // | Some t -> Some t.id |> Ply - // | None -> pm.findType name - // findConstant = - // fun name -> - // match constants |> List.tryFind (fun c -> c.name = name) with - // | Some c -> Some c.id |> Ply - // | None -> pm.findConstant name + { findType = + fun name -> + match types |> List.tryFind (fun t -> t.name = name) with + | Some t -> Some t.id |> Ply + | None -> pm.findType name + findConstant = + fun name -> + match constants |> List.tryFind (fun c -> c.name = name) with + | Some c -> Some c.id |> Ply + | None -> pm.findConstant name findFn = fun name -> match fns |> List.tryFind (fun f -> f.name = name) with | Some f -> Some f.id |> Ply | None -> pm.findFn name - // getType = - // fun id -> - // match types |> List.tryFind (fun t -> t.id = id) with - // | Some t -> Ply(Some t) - // | None -> pm.getType id - // getConstant = - // fun id -> - // match constants |> List.tryFind (fun c -> c.id = id) with - // | Some c -> Ply(Some c) - // | None -> pm.getConstant id + getType = + fun id -> + match types |> List.tryFind (fun t -> t.id = id) with + | Some t -> Ply(Some t) + | None -> pm.getType id + getConstant = + fun id -> + match constants |> List.tryFind (fun c -> c.id = id) with + | Some c -> Ply(Some c) + | None -> pm.getConstant id getFn = fun id -> match fns |> List.tryFind (fun f -> f.id = id) with @@ -656,48 +668,48 @@ type PackageManager = -// // -- -// // User things -// // -- -// module DB = -// type T = { tlid : tlid; name : string; version : int; typ : TypeReference } - -// module Secret = -// type T = { name : string; value : string; version : int } - -// module Handler = -// type CronInterval = -// | EveryDay -// | EveryWeek -// | EveryFortnight -// | EveryHour -// | Every12Hours -// | EveryMinute - -// /// User to represent handlers in their lowest-level form: a triple of space * name * modifier -// /// "Space" is "HTTP", "WORKER", "REPL", etc. -// /// -// /// "Modifier" options differ based on space. -// /// e.g. HTTP handler may have "GET" modifier. -// /// -// /// Handlers which don't have modifiers (e.g. repl, worker) nearly -// /// always (but not actually always) have `_` as their modifier. -// type HandlerDesc = (string * string * string) - -// type Spec = -// | HTTP of route : string * method : string -// | Worker of name : string -// | Cron of name : string * interval : CronInterval -// | REPL of name : string - -// type T = { tlid : tlid; ast : Expr; spec : Spec } - -// module Toplevel = -// type T = -// | TLDB of DB.T -// | TLHandler of Handler.T - -// let toTLID (tl : T) : tlid = -// match tl with -// | TLDB db -> db.tlid -// | TLHandler h -> h.tlid +// -- +// User things +// -- +module DB = + type T = { tlid : tlid; name : string; version : int; typ : TypeReference } + +module Secret = + type T = { name : string; value : string; version : int } + +module Handler = + type CronInterval = + | EveryDay + | EveryWeek + | EveryFortnight + | EveryHour + | Every12Hours + | EveryMinute + + /// User to represent handlers in their lowest-level form: a triple of space * name * modifier + /// "Space" is "HTTP", "WORKER", "REPL", etc. + /// + /// "Modifier" options differ based on space. + /// e.g. HTTP handler may have "GET" modifier. + /// + /// Handlers which don't have modifiers (e.g. repl, worker) nearly + /// always (but not actually always) have `_` as their modifier. + type HandlerDesc = (string * string * string) + + type Spec = + | HTTP of route : string * method : string + | Worker of name : string + | Cron of name : string * interval : CronInterval + | REPL of name : string + + type T = { tlid : tlid; ast : Expr; spec : Spec } + +module Toplevel = + type T = + | TLDB of DB.T + | TLHandler of Handler.T + + let toTLID (tl : T) : tlid = + match tl with + | TLDB db -> db.tlid + | TLHandler h -> h.tlid diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index c478f79d2c..4cfabf68bf 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -6,7 +6,6 @@ open RuntimeTypes module PT = ProgramTypes module VT = ValueType -module NRE = LibExecution.NameResolutionError module D = LibExecution.DvalDecoder module C2DT = LibExecution.CommonToDarkTypes @@ -32,10 +31,10 @@ module Sign = // TODO: should these be elsewhere? -let ownerField m = m |> D.stringField "owner" -let modulesField m = m |> D.stringListField "modules" -let nameField m = m |> D.stringField "name" -let versionField m = m |> D.intField "version" +let ownerField m = m |> D.field "owner" |> D.string +let modulesField m = m |> D.field "modules" |> D.list D.string +let nameField m = m |> D.field "name" |> D.string +let versionField m = m |> D.field "version" |> D.int32 module FQTypeName = @@ -158,1339 +157,1368 @@ module FQConstantName = | _ -> Exception.raiseInternal "Invalid FQConstantName" [] -module NameResolution = - let toDT - (nameValueType : KnownType) - (f : 'p -> Dval) - (result : PT.NameResolution<'p>) - : Dval = - let errType = KTCustomType(NameResolutionError.RTE.Error.typeName, []) - C2DT.Result.toDT nameValueType errType result f NRE.RTE.Error.toDT - - let fromDT (f : Dval -> 'a) (d : Dval) : PT.NameResolution<'a> = - C2DT.Result.fromDT f d NRE.RTE.Error.fromDT - - -module TypeReference = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.typeReference - let knownType = KTCustomType(typeName, []) - - let rec toDT (t : PT.TypeReference) : Dval = - let (caseName, fields) = - match t with - | PT.TVariable name -> "TVariable", [ DString name ] - - | PT.TUnit -> "TUnit", [] - | PT.TBool -> "TBool", [] - | PT.TInt8 -> "TInt8", [] - | PT.TUInt8 -> "TUInt8", [] - | PT.TInt16 -> "TInt16", [] - | PT.TUInt16 -> "TUInt16", [] - | PT.TInt32 -> "TInt32", [] - | PT.TUInt32 -> "TUInt32", [] - | PT.TInt64 -> "TInt64", [] - | PT.TUInt64 -> "TUInt64", [] - | PT.TInt128 -> "TInt128", [] - | PT.TUInt128 -> "TUInt128", [] - | PT.TFloat -> "TFloat", [] - | PT.TChar -> "TChar", [] - | PT.TString -> "TString", [] - | PT.TDateTime -> "TDateTime", [] - | PT.TUuid -> "TUuid", [] - - | PT.TList inner -> "TList", [ toDT inner ] - - | PT.TTuple(first, second, theRest) -> - "TTuple", - [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - - | PT.TDict inner -> "TDict", [ toDT inner ] - - | PT.TCustomType(typeName, typeArgs) -> - "TCustomType", - [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - DList(VT.known knownType, List.map toDT typeArgs) ] - - | PT.TDB inner -> "TDB", [ toDT inner ] - - | PT.TFn(args, ret) -> - "TFn", - [ DList(VT.known knownType, args |> NEList.toList |> List.map toDT) - toDT ret ] - - DEnum(typeName, typeName, [], caseName, fields) - - let rec fromDT (d : Dval) : PT.TypeReference = - match d with - | DEnum(_, _, [], "TVariable", [ DString name ]) -> PT.TVariable(name) - - | DEnum(_, _, [], "TUnit", []) -> PT.TUnit - | DEnum(_, _, [], "TBool", []) -> PT.TBool - | DEnum(_, _, [], "TInt64", []) -> PT.TInt64 - | DEnum(_, _, [], "TUInt64", []) -> PT.TUInt64 - | DEnum(_, _, [], "TInt8", []) -> PT.TInt8 - | DEnum(_, _, [], "TUInt8", []) -> PT.TUInt8 - | DEnum(_, _, [], "TInt16", []) -> PT.TInt16 - | DEnum(_, _, [], "TUInt16", []) -> PT.TUInt16 - | DEnum(_, _, [], "TInt32", []) -> PT.TInt32 - | DEnum(_, _, [], "TUInt32", []) -> PT.TUInt32 - | DEnum(_, _, [], "TInt128", []) -> PT.TInt128 - | DEnum(_, _, [], "TUInt128", []) -> PT.TUInt128 - | DEnum(_, _, [], "TFloat", []) -> PT.TFloat - | DEnum(_, _, [], "TChar", []) -> PT.TChar - | DEnum(_, _, [], "TString", []) -> PT.TString - | DEnum(_, _, [], "TDateTime", []) -> PT.TDateTime - | DEnum(_, _, [], "TUuid", []) -> PT.TUuid - - | DEnum(_, _, [], "TList", [ inner ]) -> PT.TList(fromDT inner) - - | DEnum(_, _, [], "TTuple", [ first; second; DList(_vtTODO, theRest) ]) -> - PT.TTuple(fromDT first, fromDT second, List.map fromDT theRest) - - | DEnum(_, _, [], "TDict", [ inner ]) -> PT.TDict(fromDT inner) - - | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> - PT.TCustomType( - NameResolution.fromDT FQTypeName.fromDT typeName, - List.map fromDT typeArgs - ) - - | DEnum(_, _, [], "TDB", [ inner ]) -> PT.TDB(fromDT inner) - | DEnum(_, _, [], "TFn", [ DList(_vtTODO, head :: tail); ret ]) -> - PT.TFn(NEList.ofList head tail |> NEList.map fromDT, fromDT ret) - | _ -> Exception.raiseInternal "Invalid TypeReference" [] - - -module LetPattern = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.letPattern - let knownType = KTCustomType(typeName, []) - - let rec toDT (p : PT.LetPattern) : Dval = - let (caseName, fields) = - match p with - | PT.LPVariable(id, name) -> "LPVariable", [ DInt64(int64 id); DString name ] - | PT.LPUnit id -> "LPUnit", [ DInt64(int64 id) ] - | PT.LPTuple(id, first, second, theRest) -> - "LPTuple", - [ DInt64(int64 id) - toDT first - toDT second - DList(VT.known knownType, List.map toDT theRest) ] - - DEnum(typeName, typeName, [], caseName, fields) - - - let rec fromDT (d : Dval) : PT.LetPattern = - match d with - | DEnum(_, _, [], "LPVariable", [ DInt64 id; DString name ]) -> - PT.LPVariable(uint64 id, name) - | DEnum(_, _, [], "LPUnit", [ DInt64 id ]) -> PT.LPUnit(uint64 id) - | DEnum(_, - _, - [], - "LPTuple", - [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - PT.LPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - | _ -> Exception.raiseInternal "Invalid LetPattern" [] - - -module MatchPattern = +module NameResolutionError = let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchPattern - let knownType = KTCustomType(typeName, []) - - let rec toDT (p : PT.MatchPattern) : Dval = - let (caseName, fields) = - match p with - | PT.MPVariable(id, name) -> "MPVariable", [ DInt64(int64 id); DString name ] - - | PT.MPUnit id -> "MPUnit", [ DInt64(int64 id) ] - | PT.MPBool(id, b) -> "MPBool", [ DInt64(int64 id); DBool b ] - | PT.MPInt64(id, i) -> "MPInt64", [ DInt64(int64 id); DInt64 i ] - | PT.MPUInt64(id, i) -> "MPUInt64", [ DInt64(int64 id); DUInt64 i ] - | PT.MPInt8(id, i) -> "MPInt8", [ DInt64(int64 id); DInt8 i ] - | PT.MPUInt8(id, i) -> "MPUInt8", [ DInt64(int64 id); DUInt8 i ] - | PT.MPInt16(id, i) -> "MPInt16", [ DInt64(int64 id); DInt16 i ] - | PT.MPUInt16(id, i) -> "MPUInt16", [ DInt64(int64 id); DUInt16 i ] - | PT.MPInt32(id, i) -> "MPInt32", [ DInt64(int64 id); DInt32 i ] - | PT.MPUInt32(id, i) -> "MPUInt32", [ DInt64(int64 id); DUInt32 i ] - | PT.MPInt128(id, i) -> "MPInt128", [ DInt64(int64 id); DInt128 i ] - | PT.MPUInt128(id, i) -> "MPUInt128", [ DInt64(int64 id); DUInt128 i ] - | PT.MPFloat(id, sign, whole, remainder) -> - - "MPFloat", - [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] - | PT.MPChar(id, c) -> "MPChar", [ DInt64(int64 id); DString c ] - | PT.MPString(id, s) -> "MPString", [ DInt64(int64 id); DString s ] - - | PT.MPList(id, inner) -> - "MPList", - [ DInt64(int64 id); DList(VT.known knownType, List.map toDT inner) ] - | PT.MPListCons(id, head, tail) -> - "MPListCons", [ DInt64(int64 id); toDT head; toDT tail ] - | PT.MPTuple(id, first, second, theRest) -> - "MPTuple", - [ DInt64(int64 id) - toDT first - toDT second - DList(VT.known knownType, List.map toDT theRest) ] - | PT.MPEnum(id, caseName, fieldPats) -> - "MPEnum", - [ DInt64(int64 id) - DString caseName - DList(VT.known knownType, List.map toDT fieldPats) ] - - DEnum(typeName, typeName, [], caseName, fields) - - let rec fromDT (d : Dval) : PT.MatchPattern = - match d with - | DEnum(_, _, [], "MPVariable", [ DInt64 id; DString name ]) -> - PT.MPVariable(uint64 id, name) - - | DEnum(_, _, [], "MPUnit", [ DInt64 id ]) -> PT.MPUnit(uint64 id) - | DEnum(_, _, [], "MPBool", [ DInt64 id; DBool b ]) -> PT.MPBool(uint64 id, b) - | DEnum(_, _, [], "MPInt64", [ DInt64 id; DInt64 i ]) -> PT.MPInt64(uint64 id, i) - | DEnum(_, _, [], "MPUInt64", [ DInt64 id; DUInt64 i ]) -> - PT.MPUInt64(uint64 id, i) - | DEnum(_, _, [], "MPInt8", [ DInt64 id; DInt8 i ]) -> PT.MPInt8(uint64 id, i) - | DEnum(_, _, [], "MPUInt8", [ DInt64 id; DUInt8 i ]) -> PT.MPUInt8(uint64 id, i) - | DEnum(_, _, [], "MPInt16", [ DInt64 id; DInt16 i ]) -> PT.MPInt16(uint64 id, i) - | DEnum(_, _, [], "MPUInt16", [ DInt64 id; DUInt16 i ]) -> - PT.MPUInt16(uint64 id, i) - | DEnum(_, _, [], "MPInt32", [ DInt64 id; DInt32 i ]) -> PT.MPInt32(uint64 id, i) - | DEnum(_, _, [], "MPUInt32", [ DInt64 id; DUInt32 i ]) -> - PT.MPUInt32(uint64 id, i) - | DEnum(_, _, [], "MPInt128", [ DInt64 id; DInt128 i ]) -> - PT.MPInt128(uint64 id, i) - | DEnum(_, _, [], "MPUInt128", [ DInt64 id; DUInt128 i ]) -> - PT.MPUInt128(uint64 id, i) - | DEnum(_, - _, - [], - "MPFloat", - [ DInt64 id; sign; DString whole; DString remainder ]) -> - PT.MPFloat(uint64 id, Sign.fromDT sign, whole, remainder) - | DEnum(_, _, [], "MPChar", [ DInt64 id; DString c ]) -> PT.MPChar(uint64 id, c) - | DEnum(_, _, [], "MPString", [ DInt64 id; DString s ]) -> - PT.MPString(uint64 id, s) - - | DEnum(_, _, [], "MPList", [ DInt64 id; DList(_vtTODO, inner) ]) -> - PT.MPList(uint64 id, List.map fromDT inner) - | DEnum(_, _, [], "MPListCons", [ DInt64 id; head; tail ]) -> - PT.MPListCons(uint64 id, fromDT head, fromDT tail) - | DEnum(_, - _, - [], - "MPTuple", - [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - PT.MPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - | DEnum(_, - _, - [], - "MPEnum", - [ DInt64 id; DString caseName; DList(_vtTODO, fieldPats) ]) -> - PT.MPEnum(uint64 id, caseName, List.map fromDT fieldPats) - | _ -> Exception.raiseInternal "Invalid MatchPattern" [] - - -module BinaryOperation = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.binaryOperation - - let toDT (b : PT.BinaryOperation) : Dval = - let (caseName, fields) = - match b with - | PT.BinOpAnd -> "BinOpAnd", [] - | PT.BinOpOr -> "BinOpOr", [] - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.BinaryOperation = - match d with - | DEnum(_, _, [], "BinOpAnd", []) -> PT.BinOpAnd - | DEnum(_, _, [], "BinOpOr", []) -> PT.BinOpOr - | _ -> Exception.raiseInternal "Invalid BinaryOperation" [] - - -module InfixFnName = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infixFnName - - let toDT (i : PT.InfixFnName) : Dval = - let (caseName, fields) = - match i with - | PT.ArithmeticPlus -> "ArithmeticPlus", [] - | PT.ArithmeticMinus -> "ArithmeticMinus", [] - | PT.ArithmeticMultiply -> "ArithmeticMultiply", [] - | PT.ArithmeticDivide -> "ArithmeticDivide", [] - | PT.ArithmeticModulo -> "ArithmeticModulo", [] - | PT.ArithmeticPower -> "ArithmeticPower", [] - | PT.ComparisonGreaterThan -> "ComparisonGreaterThan", [] - | PT.ComparisonGreaterThanOrEqual -> "ComparisonGreaterThanOrEqual", [] - | PT.ComparisonLessThan -> "ComparisonLessThan", [] - | PT.ComparisonLessThanOrEqual -> "ComparisonLessThanOrEqual", [] - | PT.ComparisonEquals -> "ComparisonEquals", [] - | PT.ComparisonNotEquals -> "ComparisonNotEquals", [] - | PT.StringConcat -> "StringConcat", [] - - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.InfixFnName = - match d with - | DEnum(_, _, [], "ArithmeticPlus", []) -> PT.ArithmeticPlus - | DEnum(_, _, [], "ArithmeticMinus", []) -> PT.ArithmeticMinus - | DEnum(_, _, [], "ArithmeticMultiply", []) -> PT.ArithmeticMultiply - | DEnum(_, _, [], "ArithmeticDivide", []) -> PT.ArithmeticDivide - | DEnum(_, _, [], "ArithmeticModulo", []) -> PT.ArithmeticModulo - | DEnum(_, _, [], "ArithmeticPower", []) -> PT.ArithmeticPower - | DEnum(_, _, [], "ComparisonGreaterThan", []) -> PT.ComparisonGreaterThan - | DEnum(_, _, [], "ComparisonGreaterThanOrEqual", []) -> - PT.ComparisonGreaterThanOrEqual - | DEnum(_, _, [], "ComparisonLessThan", []) -> PT.ComparisonLessThan - | DEnum(_, _, [], "ComparisonLessThanOrEqual", []) -> - PT.ComparisonLessThanOrEqual - | DEnum(_, _, [], "ComparisonEquals", []) -> PT.ComparisonEquals - | DEnum(_, _, [], "ComparisonNotEquals", []) -> PT.ComparisonNotEquals - | DEnum(_, _, [], "StringConcat", []) -> PT.StringConcat - | _ -> Exception.raiseInternal "Invalid InfixFnName" [] - - -module Infix = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infix - - let toDT (i : PT.Infix) : Dval = - let (caseName, fields) = - match i with - | PT.InfixFnCall infixFnName -> "InfixFnCall", [ InfixFnName.toDT infixFnName ] - | PT.BinOp binOp -> "BinOp", [ BinaryOperation.toDT binOp ] - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.Infix = - match d with - | DEnum(_, _, [], "InfixFnCall", [ infixFnName ]) -> - PT.InfixFnCall(InfixFnName.fromDT infixFnName) - | DEnum(_, _, [], "BinOp", [ binOp ]) -> PT.BinOp(BinaryOperation.fromDT binOp) - | _ -> Exception.raiseInternal "Invalid Infix" [] - - -module StringSegment = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.stringSegment - let knownType = KTCustomType(typeName, []) - - let toDT (exprToDT : PT.Expr -> Dval) (s : PT.StringSegment) : Dval = - let (caseName, fields) = - match s with - | PT.StringText text -> "StringText", [ DString text ] - | PT.StringInterpolation expr -> "StringInterpolation", [ exprToDT expr ] - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.StringSegment = - match d with - | DEnum(_, _, [], "StringText", [ DString text ]) -> PT.StringText text - | DEnum(_, _, [], "StringInterpolation", [ expr ]) -> - PT.StringInterpolation(exprFromDT expr) - | _ -> Exception.raiseInternal "Invalid StringSegment" [] - - -module PipeExpr = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.pipeExpr - let knownType = KTCustomType(typeName, []) - - let toDT - (exprKT : KnownType) - (exprToDT : PT.Expr -> Dval) - (s : PT.PipeExpr) - : Dval = - let (caseName, fields) = - match s with - | PT.EPipeVariable(id, varName, exprs) -> - "EPipeVariable", - [ DInt64(int64 id) - DString varName - DList(VT.known exprKT, List.map exprToDT exprs) ] - - | PT.EPipeLambda(id, args, body) -> - let variables = - args - |> NEList.toList - |> List.map LetPattern.toDT - |> Dval.list (KTTuple(VT.int64, VT.string, [])) - "EPipeLambda", [ DInt64(int64 id); variables; exprToDT body ] - - | PT.EPipeInfix(id, infix, expr) -> - "EPipeInfix", [ DInt64(int64 id); Infix.toDT infix; exprToDT expr ] - - | PT.EPipeFnCall(id, fnName, typeArgs, args) -> - "EPipeFnCall", - [ DInt64(int64 id) - NameResolution.toDT FQFnName.knownType FQFnName.toDT fnName - DList( - VT.known TypeReference.knownType, - List.map TypeReference.toDT typeArgs - ) - DList(VT.known exprKT, List.map exprToDT args) ] - - | PT.EPipeEnum(id, typeName, caseName, fields) -> - "EPipeEnum", - [ DInt64(int64 id) - NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - DString caseName - DList(VT.known exprKT, List.map exprToDT fields) ] - - DEnum(typeName, typeName, [], caseName, fields) - + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.nameResolutionError - let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.PipeExpr = - match d with - | DEnum(_, - _, - [], - "EPipeVariable", - [ DInt64 id; DString varName; DList(_vtTODO, args) ]) -> - PT.EPipeVariable(uint64 id, varName, args |> List.map exprFromDT) - - | DEnum(_, _, [], "EPipeLambda", [ DInt64 id; variables; body ]) -> - let variables = - match variables with - | DList(_vtTODO, pats) -> - pats - |> List.map LetPattern.fromDT - |> NEList.ofListUnsafe - "PT2DT.PipeExpr.fromDT expected at least one bound variable in EPipeLambda" - [] - | _ -> Exception.raiseInternal "Invalid variables" [] - - PT.EPipeLambda(uint64 id, variables, exprFromDT body) - - | DEnum(_, _, [], "EPipeInfix", [ DInt64 id; infix; expr ]) -> - PT.EPipeInfix(uint64 id, Infix.fromDT infix, exprFromDT expr) - - | DEnum(_, - _, - [], - "EPipeFnCall", - [ DInt64 id; fnName; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> - PT.EPipeFnCall( - uint64 id, - NameResolution.fromDT FQFnName.fromDT fnName, - List.map TypeReference.fromDT typeArgs, - List.map exprFromDT args - ) - - | DEnum(_, - _, - [], - "EPipeEnum", - [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> - PT.EPipeEnum( - uint64 id, - NameResolution.fromDT FQTypeName.fromDT typeName, - caseName, - List.map exprFromDT fields - ) - - | _ -> Exception.raiseInternal "Invalid PipeExpr" [] - - -module Expr = - let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.expr let knownType = KTCustomType(typeName, []) - let rec toDT (e : PT.Expr) : Dval = + let toDT (e : PT.NameResolutionError) : Dval = let (caseName, fields) = match e with - | PT.EUnit id -> "EUnit", [ DInt64(int64 id) ] - - // simple data - | PT.EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] - | PT.EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] - | PT.EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] - | PT.EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] - | PT.EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] - | PT.EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] - | PT.EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] - | PT.EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] - | PT.EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] - | PT.EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] - | PT.EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] - | PT.EFloat(id, sign, whole, remainder) -> - "EFloat", - [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] - - | PT.EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] - | PT.EString(id, segments) -> - "EString", - [ DInt64(int64 id) - DList( - VT.known StringSegment.knownType, - List.map (StringSegment.toDT toDT) segments - ) ] - - // structures of data - | PT.EList(id, items) -> - "EList", [ DInt64(int64 id); DList(VT.known knownType, List.map toDT items) ] - - | PT.EDict(id, pairs) -> - "EDict", - [ DInt64(int64 id) - DList( - VT.tuple VT.string (VT.known knownType) [], - pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) - ) ] - - | PT.ETuple(id, first, second, theRest) -> - "ETuple", - [ DInt64(int64 id) - toDT first - toDT second - DList(VT.known knownType, List.map toDT theRest) ] - - | PT.ERecord(id, typeName, fields) -> - let fields = - DList( - VT.tuple VT.string (VT.known knownType) [], - fields - |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) - ) - - "ERecord", - [ DInt64(int64 id) - NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - fields ] - - | PT.EEnum(id, typeName, caseName, fields) -> - "EEnum", - [ DInt64(int64 id) - NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - DString caseName - DList(VT.known knownType, List.map toDT fields) ] - - // declaring and accessing variables - | PT.ELet(id, lp, expr, body) -> - "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - - | PT.ERecordFieldAccess(id, expr, fieldName) -> - "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] - - | PT.EVariable(id, varName) -> - "EVariable", [ DInt64(int64 id); DString varName ] - - - // control flow - | PT.EIf(id, cond, thenExpr, elseExpr) -> - "EIf", - [ DInt64(int64 id) - toDT cond - toDT thenExpr - elseExpr |> Option.map toDT |> Dval.option knownType ] - - | PT.EMatch(id, arg, cases) -> - let matchCaseTypeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchCase - let cases = - cases - |> List.map (fun case -> - - let pattern = MatchPattern.toDT case.pat - let whenCondition = - case.whenCondition |> Option.map toDT |> Dval.option knownType - let expr = toDT case.rhs - DRecord( - matchCaseTypeName, - matchCaseTypeName, - [], - Map - [ ("pat", pattern) - ("whenCondition", whenCondition) - ("rhs", expr) ] - )) - |> Dval.list (KTCustomType(matchCaseTypeName, [])) - - "EMatch", [ DInt64(int64 id); toDT arg; cases ] - - | PT.EPipe(id, expr, pipeExprs) -> - "EPipe", - [ DInt64(int64 id) - toDT expr - DList( - VT.known PipeExpr.knownType, - List.map (PipeExpr.toDT knownType toDT) pipeExprs - ) ] - - - // function calls - | PT.EInfix(id, infix, lhs, rhs) -> - "EInfix", [ DInt64(int64 id); Infix.toDT infix; toDT lhs; toDT rhs ] - - | PT.ELambda(id, pats, body) -> - let variables = - DList( - VT.tuple VT.int64 VT.string [], - pats |> NEList.toList |> List.map LetPattern.toDT - ) - "ELambda", [ DInt64(int64 id); variables; toDT body ] - - | PT.EConstant(id, name) -> - "EConstant", - [ DInt64(int64 id) - NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] - - | PT.EApply(id, name, typeArgs, args) -> - "EApply", - [ DInt64(int64 id) - toDT name - DList( - VT.known TypeReference.knownType, - List.map TypeReference.toDT typeArgs - ) - DList(VT.known knownType, args |> NEList.toList |> List.map toDT) ] - - | PT.EFnName(id, name) -> - "EFnName", - [ DInt64(int64 id) - NameResolution.toDT FQFnName.knownType FQFnName.toDT name ] - - | PT.ERecordUpdate(id, record, updates) -> - let updates = - DList( - VT.tuple VT.string (VT.known knownType) [], - updates - |> NEList.toList - |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) - ) - - "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] - - + | PT.NotFound names -> + "NotFound", [ DList(VT.string, List.map Dval.string names) ] + | PT.InvalidName names -> + "InvalidName", [ DList(VT.string, List.map Dval.string names) ] DEnum(typeName, typeName, [], caseName, fields) - - let rec fromDT (d : Dval) : PT.Expr = + let fromDT (d : Dval) : PT.NameResolutionError = match d with - | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> PT.EUnit(uint64 id) - - // simple data - | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> PT.EBool(uint64 id, b) - | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> PT.EInt64(uint64 id, i) - | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> - PT.EUInt64(uint64 id, i) - | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> PT.EInt8(uint64 id, i) - | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> PT.EUInt8(uint64 id, i) - | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> PT.EInt16(uint64 id, i) - | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> - PT.EUInt16(uint64 id, i) - | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> PT.EInt32(uint64 id, i) - | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> - PT.EUInt32(uint64 id, i) - | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> - PT.EInt128(uint64 id, i) - | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> - PT.EUInt128(uint64 id, i) - | DEnum(_, _, [], "EFloat", [ DInt64 id; sign; DString whole; DString remainder ]) -> - PT.EFloat(uint64 id, Sign.fromDT sign, whole, remainder) - | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> PT.EChar(uint64 id, c) - | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> - PT.EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) - - - // structures of data - | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> - PT.EList(uint64 id, List.map fromDT inner) - | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> - let pairs = - pairsList - |> List.collect (fun pair -> - match pair with - | DTuple(DString k, v, _) -> [ (k, fromDT v) ] - | _ -> []) - PT.EDict(uint64 id, pairs) - - - | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - PT.ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - - | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO, fieldsList) ]) -> - let fields = - fieldsList - |> List.collect (fun field -> - match field with - | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] - | _ -> []) - PT.ERecord(uint64 id, NameResolution.fromDT FQTypeName.fromDT typeName, fields) - - - | DEnum(_, - _, - [], - "EEnum", - [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> - PT.EEnum( - uint64 id, - NameResolution.fromDT FQTypeName.fromDT typeName, - caseName, - List.map fromDT fields - ) - - // declaring and accessing variables - | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> - PT.ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - - | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> - PT.ERecordFieldAccess(uint64 id, fromDT expr, fieldName) - - | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> - PT.EVariable(uint64 id, varName) - - // control flow - | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> - let elseExpr = - match elseExpr with - | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) - | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None - | _ -> - Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] - PT.EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) - - | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> - let (cases : List) = - cases - |> List.collect (fun case -> - match case with - | DRecord(_, _, _, fields) -> - let whenCondition = - match Map.tryFind "whenCondition" fields with - | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) - | Some(DEnum(_, _, _, "None", [])) -> None - | _ -> None - match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with - | Some pat, Some rhs -> - [ { pat = MatchPattern.fromDT pat - whenCondition = whenCondition - rhs = fromDT rhs } ] - | _ -> [] - | _ -> []) - PT.EMatch(uint64 id, fromDT arg, cases) - - | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> - PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) - - // function calls - | DEnum(_, _, [], "EInfix", [ DInt64 id; infix; lhs; rhs ]) -> - PT.EInfix(uint64 id, Infix.fromDT infix, fromDT lhs, fromDT rhs) - - | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> - let pats = - pats - |> List.map LetPattern.fromDT - |> NEList.ofListUnsafe - "PT2DT.Expr.fromDT expected at least one bound variable in ELambda" - [] - PT.ELambda(uint64 id, pats, fromDT body) - - - | DEnum(_, - _, - [], - "EApply", - [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> - PT.EApply( - uint64 id, - fromDT name, - List.map TypeReference.fromDT typeArgs, - args |> NEList.ofListUnsafe "EApply" [] |> NEList.map fromDT - ) - - | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> - PT.EFnName(uint64 id, NameResolution.fromDT FQFnName.fromDT name) - - | DEnum(_, - _, - [], - "ERecordUpdate", - [ DInt64 id; record; DList(_vtTODO, head :: tail) ]) -> - let updates = - NEList.ofList head tail - |> NEList.map (fun update -> - match update with - | DTuple(DString name, expr, _) -> (name, fromDT expr) - | _ -> - Exception.raiseInternal "Invalid record update" [ "update", update ]) - PT.ERecordUpdate(uint64 id, fromDT record, updates) - - | DEnum(_, _, [], "EConstant", [ DInt64 id; name ]) -> - PT.EConstant(uint64 id, NameResolution.fromDT FQConstantName.fromDT name) - - | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] - - -module Const = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.constDef - let knownType = KTCustomType(typeName, []) + | DEnum(_, _, [], "NotFound", [ names ]) -> + PT.NameResolutionError.NotFound(names |> D.list D.string) - let rec toDT (c : PT.Const) : Dval = - let (caseName, fields) = - match c with - | PT.Const.CUnit -> "CUnit", [] - | PT.Const.CBool b -> "CBool", [ DBool b ] - | PT.Const.CInt64 i -> "CInt64", [ DInt64 i ] - | PT.Const.CUInt64 i -> "CUInt64", [ DUInt64 i ] - | PT.Const.CInt8 i -> "CInt8", [ DInt8 i ] - | PT.Const.CUInt8 i -> "CUInt8", [ DUInt8 i ] - | PT.Const.CInt16 i -> "CInt16", [ DInt16 i ] - | PT.Const.CUInt16 i -> "CUInt16", [ DUInt16 i ] - | PT.Const.CInt32 i -> "CInt32", [ DInt32 i ] - | PT.Const.CUInt32 i -> "CUInt32", [ DUInt32 i ] - | PT.Const.CInt128 i -> "CInt128", [ DInt128 i ] - | PT.Const.CUInt128 i -> "CUInt128", [ DUInt128 i ] - | PT.Const.CFloat(sign, w, f) -> - "CFloat", [ Sign.toDT sign; DString w; DString f ] - | PT.Const.CChar c -> "CChar", [ DString c ] - | PT.Const.CString s -> "CString", [ DString s ] - - | PT.Const.CTuple(first, second, theRest) -> - "CTuple", - [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - - | PT.Const.CEnum(typeName, caseName, fields) -> - "CEnum", - [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - DString caseName - Dval.list knownType (List.map toDT fields) ] - - | PT.Const.CList inner -> - "CList", [ DList(VT.known knownType, List.map toDT inner) ] - - | PT.Const.CDict pairs -> - "CDict", - [ DList( - VT.tuple VT.string VT.string [], - pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) - ) ] + | DEnum(_, _, [], "InvalidName", [ names ]) -> + PT.NameResolutionError.InvalidName(names |> D.list D.string) - DEnum(typeName, typeName, [], caseName, fields) + | _ -> Exception.raiseInternal "Invalid NameResolutionError" [] - let rec fromDT (d : Dval) : PT.Const = - match d with - | DEnum(_, _, [], "CInt64", [ DInt64 i ]) -> PT.Const.CInt64 i - | DEnum(_, _, [], "CUInt64", [ DUInt64 i ]) -> PT.Const.CUInt64 i - | DEnum(_, _, [], "CInt8", [ DInt8 i ]) -> PT.Const.CInt8 i - | DEnum(_, _, [], "CUInt8", [ DUInt8 i ]) -> PT.Const.CUInt8 i - | DEnum(_, _, [], "CInt16", [ DInt16 i ]) -> PT.Const.CInt16 i - | DEnum(_, _, [], "CUInt16", [ DUInt16 i ]) -> PT.Const.CUInt16 i - | DEnum(_, _, [], "CInt32", [ DInt32 i ]) -> PT.Const.CInt32 i - | DEnum(_, _, [], "CUInt32", [ DUInt32 i ]) -> PT.Const.CUInt32 i - | DEnum(_, _, [], "CInt128", [ DInt128 i ]) -> PT.Const.CInt128 i - | DEnum(_, _, [], "CUInt128", [ DUInt128 i ]) -> PT.Const.CUInt128 i - | DEnum(_, _, [], "CBool", [ DBool b ]) -> PT.Const.CBool b - | DEnum(_, _, [], "CString", [ DString s ]) -> PT.Const.CString s - | DEnum(_, _, [], "CChar", [ DString c ]) -> PT.Const.CChar c - | DEnum(_, _, [], "CFloat", [ sign; DString w; DString f ]) -> - PT.Const.CFloat(Sign.fromDT sign, w, f) - | DEnum(_, _, [], "CUnit", []) -> PT.Const.CUnit - | DEnum(_, _, [], "CTuple", [ first; second; DList(_vtTODO, rest) ]) -> - PT.Const.CTuple(fromDT first, fromDT second, List.map fromDT rest) - | DEnum(_, _, [], "CEnum", [ typeName; DString caseName; DList(_vtTODO, fields) ]) -> - PT.Const.CEnum( - NameResolution.fromDT FQTypeName.fromDT typeName, - caseName, - List.map fromDT fields - ) - | DEnum(_, _, [], "CList", [ DList(_vtTODO, inner) ]) -> - PT.Const.CList(List.map fromDT inner) - | DEnum(_, _, [], "CDict", [ DList(_vtTODO, pairs) ]) -> - let pairs = - pairs - |> List.map (fun pair -> - match pair with - | DTuple(k, v, _) -> (fromDT k, fromDT v) - | _ -> Exception.raiseInternal "Invalid pair" []) - PT.Const.CDict( - List.map - (fun (k, v) -> - (match k with - | PT.Const.CString s -> s - | _ -> Exception.raiseInternal "Invalid key" []), - v) - pairs - ) - - - | _ -> Exception.raiseInternal "Invalid Const" [] - -module Deprecation = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.deprecation - let knownType = KTCustomType(typeName, []) +module NameResolution = let toDT - (innerType : KnownType) - (inner : 'a -> Dval) - (d : PT.Deprecation<'a>) + (nameValueType : KnownType) + (f : 'p -> Dval) + (result : PT.NameResolution<'p>) : Dval = - let (caseName, fields) = - match d with - | PT.Deprecation.NotDeprecated -> "NotDeprecated", [] - | PT.Deprecation.RenamedTo replacement -> "RenamedTo", [ inner replacement ] - | PT.Deprecation.ReplacedBy replacement -> "ReplacedBy", [ inner replacement ] - | PT.Deprecation.DeprecatedBecause reason -> - "DeprecatedBecause", [ DString reason ] - DEnum( - typeName, - typeName, - Dval.ignoreAndUseEmpty [ VT.known innerType ], - caseName, - fields - ) - - let fromDT (inner : Dval -> 'a) (d : Dval) : PT.Deprecation<'a> = - match d with - | DEnum(_, _, _typeArgsDEnumTODO, "NotDeprecated", []) -> - PT.Deprecation.NotDeprecated - | DEnum(_, _, _typeArgsDEnumTODO, "RenamedTo", [ replacement ]) -> - PT.Deprecation.RenamedTo(inner replacement) - | DEnum(_, _, _typeArgsDEnumTODO, "ReplacedBy", [ replacement ]) -> - PT.Deprecation.ReplacedBy(inner replacement) - | DEnum(_, _, _typeArgsDEnumTODO, "DeprecatedBecause", [ DString reason ]) -> - PT.Deprecation.DeprecatedBecause(reason) - | _ -> Exception.raiseInternal "Invalid Deprecation" [] - - -module TypeDeclaration = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.typeDeclaration - - module RecordField = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.recordField - let knownType = KTCustomType(typeName, []) - - let toDT (rf : PT.TypeDeclaration.RecordField) : Dval = - let fields = - [ "name", DString rf.name - "typ", TypeReference.toDT rf.typ - "description", DString rf.description ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.TypeDeclaration.RecordField = - match d with - | DRecord(_, _, _, fields) -> - { name = fields |> D.stringField "name" - typ = fields |> D.field "typ" |> TypeReference.fromDT - description = fields |> D.stringField "description" } - | _ -> Exception.raiseInternal "Invalid RecordField" [] - - module EnumField = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumField - let knownType = KTCustomType(typeName, []) - - let toDT (ef : PT.TypeDeclaration.EnumField) : Dval = - let fields = - [ "typ", TypeReference.toDT ef.typ - "label", ef.label |> Option.map DString |> Dval.option KTString - "description", DString ef.description ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.TypeDeclaration.EnumField = - match d with - | DRecord(_, _, _, fields) -> - { typ = fields |> D.field "typ" |> TypeReference.fromDT - label = - match Map.get "label" fields with - | Some(DEnum(_, _, _typeArgsDEnumTODO, "Some", [ DString label ])) -> - Some label - | Some(DEnum(_, _, _typeArgsDEnumTODO, "None", [])) -> None - | _ -> - Exception.raiseInternal "Expected label to be an option of string" [] - description = fields |> D.stringField "description" } - | _ -> Exception.raiseInternal "Invalid EnumField" [] - - - module EnumCase = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumCase - let knownType = KTCustomType(typeName, []) - - let toDT (ec : PT.TypeDeclaration.EnumCase) : Dval = - let fields = - [ "name", DString ec.name - "fields", - DList(VT.known EnumField.knownType, List.map EnumField.toDT ec.fields) - "description", DString ec.description ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.TypeDeclaration.EnumCase = - match d with - | DRecord(_, _, _, fields) -> - { name = fields |> D.stringField "name" - fields = fields |> D.listField "fields" |> List.map EnumField.fromDT - description = fields |> D.stringField "description" } - - | _ -> Exception.raiseInternal "Invalid EnumCase" [] - - - module Definition = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.definition - - let toDT (d : PT.TypeDeclaration.Definition) : Dval = - let (caseName, fields) = - match d with - | PT.TypeDeclaration.Alias typeRef -> "Alias", [ TypeReference.toDT typeRef ] - - | PT.TypeDeclaration.Record fields -> - "Record", - [ DList( - VT.known RecordField.knownType, - fields |> NEList.toList |> List.map RecordField.toDT - ) ] - - | PT.TypeDeclaration.Enum cases -> - "Enum", - [ DList( - VT.known EnumCase.knownType, - cases |> NEList.toList |> List.map EnumCase.toDT - ) ] - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.TypeDeclaration.Definition = - match d with - | DEnum(_, _, [], "Alias", [ typeRef ]) -> - PT.TypeDeclaration.Alias(TypeReference.fromDT typeRef) - - | DEnum(_, _, [], "Record", [ DList(_vtTODO, firstField :: additionalFields) ]) -> - PT.TypeDeclaration.Record( - NEList.ofList firstField additionalFields |> NEList.map RecordField.fromDT - ) - - | DEnum(_, _, [], "Enum", [ DList(_vtTODO, firstCase :: additionalCases) ]) -> - PT.TypeDeclaration.Enum( - NEList.ofList firstCase additionalCases |> NEList.map EnumCase.fromDT - ) - - | _ -> Exception.raiseInternal "Invalid TypeDeclaration.Definition" [] - - - let toDT (td : PT.TypeDeclaration.T) : Dval = - let fields = - [ "typeParams", DList(VT.string, List.map DString td.typeParams) - "definition", Definition.toDT td.definition ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.TypeDeclaration.T = - match d with - | DRecord(_, _, _, fields) -> - { typeParams = fields |> D.stringListField "typeParams" - definition = fields |> D.field "definition" |> Definition.fromDT } - | _ -> Exception.raiseInternal "Invalid TypeDeclaration" [] - - -module Handler = - module CronInterval = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.Handler.cronInterval - - let toDT (ci : PT.Handler.CronInterval) : Dval = - let (caseName, fields) = - match ci with - | PT.Handler.CronInterval.EveryMinute -> "EveryMinute", [] - | PT.Handler.CronInterval.EveryHour -> "EveryHour", [] - | PT.Handler.CronInterval.Every12Hours -> "Every12Hours", [] - | PT.Handler.CronInterval.EveryDay -> "EveryDay", [] - | PT.Handler.CronInterval.EveryWeek -> "EveryWeek", [] - | PT.Handler.CronInterval.EveryFortnight -> "EveryFortnight", [] - - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.Handler.CronInterval = - match d with - | DEnum(_, _, [], "EveryMinute", []) -> PT.Handler.CronInterval.EveryMinute - | DEnum(_, _, [], "EveryHour", []) -> PT.Handler.CronInterval.EveryHour - | DEnum(_, _, [], "Every12Hours", []) -> PT.Handler.CronInterval.Every12Hours - | DEnum(_, _, [], "EveryDay", []) -> PT.Handler.CronInterval.EveryDay - | DEnum(_, _, [], "EveryWeek", []) -> PT.Handler.CronInterval.EveryWeek - | DEnum(_, _, [], "EveryFortnight", []) -> - PT.Handler.CronInterval.EveryFortnight - | _ -> Exception.raiseInternal "Invalid CronInterval" [] - - - module Spec = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.Handler.spec - - let toDT (s : PT.Handler.Spec) : Dval = - let (caseName, fields) = - match s with - | PT.Handler.Spec.HTTP(route, method) -> - "HTTP", [ DString route; DString method ] - | PT.Handler.Spec.Worker name -> "Worker", [ DString name ] - | PT.Handler.Spec.Cron(name, interval) -> - "Cron", [ DString name; CronInterval.toDT interval ] - | PT.Handler.Spec.REPL name -> "REPL", [ DString name ] - - DEnum(typeName, typeName, [], caseName, fields) - - let fromDT (d : Dval) : PT.Handler.Spec = - match d with - | DEnum(_, _, [], "HTTP", [ DString route; DString method ]) -> - PT.Handler.Spec.HTTP(route, method) - | DEnum(_, _, [], "Worker", [ DString name ]) -> PT.Handler.Spec.Worker(name) - | DEnum(_, _, [], "Cron", [ DString name; interval ]) -> - PT.Handler.Spec.Cron(name, CronInterval.fromDT interval) - | DEnum(_, _, [], "REPL", [ DString name ]) -> PT.Handler.Spec.REPL(name) - | _ -> Exception.raiseInternal "Invalid Spec" [] - - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.Handler.handler - - let toDT (h : PT.Handler.T) : Dval = - let fields = - [ "tlid", DUInt64(uint64 h.tlid) - "ast", Expr.toDT h.ast - "spec", Spec.toDT h.spec ] - DRecord(typeName, typeName, [], Map fields) - - - let fromDT (d : Dval) : PT.Handler.T = - match d with - | DRecord(_, _, _, fields) -> - { tlid = fields |> D.uint64Field "tlid" - ast = fields |> D.field "ast" |> Expr.fromDT - spec = fields |> D.field "spec" |> Spec.fromDT } - | _ -> Exception.raiseInternal "Invalid Handler" [] - - -module DB = - let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.db - - let toDT (db : PT.DB.T) : Dval = - let fields = - [ "tlid", DUInt64(uint64 db.tlid) - "name", DString db.name - "version", DInt64 db.version - "typ", TypeReference.toDT db.typ ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.DB.T = - match d with - | DRecord(_, _, _, fields) -> - { tlid = fields |> D.uint64Field "tlid" - name = fields |> D.stringField "name" - version = fields |> D.intField "version" - typ = fields |> D.field "typ" |> TypeReference.fromDT } - | _ -> Exception.raiseInternal "Invalid DB" [] - - -module Secret = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.secret - - let toDT (s : PT.Secret.T) : Dval = - let fields = - [ "name", DString s.name - "value", DString s.value - "version", DInt64 s.version ] - DRecord(typeName, typeName, [], Map fields) + C2DT.Result.toDT + nameValueType + NameResolutionError.knownType + result + f + NameResolutionError.toDT - let fromDT (d : Dval) : PT.Secret.T = - match d with - | DRecord(_, _, _, fields) -> - { name = fields |> D.stringField "name" - value = fields |> D.stringField "value" - version = fields |> D.intField "version" } - | _ -> Exception.raiseInternal "Invalid Secret" [] - - -module PackageType = - module Name = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.name - - let toDT (n : PT.PackageType.Name) : Dval = - let fields = - [ "owner", DString n.owner - "modules", DList(VT.string, List.map DString n.modules) - "name", DString n.name ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.PackageType.Name = - match d with - | DRecord(_, _, _, fields) -> - { owner = fields |> D.stringField "owner" - modules = fields |> D.stringListField "modules" - name = fields |> D.stringField "name" } - | _ -> Exception.raiseInternal "Invalid PackageType.Name" [] - - - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.packageType - - let toDT (p : PT.PackageType.PackageType) : Dval = - let fields = - [ "id", DUuid p.id - "name", Name.toDT p.name - "declaration", TypeDeclaration.toDT p.declaration - "description", DString p.description - "deprecated", - Deprecation.toDT FQTypeName.knownType FQTypeName.toDT p.deprecated ] - DRecord(typeName, typeName, [], Map fields) - - - let fromDT (d : Dval) : PT.PackageType.PackageType = - match d with - | DRecord(_, _, _, fields) -> - { id = fields |> D.uuidField "id" - name = fields |> D.field "name" |> Name.fromDT - declaration = fields |> D.field "declaration" |> TypeDeclaration.fromDT - description = fields |> D.stringField "description" - deprecated = - fields |> D.field "deprecated" |> Deprecation.fromDT FQTypeName.fromDT } - | _ -> Exception.raiseInternal "Invalid PackageType" [] - - -module PackageConstant = - module Name = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.name - - let toDT (n : PT.PackageConstant.Name) : Dval = - let fields = - [ "owner", DString n.owner - "modules", DList(VT.string, List.map DString n.modules) - "name", DString n.name ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.PackageConstant.Name = - match d with - | DRecord(_, _, _, fields) -> - { owner = fields |> D.stringField "owner" - modules = fields |> D.stringListField "modules" - name = fields |> D.stringField "name" } - | _ -> Exception.raiseInternal "Invalid PackageConstant.Name" [] - - - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.packageConstant - - let toDT (p : PT.PackageConstant.PackageConstant) : Dval = - let fields = - [ "id", DUuid p.id - "name", Name.toDT p.name - "body", Const.toDT p.body - "description", DString p.description - "deprecated", - Deprecation.toDT FQConstantName.knownType FQConstantName.toDT p.deprecated ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.PackageConstant.PackageConstant = - match d with - | DRecord(_, _, _, fields) -> - { id = fields |> D.uuidField "id" - name = fields |> D.field "name" |> Name.fromDT - body = fields |> D.field "body" |> Const.fromDT - description = fields |> D.stringField "description" - deprecated = - fields |> D.field "deprecated" |> Deprecation.fromDT FQConstantName.fromDT } - | _ -> Exception.raiseInternal "Invalid PackageConstant" [] - - -module PackageFn = - module Name = - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.name - - let toDT (n : PT.PackageFn.Name) : Dval = - let fields = - [ "owner", DString n.owner - "modules", DList(VT.string, List.map DString n.modules) - "name", DString n.name ] - DRecord(typeName, typeName, [], Map fields) - - let fromDT (d : Dval) : PT.PackageFn.Name = - match d with - | DRecord(_, _, _, fields) -> - { owner = fields |> D.stringField "owner" - modules = fields |> D.stringListField "modules" - name = fields |> D.stringField "name" } - | _ -> Exception.raiseInternal "Invalid PackageFn.Name" [] - - - module Parameter = - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.parameter - - let knownType = KTCustomType(typeName, []) - - let toDT (p : PT.PackageFn.Parameter) : Dval = - let fields = - [ "name", DString p.name - "typ", TypeReference.toDT p.typ - "description", DString p.description ] - DRecord(typeName, typeName, [], Map fields) - - - let fromDT (d : Dval) : PT.PackageFn.Parameter = - match d with - | DRecord(_, _, _, fields) -> - { name = fields |> D.stringField "name" - typ = fields |> D.field "typ" |> TypeReference.fromDT - description = fields |> D.stringField "description" } - | _ -> Exception.raiseInternal "Invalid PackageFn.Parameter" [] - - - let typeName = - FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.packageFn - - let toDT (p : PT.PackageFn.PackageFn) : Dval = - let fields = - [ ("id", DUuid p.id) - ("name", Name.toDT p.name) - ("body", Expr.toDT p.body) - ("typeParams", DList(VT.string, List.map DString p.typeParams)) - ("parameters", - DList( - VT.known Parameter.knownType, - p.parameters |> NEList.toList |> List.map Parameter.toDT - )) - ("returnType", TypeReference.toDT p.returnType) - ("description", DString p.description) - ("deprecated", Deprecation.toDT FQFnName.knownType FQFnName.toDT p.deprecated) ] - - DRecord(typeName, typeName, [], Map fields) - - - let fromDT (d : Dval) : PT.PackageFn.PackageFn = - match d with - | DRecord(_, _, _, fields) -> - { id = fields |> D.uuidField "id" - name = fields |> D.field "name" |> Name.fromDT - body = fields |> D.field "body" |> Expr.fromDT - typeParams = fields |> D.stringListField "typeParams" - parameters = - fields - |> D.listField "parameters" - |> List.map Parameter.fromDT - |> NEList.ofListUnsafe "PackageFn.fromDT" [] - returnType = fields |> D.field "returnType" |> TypeReference.fromDT - description = fields |> D.stringField "description" - deprecated = - fields |> D.field "deprecated" |> Deprecation.fromDT FQFnName.fromDT } - | _ -> Exception.raiseInternal "Invalid PackageFn" [] + let fromDT (f : Dval -> 'a) (d : Dval) : PT.NameResolution<'a> = + C2DT.Result.fromDT f d NameResolutionError.fromDT + + +// module TypeReference = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.typeReference +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (t : PT.TypeReference) : Dval = +// let (caseName, fields) = +// match t with +// | PT.TVariable name -> "TVariable", [ DString name ] + +// | PT.TUnit -> "TUnit", [] +// | PT.TBool -> "TBool", [] +// | PT.TInt8 -> "TInt8", [] +// | PT.TUInt8 -> "TUInt8", [] +// | PT.TInt16 -> "TInt16", [] +// | PT.TUInt16 -> "TUInt16", [] +// | PT.TInt32 -> "TInt32", [] +// | PT.TUInt32 -> "TUInt32", [] +// | PT.TInt64 -> "TInt64", [] +// | PT.TUInt64 -> "TUInt64", [] +// | PT.TInt128 -> "TInt128", [] +// | PT.TUInt128 -> "TUInt128", [] +// | PT.TFloat -> "TFloat", [] +// | PT.TChar -> "TChar", [] +// | PT.TString -> "TString", [] +// | PT.TDateTime -> "TDateTime", [] +// | PT.TUuid -> "TUuid", [] + +// | PT.TList inner -> "TList", [ toDT inner ] + +// | PT.TTuple(first, second, theRest) -> +// "TTuple", +// [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] + +// | PT.TDict inner -> "TDict", [ toDT inner ] + +// | PT.TCustomType(typeName, typeArgs) -> +// "TCustomType", +// [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName +// DList(VT.known knownType, List.map toDT typeArgs) ] + +// | PT.TDB inner -> "TDB", [ toDT inner ] + +// | PT.TFn(args, ret) -> +// "TFn", +// [ DList(VT.known knownType, args |> NEList.toList |> List.map toDT) +// toDT ret ] + +// DEnum(typeName, typeName, [], caseName, fields) + +// let rec fromDT (d : Dval) : PT.TypeReference = +// match d with +// | DEnum(_, _, [], "TVariable", [ DString name ]) -> PT.TVariable(name) + +// | DEnum(_, _, [], "TUnit", []) -> PT.TUnit +// | DEnum(_, _, [], "TBool", []) -> PT.TBool +// | DEnum(_, _, [], "TInt64", []) -> PT.TInt64 +// | DEnum(_, _, [], "TUInt64", []) -> PT.TUInt64 +// | DEnum(_, _, [], "TInt8", []) -> PT.TInt8 +// | DEnum(_, _, [], "TUInt8", []) -> PT.TUInt8 +// | DEnum(_, _, [], "TInt16", []) -> PT.TInt16 +// | DEnum(_, _, [], "TUInt16", []) -> PT.TUInt16 +// | DEnum(_, _, [], "TInt32", []) -> PT.TInt32 +// | DEnum(_, _, [], "TUInt32", []) -> PT.TUInt32 +// | DEnum(_, _, [], "TInt128", []) -> PT.TInt128 +// | DEnum(_, _, [], "TUInt128", []) -> PT.TUInt128 +// | DEnum(_, _, [], "TFloat", []) -> PT.TFloat +// | DEnum(_, _, [], "TChar", []) -> PT.TChar +// | DEnum(_, _, [], "TString", []) -> PT.TString +// | DEnum(_, _, [], "TDateTime", []) -> PT.TDateTime +// | DEnum(_, _, [], "TUuid", []) -> PT.TUuid + +// | DEnum(_, _, [], "TList", [ inner ]) -> PT.TList(fromDT inner) + +// | DEnum(_, _, [], "TTuple", [ first; second; DList(_vtTODO, theRest) ]) -> +// PT.TTuple(fromDT first, fromDT second, List.map fromDT theRest) + +// | DEnum(_, _, [], "TDict", [ inner ]) -> PT.TDict(fromDT inner) + +// | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> +// PT.TCustomType( +// NameResolution.fromDT FQTypeName.fromDT typeName, +// List.map fromDT typeArgs +// ) + +// | DEnum(_, _, [], "TDB", [ inner ]) -> PT.TDB(fromDT inner) +// | DEnum(_, _, [], "TFn", [ DList(_vtTODO, head :: tail); ret ]) -> +// PT.TFn(NEList.ofList head tail |> NEList.map fromDT, fromDT ret) +// | _ -> Exception.raiseInternal "Invalid TypeReference" [] + + +// module LetPattern = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.letPattern +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (p : PT.LetPattern) : Dval = +// let (caseName, fields) = +// match p with +// | PT.LPVariable(id, name) -> "LPVariable", [ DInt64(int64 id); DString name ] +// | PT.LPUnit id -> "LPUnit", [ DInt64(int64 id) ] +// | PT.LPTuple(id, first, second, theRest) -> +// "LPTuple", +// [ DInt64(int64 id) +// toDT first +// toDT second +// DList(VT.known knownType, List.map toDT theRest) ] + +// DEnum(typeName, typeName, [], caseName, fields) + + +// let rec fromDT (d : Dval) : PT.LetPattern = +// match d with +// | DEnum(_, _, [], "LPVariable", [ DInt64 id; DString name ]) -> +// PT.LPVariable(uint64 id, name) +// | DEnum(_, _, [], "LPUnit", [ DInt64 id ]) -> PT.LPUnit(uint64 id) +// | DEnum(_, +// _, +// [], +// "LPTuple", +// [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> +// PT.LPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) +// | _ -> Exception.raiseInternal "Invalid LetPattern" [] + + +// module MatchPattern = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchPattern +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (p : PT.MatchPattern) : Dval = +// let (caseName, fields) = +// match p with +// | PT.MPVariable(id, name) -> "MPVariable", [ DInt64(int64 id); DString name ] + +// | PT.MPUnit id -> "MPUnit", [ DInt64(int64 id) ] +// | PT.MPBool(id, b) -> "MPBool", [ DInt64(int64 id); DBool b ] +// | PT.MPInt64(id, i) -> "MPInt64", [ DInt64(int64 id); DInt64 i ] +// | PT.MPUInt64(id, i) -> "MPUInt64", [ DInt64(int64 id); DUInt64 i ] +// | PT.MPInt8(id, i) -> "MPInt8", [ DInt64(int64 id); DInt8 i ] +// | PT.MPUInt8(id, i) -> "MPUInt8", [ DInt64(int64 id); DUInt8 i ] +// | PT.MPInt16(id, i) -> "MPInt16", [ DInt64(int64 id); DInt16 i ] +// | PT.MPUInt16(id, i) -> "MPUInt16", [ DInt64(int64 id); DUInt16 i ] +// | PT.MPInt32(id, i) -> "MPInt32", [ DInt64(int64 id); DInt32 i ] +// | PT.MPUInt32(id, i) -> "MPUInt32", [ DInt64(int64 id); DUInt32 i ] +// | PT.MPInt128(id, i) -> "MPInt128", [ DInt64(int64 id); DInt128 i ] +// | PT.MPUInt128(id, i) -> "MPUInt128", [ DInt64(int64 id); DUInt128 i ] +// | PT.MPFloat(id, sign, whole, remainder) -> + +// "MPFloat", +// [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] +// | PT.MPChar(id, c) -> "MPChar", [ DInt64(int64 id); DString c ] +// | PT.MPString(id, s) -> "MPString", [ DInt64(int64 id); DString s ] + +// | PT.MPList(id, inner) -> +// "MPList", +// [ DInt64(int64 id); DList(VT.known knownType, List.map toDT inner) ] +// | PT.MPListCons(id, head, tail) -> +// "MPListCons", [ DInt64(int64 id); toDT head; toDT tail ] +// | PT.MPTuple(id, first, second, theRest) -> +// "MPTuple", +// [ DInt64(int64 id) +// toDT first +// toDT second +// DList(VT.known knownType, List.map toDT theRest) ] +// | PT.MPEnum(id, caseName, fieldPats) -> +// "MPEnum", +// [ DInt64(int64 id) +// DString caseName +// DList(VT.known knownType, List.map toDT fieldPats) ] + +// DEnum(typeName, typeName, [], caseName, fields) + +// let rec fromDT (d : Dval) : PT.MatchPattern = +// match d with +// | DEnum(_, _, [], "MPVariable", [ DInt64 id; DString name ]) -> +// PT.MPVariable(uint64 id, name) + +// | DEnum(_, _, [], "MPUnit", [ DInt64 id ]) -> PT.MPUnit(uint64 id) +// | DEnum(_, _, [], "MPBool", [ DInt64 id; DBool b ]) -> PT.MPBool(uint64 id, b) +// | DEnum(_, _, [], "MPInt64", [ DInt64 id; DInt64 i ]) -> PT.MPInt64(uint64 id, i) +// | DEnum(_, _, [], "MPUInt64", [ DInt64 id; DUInt64 i ]) -> +// PT.MPUInt64(uint64 id, i) +// | DEnum(_, _, [], "MPInt8", [ DInt64 id; DInt8 i ]) -> PT.MPInt8(uint64 id, i) +// | DEnum(_, _, [], "MPUInt8", [ DInt64 id; DUInt8 i ]) -> PT.MPUInt8(uint64 id, i) +// | DEnum(_, _, [], "MPInt16", [ DInt64 id; DInt16 i ]) -> PT.MPInt16(uint64 id, i) +// | DEnum(_, _, [], "MPUInt16", [ DInt64 id; DUInt16 i ]) -> +// PT.MPUInt16(uint64 id, i) +// | DEnum(_, _, [], "MPInt32", [ DInt64 id; DInt32 i ]) -> PT.MPInt32(uint64 id, i) +// | DEnum(_, _, [], "MPUInt32", [ DInt64 id; DUInt32 i ]) -> +// PT.MPUInt32(uint64 id, i) +// | DEnum(_, _, [], "MPInt128", [ DInt64 id; DInt128 i ]) -> +// PT.MPInt128(uint64 id, i) +// | DEnum(_, _, [], "MPUInt128", [ DInt64 id; DUInt128 i ]) -> +// PT.MPUInt128(uint64 id, i) +// | DEnum(_, +// _, +// [], +// "MPFloat", +// [ DInt64 id; sign; DString whole; DString remainder ]) -> +// PT.MPFloat(uint64 id, Sign.fromDT sign, whole, remainder) +// | DEnum(_, _, [], "MPChar", [ DInt64 id; DString c ]) -> PT.MPChar(uint64 id, c) +// | DEnum(_, _, [], "MPString", [ DInt64 id; DString s ]) -> +// PT.MPString(uint64 id, s) + +// | DEnum(_, _, [], "MPList", [ DInt64 id; DList(_vtTODO, inner) ]) -> +// PT.MPList(uint64 id, List.map fromDT inner) +// | DEnum(_, _, [], "MPListCons", [ DInt64 id; head; tail ]) -> +// PT.MPListCons(uint64 id, fromDT head, fromDT tail) +// | DEnum(_, +// _, +// [], +// "MPTuple", +// [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> +// PT.MPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) +// | DEnum(_, +// _, +// [], +// "MPEnum", +// [ DInt64 id; DString caseName; DList(_vtTODO, fieldPats) ]) -> +// PT.MPEnum(uint64 id, caseName, List.map fromDT fieldPats) +// | _ -> Exception.raiseInternal "Invalid MatchPattern" [] + + +// module BinaryOperation = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.binaryOperation + +// let toDT (b : PT.BinaryOperation) : Dval = +// let (caseName, fields) = +// match b with +// | PT.BinOpAnd -> "BinOpAnd", [] +// | PT.BinOpOr -> "BinOpOr", [] +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.BinaryOperation = +// match d with +// | DEnum(_, _, [], "BinOpAnd", []) -> PT.BinOpAnd +// | DEnum(_, _, [], "BinOpOr", []) -> PT.BinOpOr +// | _ -> Exception.raiseInternal "Invalid BinaryOperation" [] + + +// module InfixFnName = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infixFnName + +// let toDT (i : PT.InfixFnName) : Dval = +// let (caseName, fields) = +// match i with +// | PT.ArithmeticPlus -> "ArithmeticPlus", [] +// | PT.ArithmeticMinus -> "ArithmeticMinus", [] +// | PT.ArithmeticMultiply -> "ArithmeticMultiply", [] +// | PT.ArithmeticDivide -> "ArithmeticDivide", [] +// | PT.ArithmeticModulo -> "ArithmeticModulo", [] +// | PT.ArithmeticPower -> "ArithmeticPower", [] +// | PT.ComparisonGreaterThan -> "ComparisonGreaterThan", [] +// | PT.ComparisonGreaterThanOrEqual -> "ComparisonGreaterThanOrEqual", [] +// | PT.ComparisonLessThan -> "ComparisonLessThan", [] +// | PT.ComparisonLessThanOrEqual -> "ComparisonLessThanOrEqual", [] +// | PT.ComparisonEquals -> "ComparisonEquals", [] +// | PT.ComparisonNotEquals -> "ComparisonNotEquals", [] +// | PT.StringConcat -> "StringConcat", [] + +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.InfixFnName = +// match d with +// | DEnum(_, _, [], "ArithmeticPlus", []) -> PT.ArithmeticPlus +// | DEnum(_, _, [], "ArithmeticMinus", []) -> PT.ArithmeticMinus +// | DEnum(_, _, [], "ArithmeticMultiply", []) -> PT.ArithmeticMultiply +// | DEnum(_, _, [], "ArithmeticDivide", []) -> PT.ArithmeticDivide +// | DEnum(_, _, [], "ArithmeticModulo", []) -> PT.ArithmeticModulo +// | DEnum(_, _, [], "ArithmeticPower", []) -> PT.ArithmeticPower +// | DEnum(_, _, [], "ComparisonGreaterThan", []) -> PT.ComparisonGreaterThan +// | DEnum(_, _, [], "ComparisonGreaterThanOrEqual", []) -> +// PT.ComparisonGreaterThanOrEqual +// | DEnum(_, _, [], "ComparisonLessThan", []) -> PT.ComparisonLessThan +// | DEnum(_, _, [], "ComparisonLessThanOrEqual", []) -> +// PT.ComparisonLessThanOrEqual +// | DEnum(_, _, [], "ComparisonEquals", []) -> PT.ComparisonEquals +// | DEnum(_, _, [], "ComparisonNotEquals", []) -> PT.ComparisonNotEquals +// | DEnum(_, _, [], "StringConcat", []) -> PT.StringConcat +// | _ -> Exception.raiseInternal "Invalid InfixFnName" [] + + +// module Infix = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infix + +// let toDT (i : PT.Infix) : Dval = +// let (caseName, fields) = +// match i with +// | PT.InfixFnCall infixFnName -> "InfixFnCall", [ InfixFnName.toDT infixFnName ] +// | PT.BinOp binOp -> "BinOp", [ BinaryOperation.toDT binOp ] +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.Infix = +// match d with +// | DEnum(_, _, [], "InfixFnCall", [ infixFnName ]) -> +// PT.InfixFnCall(InfixFnName.fromDT infixFnName) +// | DEnum(_, _, [], "BinOp", [ binOp ]) -> PT.BinOp(BinaryOperation.fromDT binOp) +// | _ -> Exception.raiseInternal "Invalid Infix" [] + + +// module StringSegment = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.stringSegment +// let knownType = KTCustomType(typeName, []) + +// let toDT (exprToDT : PT.Expr -> Dval) (s : PT.StringSegment) : Dval = +// let (caseName, fields) = +// match s with +// | PT.StringText text -> "StringText", [ DString text ] +// | PT.StringInterpolation expr -> "StringInterpolation", [ exprToDT expr ] +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.StringSegment = +// match d with +// | DEnum(_, _, [], "StringText", [ DString text ]) -> PT.StringText text +// | DEnum(_, _, [], "StringInterpolation", [ expr ]) -> +// PT.StringInterpolation(exprFromDT expr) +// | _ -> Exception.raiseInternal "Invalid StringSegment" [] + + +// module PipeExpr = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.pipeExpr +// let knownType = KTCustomType(typeName, []) + +// let toDT +// (exprKT : KnownType) +// (exprToDT : PT.Expr -> Dval) +// (s : PT.PipeExpr) +// : Dval = +// let (caseName, fields) = +// match s with +// | PT.EPipeVariable(id, varName, exprs) -> +// "EPipeVariable", +// [ DInt64(int64 id) +// DString varName +// DList(VT.known exprKT, List.map exprToDT exprs) ] + +// | PT.EPipeLambda(id, args, body) -> +// let variables = +// args +// |> NEList.toList +// |> List.map LetPattern.toDT +// |> Dval.list (KTTuple(VT.int64, VT.string, [])) +// "EPipeLambda", [ DInt64(int64 id); variables; exprToDT body ] + +// | PT.EPipeInfix(id, infix, expr) -> +// "EPipeInfix", [ DInt64(int64 id); Infix.toDT infix; exprToDT expr ] + +// | PT.EPipeFnCall(id, fnName, typeArgs, args) -> +// "EPipeFnCall", +// [ DInt64(int64 id) +// NameResolution.toDT FQFnName.knownType FQFnName.toDT fnName +// DList( +// VT.known TypeReference.knownType, +// List.map TypeReference.toDT typeArgs +// ) +// DList(VT.known exprKT, List.map exprToDT args) ] + +// | PT.EPipeEnum(id, typeName, caseName, fields) -> +// "EPipeEnum", +// [ DInt64(int64 id) +// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName +// DString caseName +// DList(VT.known exprKT, List.map exprToDT fields) ] + +// DEnum(typeName, typeName, [], caseName, fields) + + +// let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.PipeExpr = +// match d with +// | DEnum(_, +// _, +// [], +// "EPipeVariable", +// [ DInt64 id; DString varName; DList(_vtTODO, args) ]) -> +// PT.EPipeVariable(uint64 id, varName, args |> List.map exprFromDT) + +// | DEnum(_, _, [], "EPipeLambda", [ DInt64 id; variables; body ]) -> +// let variables = +// match variables with +// | DList(_vtTODO, pats) -> +// pats +// |> List.map LetPattern.fromDT +// |> NEList.ofListUnsafe +// "PT2DT.PipeExpr.fromDT expected at least one bound variable in EPipeLambda" +// [] +// | _ -> Exception.raiseInternal "Invalid variables" [] + +// PT.EPipeLambda(uint64 id, variables, exprFromDT body) + +// | DEnum(_, _, [], "EPipeInfix", [ DInt64 id; infix; expr ]) -> +// PT.EPipeInfix(uint64 id, Infix.fromDT infix, exprFromDT expr) + +// | DEnum(_, +// _, +// [], +// "EPipeFnCall", +// [ DInt64 id; fnName; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> +// PT.EPipeFnCall( +// uint64 id, +// NameResolution.fromDT FQFnName.fromDT fnName, +// List.map TypeReference.fromDT typeArgs, +// List.map exprFromDT args +// ) + +// | DEnum(_, +// _, +// [], +// "EPipeEnum", +// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> +// PT.EPipeEnum( +// uint64 id, +// NameResolution.fromDT FQTypeName.fromDT typeName, +// caseName, +// List.map exprFromDT fields +// ) + +// | _ -> Exception.raiseInternal "Invalid PipeExpr" [] + + +// module Expr = +// let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.expr +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (e : PT.Expr) : Dval = +// let (caseName, fields) = +// match e with +// | PT.EUnit id -> "EUnit", [ DInt64(int64 id) ] + +// // simple data +// | PT.EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] +// | PT.EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] +// | PT.EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] +// | PT.EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] +// | PT.EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] +// | PT.EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] +// | PT.EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] +// | PT.EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] +// | PT.EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] +// | PT.EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] +// | PT.EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] +// | PT.EFloat(id, sign, whole, remainder) -> +// "EFloat", +// [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] + +// | PT.EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] +// | PT.EString(id, segments) -> +// "EString", +// [ DInt64(int64 id) +// DList( +// VT.known StringSegment.knownType, +// List.map (StringSegment.toDT toDT) segments +// ) ] + +// // structures of data +// | PT.EList(id, items) -> +// "EList", [ DInt64(int64 id); DList(VT.known knownType, List.map toDT items) ] + +// | PT.EDict(id, pairs) -> +// "EDict", +// [ DInt64(int64 id) +// DList( +// VT.tuple VT.string (VT.known knownType) [], +// pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) +// ) ] + +// | PT.ETuple(id, first, second, theRest) -> +// "ETuple", +// [ DInt64(int64 id) +// toDT first +// toDT second +// DList(VT.known knownType, List.map toDT theRest) ] + +// | PT.ERecord(id, typeName, fields) -> +// let fields = +// DList( +// VT.tuple VT.string (VT.known knownType) [], +// fields +// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) +// ) + +// "ERecord", +// [ DInt64(int64 id) +// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName +// fields ] + +// | PT.EEnum(id, typeName, caseName, fields) -> +// "EEnum", +// [ DInt64(int64 id) +// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName +// DString caseName +// DList(VT.known knownType, List.map toDT fields) ] + +// // declaring and accessing variables +// | PT.ELet(id, lp, expr, body) -> +// "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] + +// | PT.ERecordFieldAccess(id, expr, fieldName) -> +// "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] + +// | PT.EVariable(id, varName) -> +// "EVariable", [ DInt64(int64 id); DString varName ] + + +// // control flow +// | PT.EIf(id, cond, thenExpr, elseExpr) -> +// "EIf", +// [ DInt64(int64 id) +// toDT cond +// toDT thenExpr +// elseExpr |> Option.map toDT |> Dval.option knownType ] + +// | PT.EMatch(id, arg, cases) -> +// let matchCaseTypeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchCase +// let cases = +// cases +// |> List.map (fun case -> + +// let pattern = MatchPattern.toDT case.pat +// let whenCondition = +// case.whenCondition |> Option.map toDT |> Dval.option knownType +// let expr = toDT case.rhs +// DRecord( +// matchCaseTypeName, +// matchCaseTypeName, +// [], +// Map +// [ ("pat", pattern) +// ("whenCondition", whenCondition) +// ("rhs", expr) ] +// )) +// |> Dval.list (KTCustomType(matchCaseTypeName, [])) + +// "EMatch", [ DInt64(int64 id); toDT arg; cases ] + +// | PT.EPipe(id, expr, pipeExprs) -> +// "EPipe", +// [ DInt64(int64 id) +// toDT expr +// DList( +// VT.known PipeExpr.knownType, +// List.map (PipeExpr.toDT knownType toDT) pipeExprs +// ) ] + + +// // function calls +// | PT.EInfix(id, infix, lhs, rhs) -> +// "EInfix", [ DInt64(int64 id); Infix.toDT infix; toDT lhs; toDT rhs ] + +// | PT.ELambda(id, pats, body) -> +// let variables = +// DList( +// VT.tuple VT.int64 VT.string [], +// pats |> NEList.toList |> List.map LetPattern.toDT +// ) +// "ELambda", [ DInt64(int64 id); variables; toDT body ] + +// | PT.EConstant(id, name) -> +// "EConstant", +// [ DInt64(int64 id) +// NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] + +// | PT.EApply(id, name, typeArgs, args) -> +// "EApply", +// [ DInt64(int64 id) +// toDT name +// DList( +// VT.known TypeReference.knownType, +// List.map TypeReference.toDT typeArgs +// ) +// DList(VT.known knownType, args |> NEList.toList |> List.map toDT) ] + +// | PT.EFnName(id, name) -> +// "EFnName", +// [ DInt64(int64 id) +// NameResolution.toDT FQFnName.knownType FQFnName.toDT name ] + +// | PT.ERecordUpdate(id, record, updates) -> +// let updates = +// DList( +// VT.tuple VT.string (VT.known knownType) [], +// updates +// |> NEList.toList +// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) +// ) + +// "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] + + +// DEnum(typeName, typeName, [], caseName, fields) + + +// let rec fromDT (d : Dval) : PT.Expr = +// match d with +// | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> PT.EUnit(uint64 id) + +// // simple data +// | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> PT.EBool(uint64 id, b) +// | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> PT.EInt64(uint64 id, i) +// | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> +// PT.EUInt64(uint64 id, i) +// | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> PT.EInt8(uint64 id, i) +// | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> PT.EUInt8(uint64 id, i) +// | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> PT.EInt16(uint64 id, i) +// | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> +// PT.EUInt16(uint64 id, i) +// | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> PT.EInt32(uint64 id, i) +// | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> +// PT.EUInt32(uint64 id, i) +// | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> +// PT.EInt128(uint64 id, i) +// | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> +// PT.EUInt128(uint64 id, i) +// | DEnum(_, _, [], "EFloat", [ DInt64 id; sign; DString whole; DString remainder ]) -> +// PT.EFloat(uint64 id, Sign.fromDT sign, whole, remainder) +// | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> PT.EChar(uint64 id, c) +// | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> +// PT.EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) + + +// // structures of data +// | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> +// PT.EList(uint64 id, List.map fromDT inner) +// | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> +// let pairs = +// pairsList +// |> List.collect (fun pair -> +// match pair with +// | DTuple(DString k, v, _) -> [ (k, fromDT v) ] +// | _ -> []) +// PT.EDict(uint64 id, pairs) + + +// | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> +// PT.ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + +// | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO, fieldsList) ]) -> +// let fields = +// fieldsList +// |> List.collect (fun field -> +// match field with +// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] +// | _ -> []) +// PT.ERecord(uint64 id, NameResolution.fromDT FQTypeName.fromDT typeName, fields) + + +// | DEnum(_, +// _, +// [], +// "EEnum", +// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> +// PT.EEnum( +// uint64 id, +// NameResolution.fromDT FQTypeName.fromDT typeName, +// caseName, +// List.map fromDT fields +// ) + +// // declaring and accessing variables +// | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> +// PT.ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) + +// | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> +// PT.ERecordFieldAccess(uint64 id, fromDT expr, fieldName) + +// | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> +// PT.EVariable(uint64 id, varName) + +// // control flow +// | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> +// let elseExpr = +// match elseExpr with +// | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) +// | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None +// | _ -> +// Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] +// PT.EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) + +// | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> +// let (cases : List) = +// cases +// |> List.collect (fun case -> +// match case with +// | DRecord(_, _, _, fields) -> +// let whenCondition = +// match Map.tryFind "whenCondition" fields with +// | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) +// | Some(DEnum(_, _, _, "None", [])) -> None +// | _ -> None +// match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with +// | Some pat, Some rhs -> +// [ { pat = MatchPattern.fromDT pat +// whenCondition = whenCondition +// rhs = fromDT rhs } ] +// | _ -> [] +// | _ -> []) +// PT.EMatch(uint64 id, fromDT arg, cases) + +// | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> +// PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) + +// // function calls +// | DEnum(_, _, [], "EInfix", [ DInt64 id; infix; lhs; rhs ]) -> +// PT.EInfix(uint64 id, Infix.fromDT infix, fromDT lhs, fromDT rhs) + +// | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> +// let pats = +// pats +// |> List.map LetPattern.fromDT +// |> NEList.ofListUnsafe +// "PT2DT.Expr.fromDT expected at least one bound variable in ELambda" +// [] +// PT.ELambda(uint64 id, pats, fromDT body) + + +// | DEnum(_, +// _, +// [], +// "EApply", +// [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> +// PT.EApply( +// uint64 id, +// fromDT name, +// List.map TypeReference.fromDT typeArgs, +// args |> NEList.ofListUnsafe "EApply" [] |> NEList.map fromDT +// ) + +// | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> +// PT.EFnName(uint64 id, NameResolution.fromDT FQFnName.fromDT name) + +// | DEnum(_, +// _, +// [], +// "ERecordUpdate", +// [ DInt64 id; record; DList(_vtTODO, head :: tail) ]) -> +// let updates = +// NEList.ofList head tail +// |> NEList.map (fun update -> +// match update with +// | DTuple(DString name, expr, _) -> (name, fromDT expr) +// | _ -> +// Exception.raiseInternal "Invalid record update" [ "update", update ]) +// PT.ERecordUpdate(uint64 id, fromDT record, updates) + +// | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] + + +// module Const = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.constDef +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (c : PT.Const) : Dval = +// let (caseName, fields) = +// match c with +// | PT.Const.CUnit -> "CUnit", [] +// | PT.Const.CBool b -> "CBool", [ DBool b ] +// | PT.Const.CInt64 i -> "CInt64", [ DInt64 i ] +// | PT.Const.CUInt64 i -> "CUInt64", [ DUInt64 i ] +// | PT.Const.CInt8 i -> "CInt8", [ DInt8 i ] +// | PT.Const.CUInt8 i -> "CUInt8", [ DUInt8 i ] +// | PT.Const.CInt16 i -> "CInt16", [ DInt16 i ] +// | PT.Const.CUInt16 i -> "CUInt16", [ DUInt16 i ] +// | PT.Const.CInt32 i -> "CInt32", [ DInt32 i ] +// | PT.Const.CUInt32 i -> "CUInt32", [ DUInt32 i ] +// | PT.Const.CInt128 i -> "CInt128", [ DInt128 i ] +// | PT.Const.CUInt128 i -> "CUInt128", [ DUInt128 i ] +// | PT.Const.CFloat(sign, w, f) -> +// "CFloat", [ Sign.toDT sign; DString w; DString f ] +// | PT.Const.CChar c -> "CChar", [ DChar c ] +// | PT.Const.CString s -> "CString", [ DString s ] + +// | PT.Const.CTuple(first, second, theRest) -> +// "CTuple", +// [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] + +// | PT.Const.CEnum(typeName, caseName, fields) -> +// "CEnum", +// [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName +// DString caseName +// Dval.list knownType (List.map toDT fields) ] + +// | PT.Const.CList inner -> +// "CList", [ DList(VT.known knownType, List.map toDT inner) ] + +// | PT.Const.CDict pairs -> +// "CDict", +// [ DList( +// VT.tuple VT.string VT.string [], +// pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) +// ) ] + +// DEnum(typeName, typeName, [], caseName, fields) + + +// let rec fromDT (d : Dval) : PT.Const = +// match d with +// | DEnum(_, _, [], "CInt64", [ DInt64 i ]) -> PT.Const.CInt64 i +// | DEnum(_, _, [], "CUInt64", [ DUInt64 i ]) -> PT.Const.CUInt64 i +// | DEnum(_, _, [], "CInt8", [ DInt8 i ]) -> PT.Const.CInt8 i +// | DEnum(_, _, [], "CUInt8", [ DUInt8 i ]) -> PT.Const.CUInt8 i +// | DEnum(_, _, [], "CInt16", [ DInt16 i ]) -> PT.Const.CInt16 i +// | DEnum(_, _, [], "CUInt16", [ DUInt16 i ]) -> PT.Const.CUInt16 i +// | DEnum(_, _, [], "CInt32", [ DInt32 i ]) -> PT.Const.CInt32 i +// | DEnum(_, _, [], "CUInt32", [ DUInt32 i ]) -> PT.Const.CUInt32 i +// | DEnum(_, _, [], "CInt128", [ DInt128 i ]) -> PT.Const.CInt128 i +// | DEnum(_, _, [], "CUInt128", [ DUInt128 i ]) -> PT.Const.CUInt128 i +// | DEnum(_, _, [], "CBool", [ DBool b ]) -> PT.Const.CBool b +// | DEnum(_, _, [], "CString", [ DString s ]) -> PT.Const.CString s +// | DEnum(_, _, [], "CChar", [ DChar c ]) -> PT.Const.CChar c +// | DEnum(_, _, [], "CFloat", [ sign; DString w; DString f ]) -> +// PT.Const.CFloat(Sign.fromDT sign, w, f) +// | DEnum(_, _, [], "CUnit", []) -> PT.Const.CUnit +// | DEnum(_, _, [], "CTuple", [ first; second; DList(_vtTODO, rest) ]) -> +// PT.Const.CTuple(fromDT first, fromDT second, List.map fromDT rest) +// | DEnum(_, _, [], "CEnum", [ typeName; DString caseName; DList(_vtTODO, fields) ]) -> +// PT.Const.CEnum( +// NameResolution.fromDT FQTypeName.fromDT typeName, +// caseName, +// List.map fromDT fields +// ) +// | DEnum(_, _, [], "CList", [ DList(_vtTODO, inner) ]) -> +// PT.Const.CList(List.map fromDT inner) +// | DEnum(_, _, [], "CDict", [ DList(_vtTODO, pairs) ]) -> +// let pairs = +// pairs +// |> List.map (fun pair -> +// match pair with +// | DTuple(k, v, _) -> (fromDT k, fromDT v) +// | _ -> Exception.raiseInternal "Invalid pair" []) +// PT.Const.CDict( +// List.map +// (fun (k, v) -> +// (match k with +// | PT.Const.CString s -> s +// | _ -> Exception.raiseInternal "Invalid key" []), +// v) +// pairs +// ) + + +// | _ -> Exception.raiseInternal "Invalid Const" [] + +// module Deprecation = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.deprecation +// let knownType = KTCustomType(typeName, []) + +// let toDT +// (innerType : KnownType) +// (inner : 'a -> Dval) +// (d : PT.Deprecation<'a>) +// : Dval = +// let (caseName, fields) = +// match d with +// | PT.Deprecation.NotDeprecated -> "NotDeprecated", [] +// | PT.Deprecation.RenamedTo replacement -> "RenamedTo", [ inner replacement ] +// | PT.Deprecation.ReplacedBy replacement -> "ReplacedBy", [ inner replacement ] +// | PT.Deprecation.DeprecatedBecause reason -> +// "DeprecatedBecause", [ DString reason ] +// DEnum( +// typeName, +// typeName, +// [ VT.known innerType ], +// caseName, +// fields +// ) + +// let fromDT (inner : Dval -> 'a) (d : Dval) : PT.Deprecation<'a> = +// match d with +// | DEnum(_, _, _typeArgsDEnumTODO, "NotDeprecated", []) -> +// PT.Deprecation.NotDeprecated +// | DEnum(_, _, _typeArgsDEnumTODO, "RenamedTo", [ replacement ]) -> +// PT.Deprecation.RenamedTo(inner replacement) +// | DEnum(_, _, _typeArgsDEnumTODO, "ReplacedBy", [ replacement ]) -> +// PT.Deprecation.ReplacedBy(inner replacement) +// | DEnum(_, _, _typeArgsDEnumTODO, "DeprecatedBecause", [ DString reason ]) -> +// PT.Deprecation.DeprecatedBecause(reason) +// | _ -> Exception.raiseInternal "Invalid Deprecation" [] + + +// module TypeDeclaration = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.typeDeclaration + +// module RecordField = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.recordField +// let knownType = KTCustomType(typeName, []) + +// let toDT (rf : PT.TypeDeclaration.RecordField) : Dval = +// let fields = +// [ "name", DString rf.name +// "typ", TypeReference.toDT rf.typ +// "description", DString rf.description ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.TypeDeclaration.RecordField = +// match d with +// | DRecord(_, _, _, fields) -> +// { name = fields |> D.stringField "name" +// typ = fields |> D.field "typ" |> TypeReference.fromDT +// description = fields |> D.stringField "description" } +// | _ -> Exception.raiseInternal "Invalid RecordField" [] + +// module EnumField = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumField +// let knownType = KTCustomType(typeName, []) + +// let toDT (ef : PT.TypeDeclaration.EnumField) : Dval = +// let fields = +// [ "typ", TypeReference.toDT ef.typ +// "label", ef.label |> Option.map DString |> Dval.option KTString +// "description", DString ef.description ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.TypeDeclaration.EnumField = +// match d with +// | DRecord(_, _, _, fields) -> +// { typ = fields |> D.field "typ" |> TypeReference.fromDT +// label = +// match Map.get "label" fields with +// | Some(DEnum(_, _, _typeArgsDEnumTODO, "Some", [ DString label ])) -> +// Some label +// | Some(DEnum(_, _, _typeArgsDEnumTODO, "None", [])) -> None +// | _ -> +// Exception.raiseInternal "Expected label to be an option of string" [] +// description = fields |> D.stringField "description" } +// | _ -> Exception.raiseInternal "Invalid EnumField" [] + + +// module EnumCase = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumCase +// let knownType = KTCustomType(typeName, []) + +// let toDT (ec : PT.TypeDeclaration.EnumCase) : Dval = +// let fields = +// [ "name", DString ec.name +// "fields", +// DList(VT.known EnumField.knownType, List.map EnumField.toDT ec.fields) +// "description", DString ec.description ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.TypeDeclaration.EnumCase = +// match d with +// | DRecord(_, _, _, fields) -> +// { name = fields |> D.stringField "name" +// fields = fields |> D.listField "fields" |> List.map EnumField.fromDT +// description = fields |> D.stringField "description" } + +// | _ -> Exception.raiseInternal "Invalid EnumCase" [] + + +// module Definition = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.definition + +// let toDT (d : PT.TypeDeclaration.Definition) : Dval = +// let (caseName, fields) = +// match d with +// | PT.TypeDeclaration.Alias typeRef -> "Alias", [ TypeReference.toDT typeRef ] + +// | PT.TypeDeclaration.Record fields -> +// "Record", +// [ DList( +// VT.known RecordField.knownType, +// fields |> NEList.toList |> List.map RecordField.toDT +// ) ] + +// | PT.TypeDeclaration.Enum cases -> +// "Enum", +// [ DList( +// VT.known EnumCase.knownType, +// cases |> NEList.toList |> List.map EnumCase.toDT +// ) ] +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.TypeDeclaration.Definition = +// match d with +// | DEnum(_, _, [], "Alias", [ typeRef ]) -> +// PT.TypeDeclaration.Alias(TypeReference.fromDT typeRef) + +// | DEnum(_, _, [], "Record", [ DList(_vtTODO, firstField :: additionalFields) ]) -> +// PT.TypeDeclaration.Record( +// NEList.ofList firstField additionalFields |> NEList.map RecordField.fromDT +// ) + +// | DEnum(_, _, [], "Enum", [ DList(_vtTODO, firstCase :: additionalCases) ]) -> +// PT.TypeDeclaration.Enum( +// NEList.ofList firstCase additionalCases |> NEList.map EnumCase.fromDT +// ) + +// | _ -> Exception.raiseInternal "Invalid TypeDeclaration.Definition" [] + + +// let toDT (td : PT.TypeDeclaration.T) : Dval = +// let fields = +// [ "typeParams", DList(VT.string, List.map DString td.typeParams) +// "definition", Definition.toDT td.definition ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.TypeDeclaration.T = +// match d with +// | DRecord(_, _, _, fields) -> +// { typeParams = fields |> D.stringListField "typeParams" +// definition = fields |> D.field "definition" |> Definition.fromDT } +// | _ -> Exception.raiseInternal "Invalid TypeDeclaration" [] + + +// module Handler = +// module CronInterval = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.Handler.cronInterval + +// let toDT (ci : PT.Handler.CronInterval) : Dval = +// let (caseName, fields) = +// match ci with +// | PT.Handler.CronInterval.EveryMinute -> "EveryMinute", [] +// | PT.Handler.CronInterval.EveryHour -> "EveryHour", [] +// | PT.Handler.CronInterval.Every12Hours -> "Every12Hours", [] +// | PT.Handler.CronInterval.EveryDay -> "EveryDay", [] +// | PT.Handler.CronInterval.EveryWeek -> "EveryWeek", [] +// | PT.Handler.CronInterval.EveryFortnight -> "EveryFortnight", [] + +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.Handler.CronInterval = +// match d with +// | DEnum(_, _, [], "EveryMinute", []) -> PT.Handler.CronInterval.EveryMinute +// | DEnum(_, _, [], "EveryHour", []) -> PT.Handler.CronInterval.EveryHour +// | DEnum(_, _, [], "Every12Hours", []) -> PT.Handler.CronInterval.Every12Hours +// | DEnum(_, _, [], "EveryDay", []) -> PT.Handler.CronInterval.EveryDay +// | DEnum(_, _, [], "EveryWeek", []) -> PT.Handler.CronInterval.EveryWeek +// | DEnum(_, _, [], "EveryFortnight", []) -> +// PT.Handler.CronInterval.EveryFortnight +// | _ -> Exception.raiseInternal "Invalid CronInterval" [] + + +// module Spec = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.Handler.spec + +// let toDT (s : PT.Handler.Spec) : Dval = +// let (caseName, fields) = +// match s with +// | PT.Handler.Spec.HTTP(route, method) -> +// "HTTP", [ DString route; DString method ] +// | PT.Handler.Spec.Worker name -> "Worker", [ DString name ] +// | PT.Handler.Spec.Cron(name, interval) -> +// "Cron", [ DString name; CronInterval.toDT interval ] +// | PT.Handler.Spec.REPL name -> "REPL", [ DString name ] + +// DEnum(typeName, typeName, [], caseName, fields) + +// let fromDT (d : Dval) : PT.Handler.Spec = +// match d with +// | DEnum(_, _, [], "HTTP", [ DString route; DString method ]) -> +// PT.Handler.Spec.HTTP(route, method) +// | DEnum(_, _, [], "Worker", [ DString name ]) -> PT.Handler.Spec.Worker(name) +// | DEnum(_, _, [], "Cron", [ DString name; interval ]) -> +// PT.Handler.Spec.Cron(name, CronInterval.fromDT interval) +// | DEnum(_, _, [], "REPL", [ DString name ]) -> PT.Handler.Spec.REPL(name) +// | _ -> Exception.raiseInternal "Invalid Spec" [] + +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.Handler.handler + +// let toDT (h : PT.Handler.T) : Dval = +// let fields = +// [ "tlid", DUInt64(uint64 h.tlid) +// "ast", Expr.toDT h.ast +// "spec", Spec.toDT h.spec ] +// DRecord(typeName, typeName, [], Map fields) + + +// let fromDT (d : Dval) : PT.Handler.T = +// match d with +// | DRecord(_, _, _, fields) -> +// { tlid = fields |> D.uint64Field "tlid" +// ast = fields |> D.field "ast" |> Expr.fromDT +// spec = fields |> D.field "spec" |> Spec.fromDT } +// | _ -> Exception.raiseInternal "Invalid Handler" [] + + +// module DB = +// let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.db + +// let toDT (db : PT.DB.T) : Dval = +// let fields = +// [ "tlid", DUInt64(uint64 db.tlid) +// "name", DString db.name +// "version", DInt64 db.version +// "typ", TypeReference.toDT db.typ ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.DB.T = +// match d with +// | DRecord(_, _, _, fields) -> +// { tlid = fields |> D.uint64Field "tlid" +// name = fields |> D.stringField "name" +// version = fields |> D.int32Field "version" +// typ = fields |> D.field "typ" |> TypeReference.fromDT } +// | _ -> Exception.raiseInternal "Invalid DB" [] + + +// module Secret = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.secret + +// let toDT (s : PT.Secret.T) : Dval = +// let fields = +// [ "name", DString s.name +// "value", DString s.value +// "version", DInt64 s.version ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.Secret.T = +// match d with +// | DRecord(_, _, _, fields) -> +// { name = fields |> D.stringField "name" +// value = fields |> D.stringField "value" +// version = fields |> D.int32Field "version" } +// | _ -> Exception.raiseInternal "Invalid Secret" [] + + +// module PackageType = +// module Name = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.name + +// let toDT (n : PT.PackageType.Name) : Dval = +// let fields = +// [ "owner", DString n.owner +// "modules", DList(VT.string, List.map DString n.modules) +// "name", DString n.name ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.PackageType.Name = +// match d with +// | DRecord(_, _, _, fields) -> +// { owner = fields |> D.stringField "owner" +// modules = fields |> D.stringListField "modules" +// name = fields |> D.stringField "name" } +// | _ -> Exception.raiseInternal "Invalid PackageType.Name" [] + + +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.packageType + +// let toDT (p : PT.PackageType.PackageType) : Dval = +// let fields = +// [ "id", DUuid p.id +// "name", Name.toDT p.name +// "declaration", TypeDeclaration.toDT p.declaration +// "description", DString p.description +// "deprecated", +// Deprecation.toDT FQTypeName.knownType FQTypeName.toDT p.deprecated ] +// DRecord(typeName, typeName, [], Map fields) + + +// let fromDT (d : Dval) : PT.PackageType.PackageType = +// match d with +// | DRecord(_, _, _, fields) -> +// { id = fields |> D.uuidField "id" +// name = fields |> D.field "name" |> Name.fromDT +// declaration = fields |> D.field "declaration" |> TypeDeclaration.fromDT +// description = fields |> D.stringField "description" +// deprecated = +// fields |> D.field "deprecated" |> Deprecation.fromDT FQTypeName.fromDT } +// | _ -> Exception.raiseInternal "Invalid PackageType" [] + + +// module PackageConstant = +// module Name = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.name + +// let toDT (n : PT.PackageConstant.Name) : Dval = +// let fields = +// [ "owner", DString n.owner +// "modules", DList(VT.string, List.map DString n.modules) +// "name", DString n.name ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.PackageConstant.Name = +// match d with +// | DRecord(_, _, _, fields) -> +// { owner = fields |> D.stringField "owner" +// modules = fields |> D.stringListField "modules" +// name = fields |> D.stringField "name" } +// | _ -> Exception.raiseInternal "Invalid PackageConstant.Name" [] + + +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.packageConstant + +// let toDT (p : PT.PackageConstant.PackageConstant) : Dval = +// let fields = +// [ "id", DUuid p.id +// "name", Name.toDT p.name +// "body", Const.toDT p.body +// "description", DString p.description +// "deprecated", +// Deprecation.toDT FQConstantName.knownType FQConstantName.toDT p.deprecated ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.PackageConstant.PackageConstant = +// match d with +// | DRecord(_, _, _, fields) -> +// { id = fields |> D.uuidField "id" +// name = fields |> D.field "name" |> Name.fromDT +// body = fields |> D.field "body" |> Const.fromDT +// description = fields |> D.stringField "description" +// deprecated = +// fields |> D.field "deprecated" |> Deprecation.fromDT FQConstantName.fromDT } +// | _ -> Exception.raiseInternal "Invalid PackageConstant" [] + + +// module PackageFn = +// module Name = +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.name + +// let toDT (n : PT.PackageFn.Name) : Dval = +// let fields = +// [ "owner", DString n.owner +// "modules", DList(VT.string, List.map DString n.modules) +// "name", DString n.name ] +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : PT.PackageFn.Name = +// match d with +// | DRecord(_, _, _, fields) -> +// { owner = fields |> D.stringField "owner" +// modules = fields |> D.stringListField "modules" +// name = fields |> D.stringField "name" } +// | _ -> Exception.raiseInternal "Invalid PackageFn.Name" [] + + +// module Parameter = +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.parameter + +// let knownType = KTCustomType(typeName, []) + +// let toDT (p : PT.PackageFn.Parameter) : Dval = +// let fields = +// [ "name", DString p.name +// "typ", TypeReference.toDT p.typ +// "description", DString p.description ] +// DRecord(typeName, typeName, [], Map fields) + + +// let fromDT (d : Dval) : PT.PackageFn.Parameter = +// match d with +// | DRecord(_, _, _, fields) -> +// { name = fields |> D.stringField "name" +// typ = fields |> D.field "typ" |> TypeReference.fromDT +// description = fields |> D.stringField "description" } +// | _ -> Exception.raiseInternal "Invalid PackageFn.Parameter" [] + + +// let typeName = +// FQTypeName.fqPackage +// PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.packageFn + +// let toDT (p : PT.PackageFn.PackageFn) : Dval = +// let fields = +// [ ("id", DUuid p.id) +// ("name", Name.toDT p.name) +// ("body", Expr.toDT p.body) +// ("typeParams", DList(VT.string, List.map DString p.typeParams)) +// ("parameters", +// DList( +// VT.known Parameter.knownType, +// p.parameters |> NEList.toList |> List.map Parameter.toDT +// )) +// ("returnType", TypeReference.toDT p.returnType) +// ("description", DString p.description) +// ("deprecated", Deprecation.toDT FQFnName.knownType FQFnName.toDT p.deprecated) ] + +// DRecord(typeName, typeName, [], Map fields) + + +// let fromDT (d : Dval) : PT.PackageFn.PackageFn = +// match d with +// | DRecord(_, _, _, fields) -> +// { id = fields |> D.uuidField "id" +// name = fields |> D.field "name" |> Name.fromDT +// body = fields |> D.field "body" |> Expr.fromDT +// typeParams = fields |> D.stringListField "typeParams" +// parameters = +// fields +// |> D.listField "parameters" +// |> List.map Parameter.fromDT +// |> NEList.ofListUnsafe "PackageFn.fromDT" [] +// returnType = fields |> D.field "returnType" |> TypeReference.fromDT +// description = fields |> D.stringField "description" +// deprecated = +// fields |> D.field "deprecated" |> Deprecation.fromDT FQFnName.fromDT } +// | _ -> Exception.raiseInternal "Invalid PackageFn" [] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index c14560896d..22d41ae07e 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -5,22 +5,22 @@ open Prelude // Used for conversion functions module RT = RuntimeTypes -module VT = RT.ValueType +module VT = ValueType module PT = ProgramTypes -// module FQTypeName = -// module Package = -// let toRT (p : PT.FQTypeName.Package) : RT.FQTypeName.Package = p +module FQTypeName = + module Package = + let toRT (p : PT.FQTypeName.Package) : RT.FQTypeName.Package = p -// let fromRT (p : RT.FQTypeName.Package) : PT.FQTypeName.Package = p + //let fromRT (p : RT.FQTypeName.Package) : PT.FQTypeName.Package = p -// let toRT (fqtn : PT.FQTypeName.FQTypeName) : RT.FQTypeName.FQTypeName = -// match fqtn with -// | PT.FQTypeName.Package p -> RT.FQTypeName.Package(Package.toRT p) + let toRT (fqtn : PT.FQTypeName.FQTypeName) : RT.FQTypeName.FQTypeName = + match fqtn with + | PT.FQTypeName.Package p -> RT.FQTypeName.Package(Package.toRT p) -// let fromRT (fqtn : RT.FQTypeName.FQTypeName) : Option = -// match fqtn with -// | RT.FQTypeName.Package p -> PT.FQTypeName.Package(Package.fromRT p) |> Some +// let fromRT (fqtn : RT.FQTypeName.FQTypeName) : Option = +// match fqtn with +// | RT.FQTypeName.Package p -> PT.FQTypeName.Package(Package.fromRT p) |> Some // module FQConstantName = @@ -63,11 +63,18 @@ module FQFnName = | PT.FQFnName.Package p -> RT.FQFnName.Package(Package.toRT p) +module NameResolutionError = + let toRT (e : PT.NameResolutionError) : RT.NameResolutionError = + match e with + | PT.NameResolutionError.NotFound names -> RT.NameResolutionError.NotFound names + | PT.NameResolutionError.InvalidName names -> + RT.NameResolutionError.InvalidName names + module NameResolution = let toRT (f : 'a -> 'b) (nr : PT.NameResolution<'a>) : RT.NameResolution<'b> = match nr with | Ok x -> Ok(f x) - | Error e -> Error(NameResolutionError.RTE.toRuntimeError e) + | Error e -> Error(NameResolutionError.toRT e) module TypeReference = @@ -93,21 +100,25 @@ module TypeReference = | PT.TChar -> RT.TChar | PT.TString -> RT.TString + | PT.TDateTime -> RT.TDateTime + | PT.TUuid -> RT.TUuid + | PT.TList inner -> RT.TList(toRT inner) | PT.TTuple(first, second, theRest) -> RT.TTuple(toRT first, toRT second, theRest |> List.map toRT) | PT.TDict typ -> RT.TDict(toRT typ) - | PT.TDateTime -> RT.TDateTime - | PT.TUuid -> RT.TUuid -// | PT.TCustomType(typeName, typeArgs) -> -// RT.TCustomType( -// NameResolution.toRT FQTypeName.toRT typeName, -// List.map toRT typeArgs -// ) -// | PT.TVariable(name) -> RT.TVariable(name) -// | PT.TFn(paramTypes, returnType) -> -// RT.TFn(NEList.map toRT paramTypes, toRT returnType) + | PT.TCustomType(typeName, typeArgs) -> + RT.TCustomType( + NameResolution.toRT FQTypeName.toRT typeName, + List.map toRT typeArgs + ) + + | PT.TVariable(name) -> RT.TVariable(name) + + | PT.TFn(paramTypes, returnType) -> + RT.TFn(NEList.map toRT paramTypes, toRT returnType) + //| PT.TDB typ -> RT.TDB(toRT typ) @@ -225,35 +236,7 @@ module MatchCase = module Expr = - // CLEANUP clearly not the most efficient to do this, but probably fine for now - // TODO ok this is actually really wasteful. a single text string segment could be a single instruction - let rec compileString - (rc : int) - (segments : List) - : (int * RT.Instructions * RT.Register) = - let stringReg = rc - let init = (rc + 1, [ RT.LoadVal(stringReg, RT.DString "") ], stringReg) - - segments - |> List.fold - (fun (rc, instrs, _) segment -> - match segment with - | PT.StringText text -> - let textReg = rc - let newRc = rc + 1 - (newRc, - instrs - @ [ RT.LoadVal(textReg, RT.DString text) - RT.AppendString(stringReg, textReg) ], - stringReg) - | PT.StringInterpolation expr -> - let (newRc, exprInstrs, exprReg) = toRT rc expr - (newRc, - instrs @ exprInstrs @ [ RT.AppendString(stringReg, exprReg) ], - stringReg)) - init - - and toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = + let rec toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = match e with | PT.EUnit _id -> (rc + 1, [ RT.LoadVal(rc, RT.DUnit) ], rc) @@ -277,7 +260,31 @@ module Expr = | PT.EChar(_id, c) -> (rc + 1, [ RT.LoadVal(rc, RT.DChar c) ], rc) - | PT.EString(_id, segments) -> compileString rc segments + | PT.EString(_id, segments) -> + match segments with + // if there's only one segment, just load it directly + | [ PT.StringText text ] -> + (rc + 1, [ RT.LoadVal(rc, RT.DString text) ], rc) + + // otherwise, handle each segment separately + // and then create a string from the parts + | segments -> + let (rc, instrs, segments) = + List.fold + (fun (rc, instrs, segments) segment -> + match segment with + | PT.StringText text -> + (rc, instrs, segments @ [ RT.StringSegment.Text text ]) + + | PT.StringInterpolation expr -> + let (rcAfterExpr, exprInstrs, exprReg) = toRT rc expr + (rcAfterExpr, + instrs @ exprInstrs, + segments @ [ RT.Interpolated exprReg ])) + (rc, [], []) + segments + + (rc + 1, instrs @ [ RT.CreateString(rc, segments) ], rc) | PT.EList(_id, items) -> @@ -405,42 +412,42 @@ module Expr = let reg = rc (rc + 1, [ RT.LoadVal(reg, RT.DFnVal(RT.NamedFn(FQFnName.toRT name))) ], reg) - | PT.EFnName(_, Error _err) -> + | PT.EFnName(_, Error nre) -> // TODO improve // hmm maybe we shouldn't fail yet here. // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. // maybe the 'value' here is (still) some unresolved name? // (which should fail when we apply it) - (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) + (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], rc) - | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> - let (regCounter, thingToApplyInstrs, thingToApplyReg) = - // (usually, a fn name) - toRT rc thingToApplyExpr - // TODO: maybe one or both of these lists should be an `NEList`? + // | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> + // let (regCounter, thingToApplyInstrs, thingToApplyReg) = + // // (usually, a fn name) + // toRT rc thingToApplyExpr + // // TODO: maybe one or both of these lists should be an `NEList`? - // CLEANUP find a way to get rid of silly NEList stuff - let (regCounter, argInstrs, argRegs) = - let init = (regCounter, [], []) + // // CLEANUP find a way to get rid of silly NEList stuff + // let (regCounter, argInstrs, argRegs) = + // let init = (regCounter, [], []) - args - |> NEList.fold - (fun (rc, instrs, argResultRegs) arg -> - let (newRc, newInstrs, argResultReg) = toRT rc arg - (newRc, instrs @ newInstrs, argResultRegs @ [ argResultReg ])) - init + // args + // |> NEList.fold + // (fun (rc, instrs, argResultRegs) arg -> + // let (newRc, newInstrs, argResultReg) = toRT rc arg + // (newRc, instrs @ newInstrs, argResultRegs @ [ argResultReg ])) + // init - let putResultIn = regCounter - let callInstr = - RT.Apply( - putResultIn, - thingToApplyReg, - List.map TypeReference.toRT typeArgs, - NEList.ofListUnsafe "" [] argRegs - ) + // let putResultIn = regCounter + // let callInstr = + // RT.Apply( + // putResultIn, + // thingToApplyReg, + // List.map TypeReference.toRT typeArgs, + // NEList.ofListUnsafe "" [] argRegs + // ) - (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) + // (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) | PT.EMatch(_id, expr, cases) -> @@ -504,7 +511,6 @@ module Expr = ([], 0) let cases = List.rev cases - let caseInstrs = cases |> List.fold @@ -529,7 +535,6 @@ module Expr = instrs @ caseInstrs) [] - let instrs = exprInstrs @ caseInstrs @ [ RT.MatchUnmatched ] let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max @@ -537,235 +542,169 @@ module Expr = (rcAtEnd, instrs, resultReg) -// let rec toRT (e : PT.Expr) : RT.Instructions = -// match e with -// // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) -// // | PT.EConstant(id, Error err) -> -// // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - -// // | PT.EVariable(id, var) -> RT.EVariable(id, var) - -// // | PT.ERecordFieldAccess(id, obj, fieldname) -> RT.ERecordFieldAccess(id, toRT obj, fieldname) - -// | PT.EApply(id, fnName, typeArgs, args) -> -// // RT.EApply( -// // id, -// // toRT fnName, -// // List.map TypeReference.toRT typeArgs, -// // NEList.map toRT args -// // ) -// let fnInstr = -// match fnName with -// | PT.EFnName(_, Ok name) -> RT.Call(id, FQFnName.toRT name, List.map TypeReference.toRT typeArgs, NEList.map (fun a -> 0) args) -// | _ -> failwith "Unsupported function name resolution" -// fnInstr :: (args |> NEList.toList |> List.map toRT |> List.concat) - -// | PT.EFnName(id, Ok name) -> RT.EFnName(id, FQFnName.toRT name) -// | PT.EFnName(id, Error err) -> -// RT.EError(id, NameResolutionError.RTE.toRuntimeError err, []) - -// // // CLEANUP tidy infix stuff - extract to another fn? -// // | PT.EInfix(id, PT.InfixFnCall fnName, left, right) -> -// // let (fn, version) = InfixFnName.toFnName fnName -// // let name = RT.FQFnName.Builtin({ name = fn; version = version }) -// // RT.EApply( -// // id, -// // RT.EFnName(id, name), -// // [], -// // NEList.ofList (toRT left) [ toRT right ] -// // ) -// // | PT.EInfix(id, PT.BinOp PT.BinOpAnd, left, right) -> -// // RT.EAnd(id, toRT left, toRT right) -// // | PT.EInfix(id, PT.BinOp PT.BinOpOr, left, right) -> -// // RT.EOr(id, toRT left, toRT right) - -// // | PT.ELambda(id, pats, body) -> -// // RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body) - -// // | PT.ERecord(id, Ok typeName, fields) -> -// // match fields with -// // | [] -> -// // let fields = fields |> List.map Tuple2.second |> List.map toRT -// // RT.EError( -// // id, -// // RT.RuntimeError.oldError "Record must have at least one field", -// // fields -// // ) -// // | head :: tail -> -// // let fields = -// // NEList.ofList head tail -// // |> NEList.map (fun (name, expr) -> (name, toRT expr)) -// // RT.ERecord(id, FQTypeName.toRT typeName, fields) -// // | PT.ERecord(id, Error err, fields) -> -// // RT.EError( -// // id, -// // err |> NameResolutionError.RTE.toRuntimeError, -// // fields |> List.map Tuple2.second |> List.map toRT -// // ) - -// // | PT.ERecordUpdate(id, record, updates) -> -// // RT.ERecordUpdate( -// // id, -// // toRT record, -// // updates |> NEList.map (fun (fieldName, update) -> (fieldName, toRT update)) -// // ) - -// // | PT.EPipe(pipeID, expr1, rest) -> -// // // Convert v |> fn1 a |> fn2 |> fn3 b c -// // // into fn3 (fn2 (fn1 v a)) b c -// // let folder (prev : RT.Expr) (next : PT.PipeExpr) : RT.Expr = -// // let applyFn (expr : RT.Expr) (args : List) = -// // let typeArgs = [] -// // RT.EApply(pipeID, expr, typeArgs, NEList.ofList prev args) - -// // match next with -// // | PT.EPipeFnCall(id, Error err, _typeArgs, exprs) -> -// // let err = NameResolutionError.RTE.toRuntimeError err -// // let addlExprs = List.map toRT exprs -// // RT.EError(id, err, prev :: addlExprs) -// // | PT.EPipeFnCall(id, Ok fnName, typeArgs, exprs) -> -// // RT.EApply( -// // id, -// // RT.EFnName(id, FQFnName.toRT fnName), -// // List.map TypeReference.toRT typeArgs, -// // exprs |> List.map toRT |> NEList.ofList prev -// // ) -// // | PT.EPipeInfix(id, PT.InfixFnCall fnName, expr) -> -// // let (fn, version) = InfixFnName.toFnName fnName -// // let name = PT.FQFnName.Builtin({ name = fn; version = version }) -// // RT.EApply( -// // id, -// // RT.EFnName(id, FQFnName.toRT name), -// // [], -// // NEList.doubleton prev (toRT expr) -// // ) -// // // Binops work pretty naturally here -// // | PT.EPipeInfix(id, PT.BinOp op, expr) -> -// // match op with -// // | PT.BinOpAnd -> RT.EAnd(id, prev, toRT expr) -// // | PT.BinOpOr -> RT.EOr(id, prev, toRT expr) -// // | PT.EPipeEnum(id, Ok typeName, caseName, fields) -> -// // RT.EEnum( -// // id, -// // FQTypeName.toRT typeName, -// // caseName, -// // prev :: (List.map toRT fields) -// // ) -// // | PT.EPipeEnum(id, Error err, _caseName, fields) -> -// // RT.EError( -// // id, -// // NameResolutionError.RTE.toRuntimeError err, -// // prev :: (List.map toRT fields) -// // ) -// // | PT.EPipeVariable(id, name, exprs) -> -// // applyFn (RT.EVariable(id, name)) (List.map toRT exprs) -// // | PT.EPipeLambda(id, pats, body) -> -// // applyFn (RT.ELambda(id, NEList.map LetPattern.toRT pats, toRT body)) [] - -// // let init = toRT expr1 -// // List.fold folder init rest - -// // | PT.EMatch(id, mexpr, cases) -> -// // match cases with -// // | [] -> -// // RT.EError( -// // id, -// // RT.RuntimeError.oldError "Match must have at least one case", -// // [ toRT mexpr ] -// // ) -// // | head :: tail -> -// // let cases = -// // NEList.ofList head tail -// // |> NEList.map (fun case -> -// // let pattern = MatchPattern.toRT case.pat -// // let whenCondition = Option.map toRT case.whenCondition -// // let expr = toRT case.rhs -// // let result : RT.MatchCase = -// // { pat = pattern; whenCondition = whenCondition; rhs = expr } -// // result) - -// // RT.EMatch(id, toRT mexpr, cases) - -// // | PT.EEnum(id, Ok typeName, caseName, fields) -> -// // RT.EEnum(id, FQTypeName.toRT typeName, caseName, List.map toRT fields) -// // | PT.EEnum(id, Error err, _caseName, fields) -> -// // RT.EError(id, NameResolutionError.RTE.toRuntimeError err, List.map toRT fields) - -// // | PT.EDict(id, entries) -> -// // RT.EDict(id, entries |> List.map (Tuple2.mapSecond toRT)) - - -// module Const = -// let rec toRT (c : PT.Const) : RT.Const = -// match c with -// | PT.Const.CInt64 i -> RT.CInt64 i -// | PT.Const.CUInt64 i -> RT.CUInt64 i -// | PT.Const.CInt8 i -> RT.CInt8 i -// | PT.Const.CUInt8 i -> RT.CUInt8 i -// | PT.Const.CInt16 i -> RT.CInt16 i -// | PT.Const.CUInt16 i -> RT.CUInt16 i -// | PT.Const.CInt32 i -> RT.CInt32 i -// | PT.Const.CUInt32 i -> RT.CUInt32 i -// | PT.Const.CInt128 i -> RT.CInt128 i -// | PT.Const.CUInt128 i -> RT.CUInt128 i -// | PT.Const.CBool b -> RT.CBool b -// | PT.Const.CString s -> RT.CString s -// | PT.Const.CChar c -> RT.CChar c -// | PT.Const.CFloat(sign, w, f) -> RT.CFloat(sign, w, f) -// | PT.Const.CUnit -> RT.CUnit -// | PT.Const.CTuple(first, second, rest) -> -// RT.CTuple(toRT first, toRT second, List.map toRT rest) -// | PT.Const.CEnum(typeName, caseName, fields) -> -// RT.CEnum( -// NameResolution.toRT FQTypeName.toRT typeName, -// caseName, -// List.map toRT fields -// ) -// | PT.Const.CList items -> RT.CList(List.map toRT items) -// | PT.Const.CDict entries -> RT.CDict(entries |> List.map (Tuple2.mapSecond toRT)) - - -// module TypeDeclaration = -// module RecordField = -// let toRT (f : PT.TypeDeclaration.RecordField) : RT.TypeDeclaration.RecordField = -// { name = f.name; typ = TypeReference.toRT f.typ } - -// module EnumField = -// let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = -// TypeReference.toRT f.typ - -// module EnumCase = -// let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = -// { name = c.name; fields = List.map EnumField.toRT c.fields } - -// module Definition = -// let toRT (d : PT.TypeDeclaration.Definition) : RT.TypeDeclaration.Definition = -// match d with -// | PT.TypeDeclaration.Definition.Alias(typ) -> -// RT.TypeDeclaration.Alias(TypeReference.toRT typ) - -// | PT.TypeDeclaration.Record fields -> -// RT.TypeDeclaration.Record(NEList.map RecordField.toRT fields) - -// | PT.TypeDeclaration.Enum cases -> -// RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) - -// let toRT (t : PT.TypeDeclaration.T) : RT.TypeDeclaration.T = -// { typeParams = t.typeParams; definition = Definition.toRT t.definition } + // -- Records -- + | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> + let returnReg = 0 // TODO - not sure what to do here + (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], returnReg) + + | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> + // fields : List + let recordReg, rc = rc, rc + 1 + + // CLEANUP: complain if there are no fields -- or maybe that should happen during interpretation? + // - actually- is there anything _wrong_ with a fieldless record? + let (rcAfterFields, instrs, fields) = + fields + |> List.fold + (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> + let (newRc, newInstrs, fieldReg) = toRT rc fieldExpr + (newRc, instrs @ newInstrs, fieldRegs @ [ (fieldName, fieldReg) ])) + (rc, [], []) + + (rcAfterFields, + instrs + @ [ RT.CreateRecord( + recordReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + fields + ) ], + recordReg) + + // | PT.ERecordUpdate(_id, expr, updates) -> + // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = + // toRT rc expr + + // let (rcAfterUpdates, updatesInstrs, updates) = + // updates + // |> NEList.fold + // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> + // let (newRc, newInstrs, newReg) = toRT rc fieldExpr + // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) + // (rcAfterOriginalRecord, [], []) + + // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 + // let instrs = + // originalRecordInstrs + // @ updatesInstrs + // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] + + // (rc, instrs, targetReg) + + | PT.ERecordFieldAccess(_id, expr, fieldName) -> + let (rcAfterExpr, exprInstrs, exprReg) = toRT rc expr + (rcAfterExpr + 1, + exprInstrs @ [ RT.GetRecordField(rcAfterExpr, exprReg, fieldName) ], + rcAfterExpr) + + + // -- Enums -- + | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> + let returnReg = 0 // TODO - not sure what to do here + (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], returnReg) + + | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> + // fields : List + let enumReg, rc = rc, rc + 1 + + let (rcAfterFields, instrs, fields) = + fields + |> List.fold + (fun (rc, instrs, fieldRegs) fieldExpr -> + let (newRc, newInstrs, fieldReg) = toRT rc fieldExpr + (newRc, instrs @ newInstrs, fieldRegs @ [ fieldReg ])) + (rc, [], []) + + (rcAfterFields, + instrs + @ [ RT.CreateEnum( + enumReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + caseName, + fields + ) ], + enumReg) + + + +module Const = + let rec toRT (c : PT.Const) : RT.Const = + match c with + | PT.Const.CUnit -> RT.CUnit + + | PT.Const.CBool b -> RT.CBool b + + | PT.Const.CInt8 i -> RT.CInt8 i + | PT.Const.CUInt8 i -> RT.CUInt8 i + | PT.Const.CInt16 i -> RT.CInt16 i + | PT.Const.CUInt16 i -> RT.CUInt16 i + | PT.Const.CInt32 i -> RT.CInt32 i + | PT.Const.CUInt32 i -> RT.CUInt32 i + | PT.Const.CInt64 i -> RT.CInt64 i + | PT.Const.CUInt64 i -> RT.CUInt64 i + | PT.Const.CInt128 i -> RT.CInt128 i + | PT.Const.CUInt128 i -> RT.CUInt128 i + + | PT.Const.CFloat(sign, w, f) -> RT.CFloat(sign, w, f) + + | PT.Const.CChar c -> RT.CChar c + | PT.Const.CString s -> RT.CString s + + | PT.Const.CTuple(first, second, rest) -> + RT.CTuple(toRT first, toRT second, List.map toRT rest) + | PT.Const.CList items -> RT.CList(List.map toRT items) + | PT.Const.CDict entries -> RT.CDict(entries |> List.map (Tuple2.mapSecond toRT)) + + | PT.Const.CEnum(typeName, caseName, fields) -> + RT.CEnum( + NameResolution.toRT FQTypeName.toRT typeName, + caseName, + List.map toRT fields + ) + + +module TypeDeclaration = + module RecordField = + let toRT (f : PT.TypeDeclaration.RecordField) : RT.TypeDeclaration.RecordField = + { name = f.name; typ = TypeReference.toRT f.typ } + + // module EnumField = + // let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = + // TypeReference.toRT f.typ + + // module EnumCase = + // let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = + // { name = c.name; fields = List.map EnumField.toRT c.fields } + + module Definition = + let toRT (d : PT.TypeDeclaration.Definition) : RT.TypeDeclaration.Definition = + match d with + | PT.TypeDeclaration.Definition.Alias(typ) -> + RT.TypeDeclaration.Alias(TypeReference.toRT typ) + + | PT.TypeDeclaration.Record fields -> + RT.TypeDeclaration.Record(NEList.map RecordField.toRT fields) + + // | PT.TypeDeclaration.Enum cases -> + // RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) + + let toRT (t : PT.TypeDeclaration.T) : RT.TypeDeclaration.T = + { typeParams = t.typeParams; definition = Definition.toRT t.definition } // -- // Package stuff // -- -// module PackageType = -// let toRT (t : PT.PackageType.PackageType) : RT.PackageType.PackageType = -// { id = t.id; declaration = TypeDeclaration.toRT t.declaration } +module PackageType = + let toRT (t : PT.PackageType.PackageType) : RT.PackageType.PackageType = + { id = t.id; declaration = TypeDeclaration.toRT t.declaration } -// module PackageConstant = -// let toRT -// (c : PT.PackageConstant.PackageConstant) -// : RT.PackageConstant.PackageConstant = -// { id = c.id; body = Const.toRT c.body } +module PackageConstant = + let toRT + (c : PT.PackageConstant.PackageConstant) + : RT.PackageConstant.PackageConstant = + { id = c.id; body = Const.toRT c.body } module PackageFn = module Parameter = @@ -788,29 +727,6 @@ module PackageFn = // // -- // // User stuff // // -- -// module Handler = -// module CronInterval = -// let toRT (ci : PT.Handler.CronInterval) : RT.Handler.CronInterval = -// match ci with -// | PT.Handler.EveryDay -> RT.Handler.EveryDay -// | PT.Handler.EveryWeek -> RT.Handler.EveryWeek -// | PT.Handler.EveryFortnight -> RT.Handler.EveryFortnight -// | PT.Handler.EveryHour -> RT.Handler.EveryHour -// | PT.Handler.Every12Hours -> RT.Handler.Every12Hours -// | PT.Handler.EveryMinute -> RT.Handler.EveryMinute - -// module Spec = -// let toRT (s : PT.Handler.Spec) : RT.Handler.Spec = -// match s with -// | PT.Handler.HTTP(route, method) -> RT.Handler.HTTP(route, method) -// | PT.Handler.Worker name -> RT.Handler.Worker name -// | PT.Handler.Cron(name, interval) -> -// RT.Handler.Cron(name, CronInterval.toRT interval) -// | PT.Handler.REPL name -> RT.Handler.REPL name - -// let toRT (h : PT.Handler.T) : RT.Handler.T = -// { tlid = h.tlid; ast = Expr.toRT h.ast; spec = Spec.toRT h.spec } - // module DB = // let toRT (db : PT.DB.T) : RT.DB.T = // { tlid = db.tlid @@ -826,9 +742,9 @@ module PackageFn = module PackageManager = let toRT (pm : PT.PackageManager) : RT.PackageManager = - { //getType = fun id -> pm.getType id |> Ply.map (Option.map PackageType.toRT) - //getConstant = - // fun id -> pm.getConstant id |> Ply.map (Option.map PackageConstant.toRT) + { getType = fun id -> pm.getType id |> Ply.map (Option.map PackageType.toRT) + getConstant = + fun id -> pm.getConstant id |> Ply.map (Option.map PackageConstant.toRT) getFn = fun id -> pm.getFn id |> Ply.map (Option.map PackageFn.toRT) init = pm.init } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 29ef460c60..011f9fce83 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -35,7 +35,7 @@ open Prelude let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$" let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$" -//let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" +let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let assertBuiltin @@ -47,52 +47,52 @@ let assertBuiltin assert_ "version can't be negative" [ "version", version ] (version >= 0) -// /// Fully-Qualified Type Name -// /// -// /// Used to reference a type defined in a Package -// module FQTypeName = -// /// The id of a type in the package manager -// type Package = uuid +/// Fully-Qualified Type Name +/// +/// Used to reference a type defined in a Package +module FQTypeName = + /// The id of a type in the package manager + type Package = uuid -// type FQTypeName = Package of Package + type FQTypeName = Package of Package -// let package (id : uuid) : Package = id + let package (id : uuid) : Package = id -// let fqPackage (id : uuid) : FQTypeName = Package id + let fqPackage (id : uuid) : FQTypeName = Package id -// let toString (name : FQTypeName) : string = -// match name with -// | Package p -> string p // TODO: better +// let toString (name : FQTypeName) : string = +// match name with +// | Package p -> string p // TODO: better -// /// A Fully-Qualified Constant Name -// /// -// /// Used to reference a constant defined by the runtime or in a Package -// module FQConstantName = -// /// A constant built into the runtime -// type Builtin = { name : string; version : int } +/// A Fully-Qualified Constant Name +/// +/// Used to reference a constant defined by the runtime or in a Package +module FQConstantName = + /// A constant built into the runtime + type Builtin = { name : string; version : int } -// /// The id of a constant in the package manager -// type Package = uuid + /// The id of a constant in the package manager + type Package = uuid -// type FQConstantName = -// | Builtin of Builtin -// | Package of Package + type FQConstantName = + | Builtin of Builtin + | Package of Package -// let assertConstantName (name : string) : unit = -// assertRe "Constant name must match" constantNamePattern name + let assertConstantName (name : string) : unit = + assertRe "Constant name must match" constantNamePattern name -// let builtin (name : string) (version : int) : Builtin = -// assertBuiltin name version assertConstantName -// { name = name; version = version } + let builtin (name : string) (version : int) : Builtin = + assertBuiltin name version assertConstantName + { name = name; version = version } -// let package (id : uuid) : Package = id + let package (id : uuid) : Package = id -// let fqPackage (id : uuid) : FQConstantName = Package id + let fqPackage (id : uuid) : FQConstantName = Package id -// let builtinToString (s : Builtin) : string = -// let name = s.name -// if s.version = 0 then name else $"{name}_v{s.version}" + let builtinToString (s : Builtin) : string = + let name = s.name + if s.version = 0 then name else $"{name}_v{s.version}" // let toString (name : FQConstantName) : string = // match name with @@ -201,11 +201,11 @@ type KnownType = // /// List.head ([]: List>) // KTDB (Unknown) // | KTDB of ValueType - // /// let n = None // type args: [Unknown] - // /// let s = Some(5) // type args: [Known KTInt64] - // /// let o = Ok (5) // type args: [Known KTInt64, Unknown] - // /// let e = Error ("str") // type args: [Unknown, Known KTString] - // | KTCustomType of FQTypeName.FQTypeName * typeArgs : List + /// let n = None // type args: [Unknown] + /// let s = Some(5) // type args: [Known KTInt64] + /// let o = Ok (5) // type args: [Known KTInt64, Unknown] + /// let e = Error ("str") // type args: [Unknown, Known KTString] + | KTCustomType of FQTypeName.FQTypeName * typeArgs : List /// let myDict = {} // KTDict Unknown | KTDict of ValueType @@ -218,162 +218,6 @@ and [] ValueType = | Unknown | Known of KnownType -[] -module ValueType = - // some helpers to reduce typing elsewhere - let unknown = ValueType.Unknown - let unknownTODO = ValueType.Unknown - let unknownDbTODO = ValueType.Unknown - let typeArgsTODO = [] - - let known inner = ValueType.Known inner - - let unit = known KTUnit - let bool = known KTBool - let int8 = known KTInt8 - let uint8 = known KTUInt8 - let int16 = known KTInt16 - let uint16 = known KTUInt16 - let int32 = known KTInt32 - let uint32 = known KTUInt32 - let int64 = known KTInt64 - let uint64 = known KTUInt64 - let int128 = known KTInt128 - let uint128 = known KTUInt128 - let float = known KTFloat - let char = known KTChar - let string = known KTString - let dateTime = known KTDateTime - let uuid = known KTUuid - - let list (inner : ValueType) : ValueType = known (KTList inner) - let dict (inner : ValueType) : ValueType = known (KTDict inner) - let tuple - (first : ValueType) - (second : ValueType) - (theRest : List) - : ValueType = - KTTuple(first, second, theRest) |> known - - // let customType - // (typeName : FQTypeName.FQTypeName) - // (typeArgs : List) - // : ValueType = - // KTCustomType(typeName, typeArgs) |> known - - let rec toString (vt : ValueType) : string = - match vt with - | ValueType.Unknown -> "_" - | ValueType.Known kt -> - match kt with - | KTUnit -> "Unit" - | KTBool -> "Bool" - | KTInt8 -> "Int8" - | KTUInt8 -> "UInt8" - | KTInt16 -> "Int16" - | KTUInt16 -> "UInt16" - | KTInt32 -> "Int32" - | KTUInt32 -> "UInt32" - | KTInt64 -> "Int64" - | KTUInt64 -> "UInt64" - | KTInt128 -> "Int128" - | KTUInt128 -> "UInt128" - | KTFloat -> "Float" - | KTChar -> "Char" - | KTString -> "String" - | KTUuid -> "Uuid" - | KTDateTime -> "DateTime" - - | KTList inner -> $"List<{toString inner}>" - | KTDict inner -> $"Dict<{toString inner}>" - | KTTuple(first, second, theRest) -> - first :: second :: theRest - |> List.map toString - |> String.concat " * " - |> fun inner -> $"({inner})" - - // | KTCustomType(typeName, typeArgs) -> - // let typeArgsPart = - // match typeArgs with - // | [] -> "" - // | _ -> - // typeArgs - // |> List.map toString - // |> String.concat ", " - // |> fun inner -> $"<{inner}>" - - // $"{FQTypeName.toString typeName}{typeArgsPart}" - - // | KTFn(args, ret) -> - // NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " - - //| KTDB inner -> $"DB<{toString inner}>" - - - let rec private mergeKnownTypes - (left : KnownType) - (right : KnownType) - : Result = - let r = merge - match left, right with - | KTUnit, KTUnit -> KTUnit |> Ok - | KTBool, KTBool -> KTBool |> Ok - | KTInt8, KTInt8 -> KTInt8 |> Ok - | KTUInt8, KTUInt8 -> KTUInt8 |> Ok - | KTInt16, KTInt16 -> KTInt16 |> Ok - | KTUInt16, KTUInt16 -> KTUInt16 |> Ok - | KTInt32, KTInt32 -> KTInt32 |> Ok - | KTUInt32, KTUInt32 -> KTUInt32 |> Ok - | KTInt64, KTInt64 -> KTInt64 |> Ok - | KTUInt64, KTUInt64 -> KTUInt64 |> Ok - | KTInt128, KTInt128 -> KTInt128 |> Ok - | KTUInt128, KTUInt128 -> KTUInt128 |> Ok - | KTFloat, KTFloat -> KTFloat |> Ok - | KTChar, KTChar -> KTChar |> Ok - | KTString, KTString -> KTString |> Ok - | KTUuid, KTUuid -> KTUuid |> Ok - | KTDateTime, KTDateTime -> KTDateTime |> Ok - - | KTList left, KTList right -> r left right |> Result.map KTList - | KTDict left, KTDict right -> r left right |> Result.map KTDict - | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> - let firstMerged = r l1 r1 - let secondMerged = r l2 r2 - let restMerged = List.map2 r ls rs |> Result.collect - - match firstMerged, secondMerged, restMerged with - | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) - | _ -> Error() - - // | KTCustomType(lName, lArgs), KTCustomType(rName, rArgs) -> - // if lName <> rName then - // Error() - // else if List.length lArgs <> List.length rArgs then - // Error() - // else - // List.map2 r lArgs rArgs - // |> Result.collect - // |> Result.map (fun args -> KTCustomType(lName, args)) - - // | KTFn(lArgs, lRet), KTFn(rArgs, rRet) -> - // let argsMerged = NEList.map2 r lArgs rArgs |> Result.collectNE - // let retMerged = r lRet rRet - - // match argsMerged, retMerged with - // | Ok args, Ok ret -> Ok(KTFn(args, ret)) - // | _ -> Error() - - | _ -> Error() - - and merge (left : ValueType) (right : ValueType) : Result = - match left, right with - | ValueType.Unknown, v - | v, ValueType.Unknown -> Ok v - - | ValueType.Known left, ValueType.Known right -> - mergeKnownTypes left right |> Result.map ValueType.Known - - // ------------ // Exprs @@ -406,7 +250,11 @@ type LetPattern = [] type register -type NameResolution<'a> = Result<'a, RuntimeError> +type NameResolutionError = + | NotFound of List + | InvalidName of List + +type NameResolution<'a> = Result<'a, NameResolutionError> and TypeReference = | TUnit @@ -431,9 +279,9 @@ and TypeReference = | TFn of NEList * TypeReference // | TDB of TypeReference | TVariable of string - // | TCustomType of - // NameResolution * - // typeArgs : List + | TCustomType of + NameResolution * + typeArgs : List | TDict of TypeReference // CLEANUP add key type member this.isFn() : bool = @@ -467,7 +315,7 @@ and TypeReference = isConcrete t1 && isConcrete t2 && List.forall isConcrete ts | TFn(ts, t) -> NEList.forall isConcrete ts && isConcrete t // | TDB t -> isConcrete t - // | TCustomType(_, ts) -> List.forall isConcrete ts + | TCustomType(_, ts) -> List.forall isConcrete ts | TDict t -> isConcrete t | TVariable _ -> false @@ -500,6 +348,10 @@ and MatchPattern = theRest : List | MPVariable of string +and StringSegment = + | Text of string + | Interpolated of Register + /// TODO: consider if each of these should include the Expr ID that they came from /// /// Would Expr ID be enough? @@ -509,52 +361,38 @@ and MatchPattern = /// and only load it when needed. /// That way, the Interpreter could be lighter-weight. and Instruction = + // == Simple register operations == /// Push a ("constant") value into a register | LoadVal of loadTo : Register * Dval - | AppendString of targetReg : Register * sourceReg : Register + | CopyVal of copyTo : Register * copyFrom : Register - /// Loads the value of a register into a variable - | SetVar of varName : string * loadFrom : Register + // == Working with Variables == + /// Extract values in a Register to 0 or more variables, per the pattern. + /// (e.g. `let (x, y) = (1, 2)`) + /// + /// Errors if the pattern doesn't match the value. + | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern /// Stores the value of a variable to a register | GetVar of loadTo : Register * varName : string - /// Create a list, and type-check to ensure the items are of a consistent type - | CreateList of listRegister : Register * itemsToAdd : List + // == Working with Basic Types == + | CreateString of targetReg : Register * segments : List - | CreateTuple of - createTo : Register * - first : Register * - second : Register * - theRest : List - /// Create a dict, and type-check to ensure the entries are of a consistent type - | CreateDict of dictRegister : Register * entries : List + // == Flow Control == - | CopyVal of copyTo : Register * copyFrom : Register - - /// Go n instructions forward, if the value in the register is false + // -- Jumps -- + /// Go `n` instructions forward, if the value in the register is `false` | JumpByIfFalse of instrsToJump : int * conditionReg : Register - /// Go n instructions forward, unconditionally + /// Go `n` instructions forward, unconditionally | JumpBy of instrsToJump : int - | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern - - /// Apply some args (and maybe type args) to something - /// (a named function, or lambda, etc) - | Apply of - putResultIn : Register * - thingToApply : Register * - typeArgs : List * - args : NEList - - /// Fail if this is hit (basically "raise an exception") - | Fail of RuntimeError - + // -- Match -- /// Check if the value in the noted register the noted pattern, /// and extract vars per MPVariable as relevant. | CheckMatchPatternAndExtractVars of @@ -570,37 +408,66 @@ and Instruction = | MatchUnmatched -and Instructions = List -and InstructionsWithContext = - // (rc, instructions, result register) - (int * Instructions * Register) + // == Working with Collections == + | CreateTuple of + createTo : Register * + first : Register * + second : Register * + theRest : List + /// Create a list, and type-check to ensure the items are of a consistent type + | CreateList of listRegister : Register * itemsToAdd : List -// // Expressions here are runtime variants of the AST in ProgramTypes, having had -// // superfluous information removed. -// and Expr = -// // // flow control -// // | EAnd of id * lhs : Expr * rhs : Expr -// // | EOr of id * lhs : Expr * rhs : Expr + /// Create a dict, and type-check to ensure the entries are of a consistent type + | CreateDict of dictRegister : Register * entries : List -// // // declaring and referencing vars -// // | ERecordFieldAccess of id * Expr * string -// // calling fns and other things -// //| ELambda of id * pats : NEList * body : Expr + // == Working with Custom Data == + // -- Records -- + | CreateRecord of + recordReg : Register * + typeName : FQTypeName.FQTypeName * + typeArgs : List * + fields : List + + // | CloneRecordWithUpdates of + // targetReg : Register * + // originalRecordReg : Register * + // updates : List + + | GetRecordField of + targetReg : Register * + recordReg : Register * + fieldName : string + + // -- Enums -- + | CreateEnum of + enumReg : Register * + typeName : FQTypeName.FQTypeName * + typeArgs : List * + caseName : string * + fields : List -// // // working with custom types -// // | EConstant of id * FQConstantName.FQConstantName -// // | ERecord of id * FQTypeName.FQTypeName * NEList -// // | ERecordUpdate of id * record : Expr * updates : NEList -// // | EEnum of id * FQTypeName.FQTypeName * caseName : string * fields : List -// // A runtime error. This is included so that we can allow the program to run in the -// // presence of compile-time errors (which are converted to this error). We may -// // adapt this to include more information as we go. This list of exprs is the -// // subexpressions to evaluate before evaluating the error. -// | EError of id * RuntimeError * List + // == Working with things that Apply == + // /// Apply some args (and maybe type args) to something + // /// (a named function, or lambda, etc) + // | Apply of + // putResultIn : Register * + // thingToApply : Register * + // typeArgs : List * + // args : NEList + + // == Errors == + | RaiseNRE of NameResolutionError + + + +and Instructions = List + +/// (rc, instructions, result register) +and InstructionsWithContext = (int * Instructions * Register) and DvalMap = Map @@ -622,11 +489,7 @@ and FnValImpl = //| Lambda of LambdaImpl | NamedFn of FQFnName.FQFnName -/// RuntimeError is the major way of representing errors in the runtime. These are -/// primarily used for things where the user made an error, such as a type error, as -/// opposed to a place where the runtime is flawed (use Exception.raiseInternal for those). -/// See docs/errors.md for detailed discussion. -and RuntimeError = private RuntimeError of Dval + // We use NoComparison here to avoid accidentally using structural comparison and [] Dval = @@ -659,27 +522,34 @@ and [] Dval = | DTuple of first : Dval * second : Dval * theRest : List | DDict of // This is the type of the _values_, not the keys. Once users can specify the - // key type, we likely will need to add a `keyType: ValueType` field here. + // key type, we likely will need to add a `keyType: ValueType` field here. TODO valueType : ValueType * entries : DvalMap - // // custom types - // | DRecord of - // // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? - // // CLEANUP we may need a sourceTypeArgs here as well - // runtimeTypeName : FQTypeName.FQTypeName * - // sourceTypeName : FQTypeName.FQTypeName * - // typeArgs : List * - // fields : DvalMap - - // | DEnum of - // // CLEANUP nitpick: maybe move sourceTypeName before runtimeTypeName? - // // CLEANUP we may need a sourceTypeArgs here as well - // runtimeTypeName : FQTypeName.FQTypeName * - // sourceTypeName : FQTypeName.FQTypeName * - // typeArgs : List * - // caseName : string * - // fields : List + // TODO: go through all instances of DRecord and DEnum + // and make sure the typeNames are in the correct order + + // -- custom types -- + | DRecord of + // CLEANUP we may need a sourceTypeArgs here as well + sourceTypeName : FQTypeName.FQTypeName * + runtimeTypeName : FQTypeName.FQTypeName * + // do we need to split this into sourceTypeArgs and runtimeTypeArgs? + // What are we even using the source stuff for? error-reporting? + typeArgs : List * + fields : DvalMap // would a list be better? We can do the type-check fun _after_ + // field access would be a tad slower, but there usually aren't that many fields + // and it's probably more convenient? + // Hmm for dicts, we could consider the same thing, but field-access perf is + // more important there. + + | DEnum of + // CLEANUP we may need a sourceTypeArgs here as well + sourceTypeName : FQTypeName.FQTypeName * + runtimeTypeName : FQTypeName.FQTypeName * + typeArgs : List * // same q here - split into sourceTypeArgs and runtimeTypeArgs? + caseName : string * + fields : List // Functions | DFnVal of FnValImpl // VTTODO I'm not sure how ValueType fits in here @@ -772,50 +642,298 @@ and BuiltInParam = and Param = { name : string; typ : TypeReference } -module CallStack = - let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = - { entrypoint = entrypoint; lastCalled = (entrypoint, None) } +// TODO really consider making this extensible without requiring a rebuild +// (maybe reframe this as an `Exception`, maybe some new TL that users can add to) +module RuntimeError = + module TypeChecker = + // TODO: move this somewhere.. + type Context = + | FunctionCallParameter of + fnName : FQFnName.FQFnName * + parameter : Param * + paramIndex : int + | FunctionCallResult of fnName : FQFnName.FQFnName * returnType : TypeReference + | RecordField of + recordTypeName : FQTypeName.FQTypeName * + fieldName : string * + fieldType : TypeReference + | DictKey of key : string * typ : TypeReference + | EnumField of + enumTypeName : FQTypeName.FQTypeName * + caseName : string * + fieldIndex : int * + fieldCount : int * + fieldType : TypeReference + | DBQueryVariable of varName : string * expected : TypeReference + | DBSchemaType of name : string * expectedType : TypeReference + | ListIndex of index : int * listTyp : TypeReference * parent : Context + | TupleIndex of index : int * elementType : TypeReference * parent : Context + | FnValResult of returnType : TypeReference + + + // module Cli = + // type Error = + // | NoExpressionsToExecute + // | UncaughtException of String * List + // | NonIntReturned of actuallyReturned: Dval.Dval + + + // module Json = + // type Error = UnsupportedType of RuntimeTypes.TypeReference + + + module Ints = + type Error = + | DivideByZeroError + | OutOfRange + | NegativeExponent + | NegativeModulus + | ZeroModulus + + + // module Execution = + // type Error = + // | MatchExprUnmatched of RuntimeTypes.Dval.Dval + // | NonStringInStringInterpolation of RuntimeTypes.Dval.Dval + // | ConstDoesntExist of RuntimeTypes.FQConstantName.FQConstantName + // | EnumConstructionCaseNotFound of typeName: RuntimeTypes.FQTypeName * caseName: String + // | WrongNumberOfFnArgs of fn: RuntimeTypes.FQFnName * expectedTypeArgs: Int64 * expectedArgs: Int64 * actualTypeArgs: Int64 * actualArgs: Int64 + + // // TODO: Record submodule + // | RecordConstructionFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * fieldName: String + // | RecordConstructionMissingField of RuntimeTypes.FQTypeName * missingFieldName: String + // | RecordConstructionDuplicateField of RuntimeTypes.FQTypeName * duplicateFieldName: String + // | FieldAccessFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * invalidFieldName: String + // | FieldAccessNotRecord of RuntimeTypes.ValueType * String + + // module Unwrap = + // type Error = + // | GotNone + // | GotError of Dval + // | NonOptionOrResult of Dval + + + module Lets = + // CLEANUP consider some kinda _path_ thing like with JSON errors + // type Details = + // /// Unit pattern does not match + // | UnitPatternDoesNotMatch + + // /// Tuple pattern does not match + // | TuplePatternDoesNotMatch + + // /// Tuple pattern has wrong number of elements + // | TuplePatternWrongLength of expected: Int * actual: Int + + type Error = + /// Could not decompose `{someFn dval}` with pattern `{someFn pat}` in `let` expression + | PatternDoesNotMatch of dval : Dval * pat : LetPattern + + // module Enum = + // type Error = + // /// $"When constructing enum value `typeName`.`{caseName}`, + // /// expected {expectedFieldCount} fields but got {actualFieldCount}" + // | WrongNumberOfFields of typeName * FQTypeName * caseName: String * expectedFieldCount: Int * actualFieldCount: Int + + module Bools = + type Error = + // | AndOnlySupportsBooleans of gotInstead: Dval + // | OrOnlySupportsBooleans of gotInstead: Dval + | ConditionRequiresBool of actualValueType : ValueType * actualValue : Dval + + module Strings = + type Error = + // "Error: Invalid string-append attempt" + | InvalidStringAppend + + + module Lists = + type Error = + /// Cannot add a {} ({}) to a list of {} + | TriedToAddMismatchedData of + expectedType : ValueType * + actualType : ValueType * + actualValue : Dval + + // CLEANUP same here^ + module Dicts = + type Error = + | TriedToAddKeyAfterAlreadyPresent of key : string + + /// Cannot add a {} ({}) to a dict of {} + | TriedToAddMismatchedData of + expectedType : ValueType * + actualType : ValueType * + actualValue : Dval + + module Records = + type Error = + | CreationEmptyKey + | CreationMissingField of fieldName : string + | CreationDuplicateField of fieldName : string + | CreationFieldOfWrongType of + fieldName : string * + expectedType : TypeReference * + actualType : ValueType + + | FieldAccessFieldNotFound of fieldName : string + | FieldAccessNotRecord of actualType : ValueType + + + + /// RuntimeError is the major way of representing errors in the runtime. These are + /// primarily used for things where the user made an error, such as a type error, + /// as opposed to a place where the runtime is flawed (use Exception.raiseInternal + /// for those). See docs/errors.md for detailed discussion. + /// CLEANUP rewrite this^ + /// + /// + /// TODO: this needs a way to be extensible + /// users should have _some_ way to add their own RuntimeErrors + /// and we don't want to have to rebuild everything to add a new RTE + type Error = + | TypeDoesntExist of FQTypeName.FQTypeName -// module TypeReference = -// let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = -// TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.result), [ t1; t2 ]) + | NameResolution of NameResolutionError -// let option (t : TypeReference) : TypeReference = -// TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.option), [ t ]) + | Bool of Bools.Error + | Int of Ints.Error + //| Json of Json.Error + | String of Strings.Error + | List of Lists.Error + | Dict of Dicts.Error + | Record of Records.Error + | Let of Lets.Error + // | Enum of Enum.Error + | MatchUnmatched + + + // /// "The condition for an `if` expression must be a `Bool`, + // /// but is here a `{someFn actualValueType}` (`{someFn actualValue}`)" + // | IfConditionNotBool of actualValue: Dval * actualValueType: ValueType + + // | Unwrap of Unwrap.Error + + | EqualityCheckOnIncompatibleTypes of left : ValueType * right : ValueType + + | ValueNotExpectedType of + actualValue : Dval * + expectedType : TypeReference * + context : TypeChecker.Context + + // | ExpectedBoolInCondition of Dval + | VariableNotFound of attemptedVarName : string + + + // //| SqlCompiler of SqlCompiler.Error // -- or maybe this should happen during PT2RT? hmm. + + // // lol aren't they all execution errors? + // // remove this level... + // | Execution of Execution.Error + + + // /// || only supports Booleans + // | OrOnlySupportsBooleans of gotInstead: Dval + + // /// && only supports Booleans + // | AndOnlySupportsBooleans of gotInstead: Dval + + + // //| Cli of Cli.Error + + + // TODO + + // backend/src/BuiltinExecution/Libs/NoModule.fs: + // - $"unwrap called with multiple arguments: {multipleArgs}" + + + // backend/src/LibCloud/SqlCompiler.fs: + // 1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) + // 1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) + + + // backend/src/LibExecution/Interpreter.fs: + // - "TODO" + // - $"Function {FQFnName.toString fnName} is not found" + + // backend/src/LibExecution/Interpreter.Old.fs: + // - "TODO" + // - $"Invalid const name: {msg}" + // - $"Expected {expectedLength} arguments, got {actualLength}" + // - $"Function {FQFnName.toString fnToCall} is not found") + // - "Unknown error" -module RuntimeError = - // let typeName = - // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.error - let toDT (RuntimeError e : RuntimeError) : Dval = e + // backend/src/LibExecution/NameResolutionError.fs: + // - "TODO" - let fromDT (dv : Dval) : RuntimeError = RuntimeError dv - // let case (caseName : string) (fields : List) : RuntimeError = - // DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError + // backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs: + // - "Couldn't find fn" + // - "Record must have at least one field" + // - "Match must have at least one case" - // let cliError field = case "CliError" [ field ] + // backend/src/LibExecution/TypeChecker.fs: - // let nameResolutionError field = case "NameResolutionError" [ field ] + //$"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" + | CannotMergeValues of left : ValueType * right : ValueType + // - $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" + // - $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" + // - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" + // - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" + // - "Empty key" + // - $"Duplicate key: {k}" - // let typeCheckerError field = case "TypeCheckerError" [ field ] - // let jsonError field = case "JsonError" [ field ] + // backend/tests/TestUtils/LibTest.fs: + // - update `Builtin.testRuntimeError` to take an `RTE` value instead of a string + // - update all usages - // let sqlCompilerRuntimeError (internalError : RuntimeError) = - // case "SqlCompilerRuntimeError" [ toDT internalError ] - // let executionError field = case "ExecutionError" [ field ] + // backend/src/LibCloud/SqlCompiler.fs: + // 1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) + // 1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) - // let intError field = case "IntError" [ field ] + + // /home/dark/app/backend/src/LibExecution/Interpreter.Old.fs + // - $"Empty key for value `{dv}`" + // - "Expected a record in record update" + // - "Field name is empty" + // - "When condition should be a boolean" -- this _could_ warn _or_ error. which? + // - $"Expected a record but {typeStr} is something else" + // - $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" + + // - "Attempting to access field '{fieldName}' of a Datastore + // (use `DB.*` standard library functions to interact with Datastores. Field access only work with records)" + + // incorrectArgs + + + + /// Sometimes, very-unexpected things happen. This is a catch-all for those. + /// For local/private runtimes+hosting, allow users to see the details, + /// but for _our_ hosting, users shouldn't see the whole call stack or + /// whatever, for (our) safety. But, they can use the error ID to refer to + /// the error in a support ticket. + | UncaughtException of reference : uuid + + + +module CallStack = + let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = + { entrypoint = entrypoint; lastCalled = (entrypoint, None) } + +module TypeReference = + let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = + TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.result), [ t1; t2 ]) + + let option (t : TypeReference) : TypeReference = + TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.option), [ t ]) - // TODO remove all usages of this in favor of better error cases - let oldError (msg : string) : RuntimeError = - //case "OldStringErrorTODO" [ DString msg ] - RuntimeError(DString msg) /// Note: in cases where it's awkward to niclude a CallStack, @@ -826,29 +944,30 @@ module RuntimeError = /// The tricky part is that we do want the CallStack around, to report on, /// and to use for debugging, but the way the Interpreter+Execution is set up, /// there's no great single place to `try/with` to supply the call stack. -exception RuntimeErrorException of Option * RuntimeError +exception RuntimeErrorException of Option * rte : RuntimeError.Error -let raiseRTE (callStack : CallStack) (rte : RuntimeError) : 'a = + +let raiseRTE (callStack : CallStack) (rte : RuntimeError.Error) : 'a = raise (RuntimeErrorException(Some callStack, rte)) -// (only?) OK in builtins because we "fill in" the callstack in the Interpreter for such failures -// CLEANUP maybe (somehow) restrict to only Builtins -let raiseUntargetedRTE (rte : RuntimeError) : 'a = - raise (RuntimeErrorException(None, rte)) +// let raiseRTE (callStack : CallStack) (rte : RuntimeError) : 'a = +// raise (RuntimeErrorException(Some callStack, rte)) +// // (only?) OK in builtins because we "fill in" the callstack in the Interpreter for such failures +// // CLEANUP maybe (somehow) restrict to only Builtins +// let raiseUntargetedRTE (rte : RuntimeError) : 'a = +// raise (RuntimeErrorException(None, rte)) -// TODO remove all usages of this in favor of better error cases -let raiseUntargetedString (s : string) : 'a = - raiseUntargetedRTE (RuntimeError.oldError s) /// Internally in the runtime, we allow throwing RuntimeErrorExceptions. At the -/// boundary, typically in Execution.fs, we will catch the exception, and return this -/// type. -type ExecutionResult = Result * RuntimeError> +/// boundary, typically in Execution.fs, we will catch the exception, and return +/// this type. +type ExecutionResult = Result * RuntimeError.Error> /// IncorrectArgs should never happen, as all functions are type-checked before /// calling. If it does happen, it means that the type parameters in the Fn structure /// do not match the args expected in the F# function definition. +/// CLEANUP should this take more args, so we can find the error? Maybe just the fn name? let incorrectArgs () = Exception.raiseInternal "IncorrectArgs" [] @@ -869,17 +988,17 @@ type Deprecation<'name> = | DeprecatedBecause of string -// module TypeDeclaration = -// type RecordField = { name : string; typ : TypeReference } +module TypeDeclaration = + type RecordField = { name : string; typ : TypeReference } -// type EnumCase = { name : string; fields : List } + //type EnumCase = { name : string; fields : List } -// type Definition = -// | Alias of TypeReference -// | Record of NEList -// | Enum of NEList + type Definition = + | Alias of TypeReference + | Record of NEList + //| Enum of NEList -// type T = { typeParams : List; definition : Definition } + type T = { typeParams : List; definition : Definition } @@ -933,19 +1052,19 @@ module Dval = pairs |> List.all (fun (v, subtype) -> r subtype v) | DDict(_vtTODO, m), TDict t -> Map.all (r t) m - // | DRecord(typeName, _, _typeArgsTODO, _fields), - // TCustomType(Ok typeName', _typeArgs) -> - // // TYPESCLEANUP: should load type by name - // // TYPESCLEANUP: are we handling type arguments here? - // // TYPESCLEANUP: do we need to check fields? - // typeName = typeName' + | DRecord(typeName, _, _typeArgsTODO, _fields), + TCustomType(Ok typeName', _typeArgs) -> + // TYPESCLEANUP: should load type by name + // TYPESCLEANUP: are we handling type arguments here? + // TYPESCLEANUP: do we need to check fields? + typeName = typeName' - // | DEnum(typeName, _, _typeArgsDEnumTODO, _casename, _fields), - // TCustomType(Ok typeName', _typeArgsExpected) -> - // // TYPESCLEANUP: should load type by name - // // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare - // // against the typeArgs in the DEnum - their zipped values should merge OK - // typeName = typeName' + | DEnum(_, typeName, _typeArgsDEnumTODO, _casename, _fields), + TCustomType(Ok typeName', _typeArgsExpected) -> + // TYPESCLEANUP: should load type by name + // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare + // against the typeArgs in the DEnum - their zipped values should merge OK + typeName = typeName' // | DFnVal(Lambda l), TFn(parameters, _) -> // NEList.length parameters = NEList.length l.parameters @@ -973,8 +1092,8 @@ module Dval = | DList _, _ | DTuple _, _ | DDict _, _ - // | DRecord _, _ - //| DEnum _, _ + | DRecord _, _ + | DEnum _, _ | DFnVal _, _ // | DDB _, _ -> false @@ -1009,11 +1128,11 @@ module Dval = KTTuple(toValueType first, toValueType second, List.map toValueType theRest) ) - // | DRecord(typeName, _, typeArgs, _) -> - // KTCustomType(typeName, typeArgs) |> ValueType.Known + | DRecord(typeName, _, typeArgs, _) -> + KTCustomType(typeName, typeArgs) |> ValueType.Known - // | DEnum(typeName, _, typeArgs, _, _) -> - // KTCustomType(typeName, typeArgs) |> ValueType.Known + | DEnum(typeName, _, typeArgs, _, _) -> + KTCustomType(typeName, typeArgs) |> ValueType.Known | DFnVal fnImpl -> match fnImpl with @@ -1027,139 +1146,50 @@ module Dval = // VTTODO look up type, etc | NamedFn _named -> ValueType.Unknown - // // CLEANUP follow up when DDB has a typeReference - // | DDB _ -> ValueType.Unknown - - - let asList (dv : Dval) : Option> = - match dv with - | DList(_, l) -> Some l - | _ -> None - - let asDict (dv : Dval) : Option> = - match dv with - | DDict(_, d) -> Some d - | _ -> None - - let asTuple2 (dv : Dval) : Option = - match dv with - | DTuple(first, second, _) -> Some(first, second) - | _ -> None - - let asTuple3 (dv : Dval) : Option = - match dv with - | DTuple(first, second, [ third ]) -> Some(first, second, third) - | _ -> None - - let asString (dv : Dval) : Option = - match dv with - | DString s -> Some s - | _ -> None - - let asInt8 (dv : Dval) : Option = - match dv with - | DInt8 i -> Some i - | _ -> None - - let asUInt8 (dv : Dval) : Option = - match dv with - | DUInt8 i -> Some i - | _ -> None - - let asInt16 (dv : Dval) : Option = - match dv with - | DInt16 i -> Some i - | _ -> None - - let asUInt16 (dv : Dval) : Option = - match dv with - | DUInt16 i -> Some i - | _ -> None - - let asInt32 (dv : Dval) : Option = - match dv with - | DInt32 i -> Some i - | _ -> None - - let asUInt32 (dv : Dval) : Option = - match dv with - | DUInt32 i -> Some i - | _ -> None - - let asInt64 (dv : Dval) : Option = - match dv with - | DInt64 i -> Some i - | _ -> None - - let asUInt64 (dv : Dval) : Option = - match dv with - | DUInt64 i -> Some i - | _ -> None - - let asInt128 (dv : Dval) : Option = - match dv with - | DInt128 i -> Some i - | _ -> None +// // CLEANUP follow up when DDB has a typeReference +// | DDB _ -> ValueType.Unknown - let asUInt128 (dv : Dval) : Option = - match dv with - | DUInt128 i -> Some i - | _ -> None - let asFloat (dv : Dval) : Option = - match dv with - | DFloat f -> Some f - | _ -> None - let asBool (dv : Dval) : Option = - match dv with - | DBool b -> Some b - | _ -> None - let asUuid (dv : Dval) : Option = - match dv with - | DUuid u -> Some u - | _ -> None +type Const = + | CUnit + | CBool of bool + | CInt8 of int8 + | CUInt8 of uint8 + | CInt16 of int16 + | CUInt16 of uint16 + | CInt32 of int32 + | CUInt32 of uint32 + | CInt64 of int64 + | CUInt64 of uint64 + | CInt128 of System.Int128 + | CUInt128 of System.UInt128 -// type Const = -// | CUnit -// | CBool of bool + | CFloat of Sign * string * string -// | CInt8 of int8 -// | CUInt8 of uint8 -// | CInt16 of int16 -// | CUInt16 of uint16 -// | CInt32 of int32 -// | CUInt32 of uint32 -// | CInt64 of int64 -// | CUInt64 of uint64 -// | CInt128 of System.Int128 -// | CUInt128 of System.UInt128 + | CChar of string + | CString of string -// | CFloat of Sign * string * string + | CList of List + | CTuple of first : Const * second : Const * rest : List + | CDict of List -// | CChar of string -// | CString of string + | CEnum of NameResolution * caseName : string * List -// | CList of List -// | CTuple of first : Const * second : Const * rest : List -// | CDict of List -// | CEnum of NameResolution * caseName : string * List +// ------------ +// Package-Space +// ------------ +module PackageType = + // TODO: hash + type PackageType = { id : uuid; declaration : TypeDeclaration.T } - -// // ------------ -// // Package-Space -// // ------------ -// module PackageType = -// // TODO: hash -// type PackageType = { id : uuid; declaration : TypeDeclaration.T } - -// module PackageConstant = -// // TODO: hash -// type PackageConstant = { id : uuid; body : Const } +module PackageConstant = + // TODO: hash + type PackageConstant = { id : uuid; body : Const } module PackageFn = type Parameter = { name : string; typ : TypeReference } @@ -1182,33 +1212,6 @@ module PackageFn = // module Secret = // type T = { name : string; value : string; version : int } -// module Handler = -// type CronInterval = -// | EveryDay -// | EveryWeek -// | EveryFortnight -// | EveryHour -// | Every12Hours -// | EveryMinute - -// type Spec = -// | HTTP of path : string * method : string -// | Worker of name : string -// | Cron of name : string * interval : CronInterval -// | REPL of name : string - -// type T = { tlid : tlid; ast : Expr; spec : Spec } - -// module Toplevel = -// type T = -// | TLHandler of Handler.T -// | TLDB of DB.T - -// let toTLID (tl : T) : tlid = -// match tl with -// | TLHandler h -> h.tlid -// | TLDB db -> db.tlid - // ------------ @@ -1241,57 +1244,57 @@ type Previewable = | Impure -// /// Used to mark whether a function has an equivalent that can be -// /// used within a Postgres query. -// type SqlSpec = -// /// Can be implemented, but we haven't yet -// | NotYetImplemented - -// /// This is not a function which can be queried -// | NotQueryable - -// /// A query function (it can't be called inside a query, but its argument can be a query) -// | QueryFunction +/// Used to mark whether a function has an equivalent that can be +/// used within a Postgres query. +type SqlSpec = + /// Can be implemented, but we haven't yet + | NotYetImplemented -// /// Can be implemented by a given builtin postgres 9.6 operator with 1 arg (eg `@ x`) -// | SqlUnaryOp of string + /// This is not a function which can be queried + | NotQueryable -// /// Can be implemented by a given builtin postgres 9.6 operator with 2 args (eg `x + y`) -// | SqlBinOp of string + /// A query function (it can't be called inside a query, but its argument can be a query) + | QueryFunction -// /// Can be implemented by a given builtin postgres 9.6 function -// | SqlFunction of string + /// Can be implemented by a given builtin postgres 9.6 operator with 1 arg (eg `@ x`) + | SqlUnaryOp of string -// /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go first -// | SqlFunctionWithPrefixArgs of string * List + /// Can be implemented by a given builtin postgres 9.6 operator with 2 args (eg `x + y`) + | SqlBinOp of string -// /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go last -// | SqlFunctionWithSuffixArgs of string * List + /// Can be implemented by a given builtin postgres 9.6 function + | SqlFunction of string -// /// Can be implemented by given callback that receives 1 SQLified-string argument -// /// | SqlCallback of (string -> string) -// /// Can be implemented by given callback that receives 2 SQLified-string argument -// | SqlCallback2 of (string -> string -> string) + /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go first + | SqlFunctionWithPrefixArgs of string * List -// member this.isQueryable() : bool = -// match this with -// | NotYetImplemented -// | NotQueryable -// | QueryFunction -> false -// | SqlUnaryOp _ -// | SqlBinOp _ -// | SqlFunction _ -// | SqlFunctionWithPrefixArgs _ -// | SqlFunctionWithSuffixArgs _ -// | SqlCallback2 _ -> true + /// Can be implemented by a given builtin postgres 9.6 function with extra arguments that go last + | SqlFunctionWithSuffixArgs of string * List + /// Can be implemented by given callback that receives 1 SQLified-string argument + /// | SqlCallback of (string -> string) + /// Can be implemented by given callback that receives 2 SQLified-string argument + | SqlCallback2 of (string -> string -> string) -// type BuiltInConstant = -// { name : FQConstantName.Builtin -// typ : TypeReference -// description : string -// deprecated : Deprecation -// body : Dval } + member this.isQueryable() : bool = + match this with + | NotYetImplemented + | NotQueryable + | QueryFunction -> false + | SqlUnaryOp _ + | SqlBinOp _ + | SqlFunction _ + | SqlFunctionWithPrefixArgs _ + | SqlFunctionWithSuffixArgs _ + | SqlCallback2 _ -> true + + +type BuiltInConstant = + { name : FQConstantName.Builtin + typ : TypeReference + description : string + deprecated : Deprecation + body : Dval } /// A built-in standard library function @@ -1306,7 +1309,7 @@ type BuiltInFn = description : string previewable : Previewable deprecated : Deprecation - //sqlSpec : SqlSpec + sqlSpec : SqlSpec fn : BuiltInFnSig } and Fn = @@ -1316,7 +1319,7 @@ and Fn = parameters : NEList returnType : TypeReference previewable : Previewable - //sqlSpec : SqlSpec + sqlSpec : SqlSpec /// /// May throw an exception, though we're trying to get them to never throw exceptions. @@ -1360,9 +1363,7 @@ and Tracing = { traceDval : TraceDval traceExecutionPoint : TraceExecutionPoint loadFnResult : LoadFnResult - storeFnResult : StoreFnResult - - callStack : CallStack } + storeFnResult : StoreFnResult } // Used for testing // TODO: maybe this belongs in Execution rather than RuntimeTypes? @@ -1376,7 +1377,7 @@ and TestContext = /// Functionally written in F# and shipped with the executable and Builtins = - { //constants : Map + { constants : Map fns : Map } /// Functionality written in Dark stored and managed outside of user space @@ -1387,17 +1388,17 @@ and Builtins = /// not yet in the Cloud PM. /// (though, we'll likely demand deps. in the PM before committing something upstream...) and PackageManager = - { //getType : FQTypeName.Package -> Ply> - //getConstant : - // FQConstantName.Package -> Ply> + { getType : FQTypeName.Package -> Ply> + getConstant : + FQConstantName.Package -> Ply> getFn : FQFnName.Package -> Ply> init : Ply } static member empty = - { //getType = (fun _ -> Ply None) + { getType = (fun _ -> Ply None) getFn = (fun _ -> Ply None) - //getConstant = (fun _ -> Ply None) + getConstant = (fun _ -> Ply None) init = uply { return () } } @@ -1405,21 +1406,20 @@ and PackageManager = /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras (pm : PackageManager) - //(types : List) - //(constants : List) + (types : List) + (constants : List) (fns : List) : PackageManager = - { - // getType = - // fun id -> - // match types |> List.tryFind (fun t -> t.id = id) with - // | Some t -> Some t |> Ply - // | None -> pm.getType id - // getConstant = - // fun id -> - // match constants |> List.tryFind (fun c -> c.id = id) with - // | Some c -> Some c |> Ply - // | None -> pm.getConstant id + { getType = + fun id -> + match types |> List.tryFind (fun t -> t.id = id) with + | Some t -> Some t |> Ply + | None -> pm.getType id + getConstant = + fun id -> + match constants |> List.tryFind (fun c -> c.id = id) with + | Some c -> Some c |> Ply + | None -> pm.getConstant id getFn = fun id -> match fns |> List.tryFind (fun f -> f.id = id) with @@ -1462,34 +1462,46 @@ and ExecutionState = types : Types fns : Functions - //availableConstants: Constants - + constants : Constants } and Registers = Dval array and VMState = - { // /// Program counter -- what instruction index are we pointing at? - //pc: int + { + /// Program counter -- what instruction index are we pointing at? + mutable pc : int instructions : Instruction array - registers : Registers + registers : Registers // mutable because array? resultReg : Register - symbolTable : Symtable - typeSymbolTable : TypeSymbolTable } + mutable callStack : CallStack - static member empty = - { instructions = Array.empty - registers = Array.empty - resultReg = 0 + mutable symbolTable : Symtable + mutable typeSymbolTable : TypeSymbolTable + } - symbolTable = Map.empty - typeSymbolTable = Map.empty } + // static member empty = + // { pc = 0 + // callStack = CallStack.fromEntryPoint(ExecutionPoint.BuiltIn) + + // instructions = Array.empty + // registers = Array.empty + // resultReg = 0 + + // symbolTable = Map.empty + // typeSymbolTable = Map.empty } - static member fromInstructions(instructions : InstructionsWithContext) : VMState = + static member fromInstructions + (entrypoint) + (instructions : InstructionsWithContext) + : VMState = let registersNeeded, instructions, resultReg = instructions - { instructions = List.toArray instructions + { pc = 0 + callStack = CallStack.fromEntryPoint entrypoint + + instructions = List.toArray instructions registers = Array.zeroCreate registersNeeded resultReg = resultReg @@ -1498,12 +1510,11 @@ and VMState = and Types = { typeSymbolTable : TypeSymbolTable - //package : FQTypeName.Package -> Ply> - } + package : FQTypeName.Package -> Ply> } -// and Constants = -// { builtIn : Map -// package : FQConstantName.Package -> Ply> } +and Constants = + { builtIn : Map + package : FQConstantName.Package -> Ply> } and Functions = { builtIn : Map @@ -1526,17 +1537,16 @@ and Functions = -// module Types = -// let empty = { typeSymbolTable = Map.empty; package = (fun _ -> Ply None) } +module Types = + let empty = { typeSymbolTable = Map.empty; package = (fun _ -> Ply None) } -// let find -// // TODO: swap these args -// (name : FQTypeName.FQTypeName) -// (types : Types) -// : Ply> = -// match name with -// | FQTypeName.Package pkg -> -// types.package pkg |> Ply.map (Option.map _.declaration) + let find + (types : Types) + (name : FQTypeName.FQTypeName) + : Ply> = + match name with + | FQTypeName.Package pkg -> + types.package pkg |> Ply.map (Option.map _.declaration) // /// Swap concrete types for type parameters // let rec substitute @@ -1589,24 +1599,6 @@ and Functions = -let rec getTypeReferenceFromAlias - (_types : Types) - (typ : TypeReference) - : Ply> = - match typ with - // | TCustomType(Ok outerTypeName, outerTypeArgs) -> - // uply { - // match! Types.find outerTypeName types with - // | Some { definition = TypeDeclaration.Alias typ; typeParams = typeParams } -> - // let typ = Types.substitute typeParams outerTypeArgs typ - // return! getTypeReferenceFromAlias types typ - // | _ -> return Ok typ - // } - - // | TCustomType(Error err, _) -> Ply(Error err) - - | _ -> Ply(Ok typ) - let consoleReporter : ExceptionReporter = fun _state (metadata : Metadata) (exn : exn) -> @@ -1630,7 +1622,7 @@ let builtInFnToFn (fn : BuiltInFn) : Fn = |> NEList.ofListUnsafe "builtInFnToFn" [ "name", fn.name ] returnType = fn.returnType previewable = fn.previewable - //sqlSpec = fn.sqlSpec + sqlSpec = fn.sqlSpec fn = BuiltInFunction fn.fn } let packageFnToFn (fn : PackageFn.PackageFn) : Fn = @@ -1641,5 +1633,5 @@ let packageFnToFn (fn : PackageFn.PackageFn) : Fn = parameters = fn.parameters |> NEList.map toParam returnType = fn.returnType previewable = Impure - //sqlSpec = NotQueryable + sqlSpec = NotQueryable fn = PackageFunction(fn.id, fn.body) } diff --git a/backend/src/LibExecution/RuntimeTypesAst.fs b/backend/src/LibExecution/RuntimeTypesAst.fs deleted file mode 100644 index 98a0014b84..0000000000 --- a/backend/src/LibExecution/RuntimeTypesAst.fs +++ /dev/null @@ -1,583 +0,0 @@ -/// Module to work with Runtime ASTs -module LibExecution.RuntimeTypesAst - -open System.Threading.Tasks -open FSharp.Control.Tasks - -open Prelude -open RuntimeTypes - -let rec preTraversal - (exprFn : Expr -> Expr) - (typeRefFn : TypeReference -> TypeReference) - (fqtnFn : FQTypeName.FQTypeName -> FQTypeName.FQTypeName) - (fqfnFn : FQFnName.FQFnName -> FQFnName.FQFnName) - (fqcnFn : FQConstantName.FQConstantName -> FQConstantName.FQConstantName) - (letPatternFn : LetPattern -> LetPattern) - (matchPatternFn : MatchPattern -> MatchPattern) - (expr : Expr) - : Expr = - - let rec preTraversalLetPattern (pat : LetPattern) : LetPattern = - let f = preTraversalLetPattern - match letPatternFn pat with - | LPVariable _ - | LPUnit _ -> letPatternFn pat - | LPTuple(id, p1, p2, pats) -> LPTuple(id, f p1, f p2, List.map f pats) - - let rec preTraverseMatchPattern (pat : MatchPattern) : MatchPattern = - let f = preTraverseMatchPattern - match matchPatternFn pat with - | MPVariable _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPChar _ - | MPFloat _ - | MPUnit _ -> pat - | MPList(id, pats) -> MPList(id, List.map f pats) - | MPTuple(id, p1, p2, pats) -> MPTuple(id, f p1, f p2, List.map f pats) - | MPEnum(id, name, pats) -> MPEnum(id, name, List.map f pats) - | MPListCons(id, head, tail) -> MPListCons(id, f head, f tail) - - let rec preTraversalTypeRef (typeRef : TypeReference) : TypeReference = - let f = preTraversalTypeRef - match typeRefFn typeRef with - | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TBool - | TUnit - | TFloat - | TChar - | TUuid - | TDateTime - | TVariable _ - | TString -> typeRef - | TList tr -> TList(f tr) - | TTuple(tr1, tr2, trs) -> TTuple(f tr1, f tr2, List.map f trs) - | TDB tr -> TDB(f tr) - | TCustomType(name, trs) -> TCustomType(Result.map fqtnFn name, List.map f trs) - | TDict(tr) -> TDict(f tr) - | TFn(trs, tr) -> TFn(NEList.map f trs, f tr) - - let f = - preTraversal exprFn typeRefFn fqtnFn fqfnFn fqcnFn letPatternFn matchPatternFn - - match exprFn expr with - | EInt64 _ - | EUInt64 _ - | EInt8 _ - | EUInt8 _ - | EInt16 _ - | EUInt16 _ - | EInt32 _ - | EUInt32 _ - | EInt128 _ - | EUInt128 _ - | EBool _ - | EChar _ - | EUnit _ - | EVariable _ - | EFloat _ -> expr - | EString(id, strs) -> - EString( - id, - strs - |> List.map (fun s -> - match s with - | StringText t -> StringText t - | StringInterpolation e -> StringInterpolation(f e)) - ) - | EConstant(id, name) -> EConstant(id, fqcnFn name) - | ELet(id, pat, rhs, next) -> ELet(id, preTraversalLetPattern pat, f rhs, f next) - | EIf(id, cond, ifexpr, elseexpr) -> - EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | ERecordFieldAccess(id, expr, fieldname) -> - ERecordFieldAccess(id, f expr, fieldname) - | EApply(id, name, typeArgs, args) -> - EApply(id, f name, List.map preTraversalTypeRef typeArgs, NEList.map f args) - | EFnName(id, name) -> EFnName(id, fqfnFn name) - | EAnd(id, left, right) -> EAnd(id, f left, f right) - | EOr(id, left, right) -> EOr(id, f left, f right) - | ELambda(id, names, expr) -> ELambda(id, names, f expr) - | EList(id, exprs) -> EList(id, List.map f exprs) - | EDict(id, pairs) -> EDict(id, List.map (fun (k, v) -> (k, f v)) pairs) - | ETuple(id, first, second, theRest) -> - ETuple(id, f first, f second, List.map f theRest) - | EEnum(id, typeName, caseName, fields) -> - EEnum(id, fqtnFn typeName, caseName, List.map f fields) - | EMatch(id, mexpr, cases) -> - EMatch( - id, - f mexpr, - NEList.map - (fun case -> - { pat = preTraverseMatchPattern case.pat - whenCondition = Option.map f case.whenCondition - rhs = f case.rhs }) - cases - ) - | ERecord(id, typeName, fields) -> - ERecord( - id, - fqtnFn typeName, - NEList.map (fun (name, expr) -> (name, f expr)) fields - ) - | ERecordUpdate(id, record, updates) -> - ERecordUpdate( - id, - f record, - NEList.map (fun (name, expr) -> (name, f expr)) updates - ) - | EError(id, msg, exprs) -> EError(id, msg, List.map f exprs) - -let rec postTraversal - (exprFn : Expr -> Expr) - (typeRefFn : TypeReference -> TypeReference) - (fqtnFn : FQTypeName.FQTypeName -> FQTypeName.FQTypeName) - (fqfnFn : FQFnName.FQFnName -> FQFnName.FQFnName) - (fqcnFn : FQConstantName.FQConstantName -> FQConstantName.FQConstantName) - (letPatternFn : LetPattern -> LetPattern) - (matchPatternFn : MatchPattern -> MatchPattern) - (expr : Expr) - : Expr = - - let rec postTraversalLetPattern (pat : LetPattern) : LetPattern = - let f = postTraversalLetPattern - match letPatternFn pat with - | LPVariable _ - | LPUnit _ -> letPatternFn pat - | LPTuple(id, p1, p2, pats) -> LPTuple(id, f p1, f p2, List.map f pats) - - let rec postTraverseMatchPattern (pat : MatchPattern) : MatchPattern = - let f = postTraverseMatchPattern - match matchPatternFn pat with - | MPVariable _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPChar _ - | MPFloat _ - | MPUnit _ -> pat - | MPList(id, pats) -> MPList(id, List.map f pats) - | MPTuple(id, p1, p2, pats) -> MPTuple(id, f p1, f p2, List.map f pats) - | MPEnum(id, name, pats) -> MPEnum(id, name, List.map f pats) - | MPListCons(id, head, tail) -> MPListCons(id, f head, f tail) - - let rec postTraversalTypeRef (typeRef : TypeReference) : TypeReference = - let f = postTraversalTypeRef - match typeRefFn typeRef with - | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TBool - | TUnit - | TFloat - | TChar - | TUuid - | TDateTime - | TVariable _ - | TString -> typeRef - | TList tr -> TList(f tr) - | TTuple(tr1, tr2, trs) -> TTuple(f tr1, f tr2, List.map f trs) - | TDB tr -> TDB(f tr) - | TCustomType(name, trs) -> TCustomType(Result.map fqtnFn name, List.map f trs) - | TDict(tr) -> TDict(f tr) - | TFn(trs, tr) -> TFn(NEList.map f trs, f tr) - - let f = - postTraversal exprFn typeRefFn fqtnFn fqfnFn fqcnFn letPatternFn matchPatternFn - (match expr with - | EInt64 _ - | EUInt64 _ - | EInt8 _ - | EUInt8 _ - | EInt16 _ - | EUInt16 _ - | EInt32 _ - | EUInt32 _ - | EInt128 _ - | EUInt128 _ - | EBool _ - | EChar _ - | EUnit _ - | EVariable _ - | EFloat _ -> expr - | EString(id, strs) -> - EString( - id, - strs - |> List.map (fun s -> - match s with - | StringText t -> StringText t - | StringInterpolation e -> StringInterpolation(f e)) - ) - | EConstant(id, name) -> EConstant(id, fqcnFn name) - | ELet(id, pat, rhs, next) -> ELet(id, postTraversalLetPattern pat, f rhs, f next) - | EIf(id, cond, ifexpr, elseexpr) -> - EIf(id, f cond, f ifexpr, Option.map f elseexpr) - | ERecordFieldAccess(id, expr, fieldname) -> - ERecordFieldAccess(id, f expr, fieldname) - | EApply(id, name, typeArgs, args) -> - EApply(id, f name, List.map postTraversalTypeRef typeArgs, NEList.map f args) - | EFnName(id, name) -> EFnName(id, fqfnFn name) - | EAnd(id, left, right) -> EAnd(id, f left, f right) - | EOr(id, left, right) -> EOr(id, f left, f right) - | ELambda(id, names, expr) -> ELambda(id, names, f expr) - | EList(id, exprs) -> EList(id, List.map f exprs) - | EDict(id, pairs) -> EDict(id, List.map (fun (k, v) -> (k, f v)) pairs) - | ETuple(id, first, second, theRest) -> - ETuple(id, f first, f second, List.map f theRest) - | EEnum(id, typeName, caseName, fields) -> - - EEnum(id, fqtnFn typeName, caseName, List.map f fields) - | EMatch(id, mexpr, cases) -> - EMatch( - id, - f mexpr, - NEList.map - (fun case -> - ({ pat = postTraverseMatchPattern case.pat - whenCondition = Option.map f case.whenCondition - rhs = f case.rhs })) - cases - ) - | ERecord(id, typeName, fields) -> - ERecord( - id, - fqtnFn typeName, - NEList.map (fun (name, expr) -> (name, f expr)) fields - ) - | ERecordUpdate(id, record, updates) -> - ERecordUpdate( - id, - f record, - NEList.map (fun (name, expr) -> (name, f expr)) updates - ) - | EError(id, msg, exprs) -> EError(id, msg, List.map f exprs)) - |> exprFn - - - -let rec postTraversalAsync - (exprFn : Expr -> Ply.Ply) - (typeRefFn : TypeReference -> Ply.Ply) - (fqtnFn : FQTypeName.FQTypeName -> Ply.Ply) - (fqfnFn : FQFnName.FQFnName -> Ply.Ply) - (fqcnFn : FQConstantName.FQConstantName -> Ply.Ply) - (letPatternFn : LetPattern -> Ply.Ply) - (matchPatternFn : MatchPattern -> Ply.Ply) - (expr : Expr) - : Ply.Ply = - - let rec postTraversalLetPattern (pat : LetPattern) : Ply.Ply = - uply { - let! pat = letPatternFn pat - let r = postTraversalLetPattern - match pat with - | LPVariable _ - | LPUnit _ -> return pat - | LPTuple(id, p1, p2, pats) -> - let! p1 = r p1 - let! p2 = r p2 - let! pats = Ply.List.mapSequentially r pats - return LPTuple(id, p1, p2, pats) - } - - let rec postTraverseMatchPattern (pat : MatchPattern) : Ply.Ply = - uply { - let! pat = matchPatternFn pat - - let r = postTraverseMatchPattern - match pat with - | MPVariable _ - | MPInt64 _ - | MPUInt64 _ - | MPInt8 _ - | MPUInt8 _ - | MPInt16 _ - | MPUInt16 _ - | MPInt32 _ - | MPUInt32 _ - | MPInt128 _ - | MPUInt128 _ - | MPBool _ - | MPString _ - | MPChar _ - | MPFloat _ - | MPUnit _ -> return pat - | MPList(id, pats) -> - let! pats = Ply.List.mapSequentially r pats - return MPList(id, pats) - | MPTuple(id, p1, p2, pats) -> - let! p1 = r p1 - let! p2 = r p2 - let! pats = Ply.List.mapSequentially r pats - return MPTuple(id, p1, p2, pats) - | MPEnum(id, name, pats) -> - let! pats = Ply.List.mapSequentially r pats - return MPEnum(id, name, pats) - | MPListCons(id, head, tail) -> - let! head = r head - let! tail = r tail - return MPListCons(id, head, tail) - } - - let rec postTraversalTypeRef (typeRef : TypeReference) : Ply.Ply = - uply { - let! typeRef = typeRefFn typeRef - let r = postTraversalTypeRef - match typeRef with - | TInt64 - | TUInt64 - | TInt8 - | TUInt8 - | TInt16 - | TUInt16 - | TInt32 - | TUInt32 - | TInt128 - | TUInt128 - | TBool - | TUnit - | TFloat - | TChar - | TUuid - | TDateTime - | TVariable _ - | TString -> return typeRef - | TList tr -> - let! tr = r tr - return TList(tr) - | TTuple(tr1, tr2, trs) -> - let! tr1 = r tr1 - let! tr2 = r tr2 - let! trs = Ply.List.mapSequentially r trs - return TTuple(tr1, tr2, trs) - | TDB tr -> - let! tr = r tr - return TDB(tr) - | TCustomType(name, trs) -> - let! trs = Ply.List.mapSequentially r trs - let! name = Ply.Result.map fqtnFn name - return TCustomType(name, trs) - | TDict(tr) -> - let! tr = r tr - return TDict(tr) - | TFn(trs, tr) -> - let! trs = Ply.NEList.mapSequentially r trs - let! tr = r tr - return TFn(trs, tr) - } - - uply { - let r = - postTraversalAsync - exprFn - typeRefFn - fqtnFn - fqfnFn - fqcnFn - letPatternFn - matchPatternFn - - let! expr = - match expr with - | EInt64 _ - | EUInt64 _ - | EInt8 _ - | EUInt8 _ - | EInt16 _ - | EUInt16 _ - | EInt32 _ - | EUInt32 _ - | EInt128 _ - | EUInt128 _ - | EBool _ - | EChar _ - | EUnit _ - | EVariable _ - | EFloat _ -> Ply expr - | EAnd(id, left, right) -> - uply { - let! left = r left - let! right = r right - return EAnd(id, left, right) - } - | EOr(id, left, right) -> - uply { - let! left = r left - let! right = r right - return EOr(id, left, right) - } - | ELambda(id, names, expr) -> - uply { - let! expr = r expr - return ELambda(id, names, expr) - } - | ELet(id, pat, rhs, next) -> - uply { - let! pat = postTraversalLetPattern pat - let! rhs = r rhs - let! next = r next - return ELet(id, pat, rhs, next) - } - | EList(id, exprs) -> - uply { - let! exprs = Ply.List.mapSequentially r exprs - return EList(id, exprs) - } - | ETuple(id, first, second, theRest) -> - uply { - let! first = r first - let! second = r second - let! theRest = Ply.List.mapSequentially r theRest - return ETuple(id, first, second, theRest) - } - | EIf(id, cond, ifexpr, elseexpr) -> - uply { - let! cond = r cond - let! ifexpr = r ifexpr - let! elseexpr = Ply.Option.map r elseexpr - return EIf(id, cond, ifexpr, elseexpr) - } - | EMatch(id, mexpr, cases) -> - uply { - let! mexpr = r mexpr - let! cases = - Ply.NEList.mapSequentially - (fun case -> - uply { - let! pattern = postTraverseMatchPattern case.pat - let! whenCondition = Ply.Option.map r case.whenCondition - let! expr = r case.rhs - return - { pat = pattern; whenCondition = whenCondition; rhs = expr } - }) - cases - return EMatch(id, mexpr, cases) - } - - | ERecord(id, typeName, fields) -> - uply { - let! fields = - Ply.NEList.mapSequentially - (fun (name, expr) -> - uply { - let! expr = r expr - return (name, expr) - }) - fields - return ERecord(id, typeName, fields) - } - | ERecordUpdate(id, record, updates) -> - uply { - let! record = r record - let! updates = - Ply.NEList.mapSequentially - (fun (name, expr) -> - uply { - let! expr = r expr - return (name, expr) - }) - updates - return ERecordUpdate(id, record, updates) - } - | EApply(id, name, typeArgs, args) -> - uply { - let! name = r name - let! typeArgs = Ply.List.mapSequentially postTraversalTypeRef typeArgs - let! args = Ply.NEList.mapSequentially r args - return EApply(id, name, typeArgs, args) - } - | EError(id, msg, exprs) -> - uply { - let! exprs = Ply.List.mapSequentially r exprs - return EError(id, msg, exprs) - } - | EDict(id, pairs) -> - uply { - let! pairs = - Ply.List.mapSequentially - (fun (k, v) -> - uply { - let! v = r v - return (k, v) - }) - pairs - return EDict(id, pairs) - } - | EFnName(id, name) -> - uply { - let! name = fqfnFn name - return EFnName(id, name) - } - | EConstant(id, name) -> - uply { - let! name = fqcnFn name - return EConstant(id, name) - } - | EEnum(id, typeName, caseName, fields) -> - uply { - let! typeName = fqtnFn typeName - let! fields = Ply.List.mapSequentially r fields - return EEnum(id, typeName, caseName, fields) - } - | ERecordFieldAccess(id, expr, fieldname) -> - uply { - let! expr = r expr - return ERecordFieldAccess(id, expr, fieldname) - } - - - | EString(id, strs) -> - uply { - let! strs = - Ply.List.mapSequentially - (fun s -> - uply { - match s with - | StringText t -> return (StringText t) - | StringInterpolation e -> - let! e = r e - return (StringInterpolation(e)) - }) - strs - return EString(id, strs) - } - - return! exprFn expr - } diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs index 59f46be9f3..704372648c 100644 --- a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs +++ b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs @@ -13,7 +13,7 @@ module C2DT = LibExecution.CommonToDarkTypes let ownerField m = m |> D.stringField "owner" let modulesField m = m |> D.stringListField "modules" let nameField m = m |> D.stringField "name" -let versionField m = m |> D.intField "version" +let versionField m = m |> D.int32Field "version" module FQTypeName = @@ -391,321 +391,321 @@ module StringSegment = | _ -> Exception.raiseInternal "Invalid StringSegment" [] -module Expr = - let typeName = FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.expr - let knownType = KTCustomType(typeName, []) - - let rec toDT (e : Expr) : Dval = - let (caseName, fields) = - match e with - | EUnit id -> "EUnit", [ DInt64(int64 id) ] - - | EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] - | EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] - | EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] - | EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] - | EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] - | EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] - | EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] - | EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] - | EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] - | EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] - | EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] - | EFloat(id, f) -> "EFloat", [ DInt64(int64 id); DFloat f ] - | EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] - | EString(id, segments) -> - let segments = - DList( - VT.known StringSegment.knownType, - List.map (StringSegment.toDT toDT) segments - ) - "EString", [ DInt64(int64 id); segments ] - - | EList(id, exprs) -> - "EList", [ DInt64(int64 id); Dval.list knownType (List.map toDT exprs) ] - - | EDict(id, entries) -> - let entries = - entries - |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) - |> fun entries -> - DList(VT.tuple VT.string (ValueType.known knownType) [], entries) - "EDict", [ DInt64(int64 id); entries ] - - | ETuple(id, first, second, theRest) -> - "ETuple", - [ DInt64(int64 id) - toDT first - toDT second - Dval.list knownType (List.map toDT theRest) ] - - | ERecord(id, typeName, fields) -> - let fields = - fields - |> NEList.toList - |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) - |> fun fields -> - DList(VT.tuple VT.string (ValueType.known knownType) [], fields) - "ERecord", [ DInt64(int64 id); FQTypeName.toDT typeName; fields ] - - | EEnum(id, typeName, caseName, fields) -> - "EEnum", - [ DInt64(int64 id) - FQTypeName.toDT typeName - DString caseName - Dval.list knownType (List.map toDT fields) ] - - // declaring and accessing variables - | ELet(id, lp, expr, body) -> - "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - - | ERecordFieldAccess(id, expr, fieldName) -> - "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] - - | EVariable(id, varName) -> "EVariable", [ DInt64(int64 id); DString varName ] - - - // control flow - | EIf(id, cond, thenExpr, elseExpr) -> - "EIf", - [ DInt64(int64 id) - toDT cond - toDT thenExpr - elseExpr |> Option.map toDT |> Dval.option knownType ] - - | EMatch(id, arg, cases) -> - let matchCaseTypeName = - FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.matchCase - - let cases = - cases - |> NEList.toList - |> List.map (fun case -> - let pattern = MatchPattern.toDT case.pat - let whenCondition = - case.whenCondition |> Option.map toDT |> Dval.option knownType - let expr = toDT case.rhs - DRecord( - matchCaseTypeName, - matchCaseTypeName, - [], - Map - [ ("pat", pattern) - ("whenCondition", whenCondition) - ("rhs", expr) ] - )) - |> Dval.list (KTCustomType(matchCaseTypeName, [])) - "EMatch", [ DInt64(int64 id); toDT arg; cases ] - - - | ELambda(id, pats, body) -> - let variables = - (NEList.toList pats) - |> List.map LetPattern.toDT - |> Dval.list (KTTuple(VT.int64, VT.string, [])) - "ELambda", [ DInt64(int64 id); variables; toDT body ] - - | EConstant(id, name) -> - "EConstant", [ DInt64(int64 id); FQConstantName.toDT name ] - - | EApply(id, expr, typeArgs, args) -> - let typeArgs = - typeArgs - |> List.map TypeReference.toDT - |> Dval.list TypeReference.knownType - let args = - Dval.list TypeReference.knownType (args |> NEList.toList |> List.map toDT) - "EApply", [ DInt64(int64 id); toDT expr; typeArgs; args ] - - | EFnName(id, name) -> "EFnName", [ DInt64(int64 id); FQFnName.toDT name ] - - | ERecordUpdate(id, record, updates) -> - let updates = - NEList.toList updates - |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) - |> Dval.list (KTTuple(VT.string, VT.known knownType, [])) - "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] - - | EAnd(id, left, right) -> "EAnd", [ DInt64(int64 id); toDT left; toDT right ] - - | EOr(id, left, right) -> "EOr", [ DInt64(int64 id); toDT left; toDT right ] - - // Let the error straight through - | EError(id, rtError, exprs) -> - "EError", - [ DInt64(int64 id) - RuntimeTypes.RuntimeError.toDT rtError - Dval.list knownType (List.map toDT exprs) ] - - - DEnum(typeName, typeName, [], caseName, fields) - - let rec fromDT (d : Dval) : Expr = - match d with - | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> EUnit(uint64 id) - - | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> EBool(uint64 id, b) - | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> EInt64(uint64 id, i) - | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> EUInt64(uint64 id, i) - | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> EInt8(uint64 id, i) - | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> EUInt8(uint64 id, i) - | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> EInt16(uint64 id, i) - | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> EUInt16(uint64 id, i) - | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> EInt32(uint64 id, i) - | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> EUInt32(uint64 id, i) - | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> EInt128(uint64 id, i) - | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> - EUInt128(uint64 id, i) - | DEnum(_, _, [], "EFloat", [ DInt64 id; DFloat f ]) -> EFloat(uint64 id, f) - | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> EChar(uint64 id, c) - | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> - EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) - - - | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> - EList(uint64 id, List.map fromDT inner) - - | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> - let pairs = - pairsList - // TODO: this should be a List.map, and raise an exception - |> List.collect (fun pair -> - match pair with - | DTuple(DString k, v, _) -> [ (k, fromDT v) ] - | _ -> []) // TODO: raise exception - EDict(uint64 id, pairs) - - - | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - - | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO1, fieldsList) ]) -> - let fields = - fieldsList - |> List.collect (fun field -> - match field with - | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] - | _ -> []) - ERecord( - uint64 id, - FQTypeName.fromDT typeName, - NEList.ofListUnsafe - "RT2DT.Expr.fromDT expected at least one field in ERecord" - [] - fields - ) - - | DEnum(_, - _, - [], - "EEnum", - [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> - EEnum(uint64 id, FQTypeName.fromDT typeName, caseName, List.map fromDT fields) - - | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> - ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - - | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> - ERecordFieldAccess(uint64 id, fromDT expr, fieldName) - - | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> - EVariable(uint64 id, varName) - - | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> - let elseExpr = - match elseExpr with - | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) - | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None - | _ -> - Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] - EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) - - | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> - let cases = - cases - |> List.collect (fun case -> - match case with - | DRecord(_, _, _, fields) -> - let whenCondition = - match Map.tryFind "whenCondition" fields with - | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) - | Some(DEnum(_, _, _, "None", [])) -> None - | _ -> None - match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with - | Some pat, Some rhs -> - [ { pat = MatchPattern.fromDT pat - whenCondition = whenCondition - rhs = fromDT rhs } ] - | _ -> [] - | _ -> []) - EMatch( - uint64 id, - fromDT arg, - NEList.ofListUnsafe - "RT2DT.Expr.fromDT expected at least one case in EMatch" - [] - cases - ) - - | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> - let pats = - pats - |> List.map LetPattern.fromDT - |> NEList.ofListUnsafe - "RT2DT.Expr.fromDT expected at least one bound variable in ELambda" - [] - ELambda(uint64 id, pats, fromDT body) - - - | DEnum(_, - _, - [], - "EApply", - [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> - let args = - NEList.ofListUnsafe - "RT2DT.Expr.fromDT expected at least one argument in EApply" - [] - args - - EApply( - uint64 id, - fromDT name, - List.map TypeReference.fromDT typeArgs, - NEList.map fromDT args - ) - - | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> - EFnName(uint64 id, FQFnName.fromDT name) - - | DEnum(_, _, [], "ERecordUpdate", [ DInt64 id; record; DList(_vtTODO, updates) ]) -> - let updates = - updates - |> List.collect (fun update -> - match update with - | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] - | _ -> []) - ERecordUpdate( - uint64 id, - fromDT record, - NEList.ofListUnsafe - "RT2DT.Expr.fromDT expected at least one field update in ERecordUpdate" - [] - updates - ) - - // now for EAnd, EOr and EError - | DEnum(_, _, [], "EAnd", [ DInt64 id; left; right ]) -> - EAnd(uint64 id, fromDT left, fromDT right) - - | DEnum(_, _, [], "EOr", [ DInt64 id; left; right ]) -> - EOr(uint64 id, fromDT left, fromDT right) - - | DEnum(_, _, [], "EError", [ DInt64 id; rtError; DList(_vtTODO, exprs) ]) -> - EError(uint64 id, RuntimeError.fromDT rtError, List.map fromDT exprs) - - - | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] +// module Expr = +// let typeName = FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.expr +// let knownType = KTCustomType(typeName, []) + +// let rec toDT (e : Expr) : Dval = +// let (caseName, fields) = +// match e with +// | EUnit id -> "EUnit", [ DInt64(int64 id) ] + +// | EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] +// | EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] +// | EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] +// | EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] +// | EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] +// | EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] +// | EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] +// | EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] +// | EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] +// | EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] +// | EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] +// | EFloat(id, f) -> "EFloat", [ DInt64(int64 id); DFloat f ] +// | EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] +// | EString(id, segments) -> +// let segments = +// DList( +// VT.known StringSegment.knownType, +// List.map (StringSegment.toDT toDT) segments +// ) +// "EString", [ DInt64(int64 id); segments ] + +// | EList(id, exprs) -> +// "EList", [ DInt64(int64 id); Dval.list knownType (List.map toDT exprs) ] + +// | EDict(id, entries) -> +// let entries = +// entries +// |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) +// |> fun entries -> +// DList(VT.tuple VT.string (ValueType.known knownType) [], entries) +// "EDict", [ DInt64(int64 id); entries ] + +// | ETuple(id, first, second, theRest) -> +// "ETuple", +// [ DInt64(int64 id) +// toDT first +// toDT second +// Dval.list knownType (List.map toDT theRest) ] + +// | ERecord(id, typeName, fields) -> +// let fields = +// fields +// |> NEList.toList +// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) +// |> fun fields -> +// DList(VT.tuple VT.string (ValueType.known knownType) [], fields) +// "ERecord", [ DInt64(int64 id); FQTypeName.toDT typeName; fields ] + +// | EEnum(id, typeName, caseName, fields) -> +// "EEnum", +// [ DInt64(int64 id) +// FQTypeName.toDT typeName +// DString caseName +// Dval.list knownType (List.map toDT fields) ] + +// // declaring and accessing variables +// | ELet(id, lp, expr, body) -> +// "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] + +// | ERecordFieldAccess(id, expr, fieldName) -> +// "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] + +// | EVariable(id, varName) -> "EVariable", [ DInt64(int64 id); DString varName ] + + +// // control flow +// | EIf(id, cond, thenExpr, elseExpr) -> +// "EIf", +// [ DInt64(int64 id) +// toDT cond +// toDT thenExpr +// elseExpr |> Option.map toDT |> Dval.option knownType ] + +// | EMatch(id, arg, cases) -> +// let matchCaseTypeName = +// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.matchCase + +// let cases = +// cases +// |> NEList.toList +// |> List.map (fun case -> +// let pattern = MatchPattern.toDT case.pat +// let whenCondition = +// case.whenCondition |> Option.map toDT |> Dval.option knownType +// let expr = toDT case.rhs +// DRecord( +// matchCaseTypeName, +// matchCaseTypeName, +// [], +// Map +// [ ("pat", pattern) +// ("whenCondition", whenCondition) +// ("rhs", expr) ] +// )) +// |> Dval.list (KTCustomType(matchCaseTypeName, [])) +// "EMatch", [ DInt64(int64 id); toDT arg; cases ] + + +// | ELambda(id, pats, body) -> +// let variables = +// (NEList.toList pats) +// |> List.map LetPattern.toDT +// |> Dval.list (KTTuple(VT.int64, VT.string, [])) +// "ELambda", [ DInt64(int64 id); variables; toDT body ] + +// | EConstant(id, name) -> +// "EConstant", [ DInt64(int64 id); FQConstantName.toDT name ] + +// | EApply(id, expr, typeArgs, args) -> +// let typeArgs = +// typeArgs +// |> List.map TypeReference.toDT +// |> Dval.list TypeReference.knownType +// let args = +// Dval.list TypeReference.knownType (args |> NEList.toList |> List.map toDT) +// "EApply", [ DInt64(int64 id); toDT expr; typeArgs; args ] + +// | EFnName(id, name) -> "EFnName", [ DInt64(int64 id); FQFnName.toDT name ] + +// | ERecordUpdate(id, record, updates) -> +// let updates = +// NEList.toList updates +// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) +// |> Dval.list (KTTuple(VT.string, VT.known knownType, [])) +// "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] + +// | EAnd(id, left, right) -> "EAnd", [ DInt64(int64 id); toDT left; toDT right ] + +// | EOr(id, left, right) -> "EOr", [ DInt64(int64 id); toDT left; toDT right ] + +// // Let the error straight through +// | EError(id, rtError, exprs) -> +// "EError", +// [ DInt64(int64 id) +// RuntimeTypes.RuntimeError.toDT rtError +// Dval.list knownType (List.map toDT exprs) ] + + +// DEnum(typeName, typeName, [], caseName, fields) + +// let rec fromDT (d : Dval) : Expr = +// match d with +// | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> EUnit(uint64 id) + +// | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> EBool(uint64 id, b) +// | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> EInt64(uint64 id, i) +// | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> EUInt64(uint64 id, i) +// | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> EInt8(uint64 id, i) +// | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> EUInt8(uint64 id, i) +// | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> EInt16(uint64 id, i) +// | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> EUInt16(uint64 id, i) +// | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> EInt32(uint64 id, i) +// | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> EUInt32(uint64 id, i) +// | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> EInt128(uint64 id, i) +// | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> +// EUInt128(uint64 id, i) +// | DEnum(_, _, [], "EFloat", [ DInt64 id; DFloat f ]) -> EFloat(uint64 id, f) +// | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> EChar(uint64 id, c) +// | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> +// EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) + + +// | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> +// EList(uint64 id, List.map fromDT inner) + +// | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> +// let pairs = +// pairsList +// // TODO: this should be a List.map, and raise an exception +// |> List.collect (fun pair -> +// match pair with +// | DTuple(DString k, v, _) -> [ (k, fromDT v) ] +// | _ -> []) // TODO: raise exception +// EDict(uint64 id, pairs) + + +// | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> +// ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + +// | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO1, fieldsList) ]) -> +// let fields = +// fieldsList +// |> List.collect (fun field -> +// match field with +// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] +// | _ -> []) +// ERecord( +// uint64 id, +// FQTypeName.fromDT typeName, +// NEList.ofListUnsafe +// "RT2DT.Expr.fromDT expected at least one field in ERecord" +// [] +// fields +// ) + +// | DEnum(_, +// _, +// [], +// "EEnum", +// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> +// EEnum(uint64 id, FQTypeName.fromDT typeName, caseName, List.map fromDT fields) + +// | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> +// ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) + +// | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> +// ERecordFieldAccess(uint64 id, fromDT expr, fieldName) + +// | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> +// EVariable(uint64 id, varName) + +// | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> +// let elseExpr = +// match elseExpr with +// | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) +// | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None +// | _ -> +// Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] +// EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) + +// | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> +// let cases = +// cases +// |> List.collect (fun case -> +// match case with +// | DRecord(_, _, _, fields) -> +// let whenCondition = +// match Map.tryFind "whenCondition" fields with +// | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) +// | Some(DEnum(_, _, _, "None", [])) -> None +// | _ -> None +// match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with +// | Some pat, Some rhs -> +// [ { pat = MatchPattern.fromDT pat +// whenCondition = whenCondition +// rhs = fromDT rhs } ] +// | _ -> [] +// | _ -> []) +// EMatch( +// uint64 id, +// fromDT arg, +// NEList.ofListUnsafe +// "RT2DT.Expr.fromDT expected at least one case in EMatch" +// [] +// cases +// ) + +// | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> +// let pats = +// pats +// |> List.map LetPattern.fromDT +// |> NEList.ofListUnsafe +// "RT2DT.Expr.fromDT expected at least one bound variable in ELambda" +// [] +// ELambda(uint64 id, pats, fromDT body) + + +// | DEnum(_, +// _, +// [], +// "EApply", +// [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> +// let args = +// NEList.ofListUnsafe +// "RT2DT.Expr.fromDT expected at least one argument in EApply" +// [] +// args + +// EApply( +// uint64 id, +// fromDT name, +// List.map TypeReference.fromDT typeArgs, +// NEList.map fromDT args +// ) + +// | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> +// EFnName(uint64 id, FQFnName.fromDT name) + +// | DEnum(_, _, [], "ERecordUpdate", [ DInt64 id; record; DList(_vtTODO, updates) ]) -> +// let updates = +// updates +// |> List.collect (fun update -> +// match update with +// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] +// | _ -> []) +// ERecordUpdate( +// uint64 id, +// fromDT record, +// NEList.ofListUnsafe +// "RT2DT.Expr.fromDT expected at least one field update in ERecordUpdate" +// [] +// updates +// ) + +// // now for EAnd, EOr and EError +// | DEnum(_, _, [], "EAnd", [ DInt64 id; left; right ]) -> +// EAnd(uint64 id, fromDT left, fromDT right) + +// | DEnum(_, _, [], "EOr", [ DInt64 id; left; right ]) -> +// EOr(uint64 id, fromDT left, fromDT right) + +// | DEnum(_, _, [], "EError", [ DInt64 id; rtError; DList(_vtTODO, exprs) ]) -> +// EError(uint64 id, RuntimeError.fromDT rtError, List.map fromDT exprs) + + +// | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] module RuntimeError = @@ -880,13 +880,13 @@ module FnValImpl = let toDT (fnValImpl : FnValImpl) : Dval = let (caseName, fields) = match fnValImpl with - | Lambda lambda -> "Lambda", [ LambdaImpl.toDT lambda ] + //| Lambda lambda -> "Lambda", [ LambdaImpl.toDT lambda ] | NamedFn fnName -> "NamedFn", [ FQFnName.toDT fnName ] DEnum(typeName, typeName, [], caseName, fields) let fromDT (d : Dval) : FnValImpl = match d with - | DEnum(_, _, [], "Lambda", [ lambda ]) -> Lambda(LambdaImpl.fromDT lambda) + //| DEnum(_, _, [], "Lambda", [ lambda ]) -> Lambda(LambdaImpl.fromDT lambda) | DEnum(_, _, [], "NamedFn", [ fnName ]) -> NamedFn(FQFnName.fromDT fnName) | _ -> Exception.raiseInternal "Invalid FnValImpl" [] diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index d6f26f3c64..dbb941936a 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -5,466 +5,342 @@ module LibExecution.TypeChecker open Prelude open RuntimeTypes module VT = ValueType - - -/// Returns `Ok ()` if no errors, or `Error first` otherwise -let combineErrorsUnit (l : NEList>) : Result = - l |> NEList.find Result.isError |> Option.unwrap (Ok()) - - -type Context = - | FunctionCallParameter of - fnName : FQFnName.FQFnName * - parameter : Param * - paramIndex : int - | FunctionCallResult of fnName : FQFnName.FQFnName * returnType : TypeReference - // | RecordField of - // recordTypeName : FQTypeName.FQTypeName * - // fieldName : string * - // fieldType : TypeReference - // | DictKey of key : string * typ : TypeReference - // | EnumField of - // enumTypeName : FQTypeName.FQTypeName * - // caseName : string * - // fieldIndex : int * - // fieldCount : int * - // fieldType : TypeReference - // | DBQueryVariable of varName : string * expected : TypeReference - // | DBSchemaType of name : string * expectedType : TypeReference - // | ListIndex of index : int * listTyp : TypeReference * parent : Context - // | TupleIndex of index : int * elementType : TypeReference * parent : Context - | FnValResult of returnType : TypeReference - - -type ErrorType = - // TODO? swap these fields - | ValueNotExpectedType of actualValue : Dval * expectedType : TypeReference -//| TypeDoesntExist of FQTypeName.FQTypeName - - -type Error = { errorType : ErrorType; context : Context } - - -module Error = - // module RT2DT = RuntimeTypesToDarkTypes - - // module Context = - // let typeName = - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.context - - // let rec toDT (context : Context) : Dval = - // let (caseName, fields) = - // match context with - // | FunctionCallParameter(fnName, param, paramIndex) -> - // "FunctionCallParameter", - // [ RT2DT.FQFnName.toDT fnName; RT2DT.Param.toDT param; DInt64 paramIndex ] - - // | FunctionCallResult(fnName, returnType) -> - // "FunctionCallResult", - // [ RT2DT.FQFnName.toDT fnName; RT2DT.TypeReference.toDT returnType ] - - // | RecordField(recordTypeName, fieldName, fieldType) -> - // "RecordField", - // [ RT2DT.FQTypeName.toDT recordTypeName - // DString fieldName - // RT2DT.TypeReference.toDT fieldType ] - - // | DictKey(key, typ) -> - // "DictKey", [ DString key; RT2DT.TypeReference.toDT typ ] - - // | EnumField(enumTypeName, caseName, fieldIndex, fieldCount, fieldType) -> - // "EnumField", - // [ RT2DT.FQTypeName.toDT enumTypeName - // DString caseName - // DInt64 fieldIndex - // DInt64 fieldCount - // RT2DT.TypeReference.toDT fieldType ] - - // | DBQueryVariable(varName, expected) -> - // "DBQueryVariable", [ DString varName; RT2DT.TypeReference.toDT expected ] - - // | DBSchemaType(name, expectedType) -> - // "DBSchemaType", [ DString name; RT2DT.TypeReference.toDT expectedType ] - - // | ListIndex(index, listTyp, parent) -> - // "ListIndex", - // [ DInt64 index; RT2DT.TypeReference.toDT listTyp; toDT parent ] - - // | TupleIndex(index, elementType, parent) -> - // "TupleIndex", - // [ DInt64 index; RT2DT.TypeReference.toDT elementType; toDT parent ] - - // | FnValResult(returnType) -> - // "FnValResult", [ RT2DT.TypeReference.toDT returnType ] - - // DEnum(typeName, typeName, [], caseName, fields) - - // module ErrorType = - // let typeName = - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.errorType - - // let toDT (et : ErrorType) : Dval = - // let (caseName, fields) = - // match et with - // | ValueNotExpectedType(actualValue, expectedType) -> - // "ValueNotExpectedType", - // [ actualValue |> RT2DT.Dval.toDT - // expectedType |> RT2DT.TypeReference.toDT ] - - // | TypeDoesntExist(typeName) -> - // "TypeDoesntExist", [ RT2DT.FQTypeName.toDT typeName ] - - // DEnum(typeName, typeName, [], caseName, fields) - - // let typeName = - // FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.TypeChecker.error - - let toRuntimeError (_e : Error) : RuntimeError = - // let fields = - // [ ("errorType", ErrorType.toDT e.errorType) - // ("context", Context.toDT e.context) ] - - // DRecord(typeName, typeName, [], Map fields) |> RuntimeError.typeCheckerError - RuntimeError.oldError "TODO" - - -let raiseValueNotExpectedType - (callStack : CallStack) - (dv : Dval) - (typ : TypeReference) - (context : Context) - : 'a = - { errorType = ValueNotExpectedType(dv, typ); context = context } - |> Error.toRuntimeError - |> raiseRTE callStack - -let raiseFnValResultNotExpectedType - (callStack : CallStack) - (dv : Dval) - (typ : TypeReference) - : 'a = - { errorType = ValueNotExpectedType(dv, typ); context = FnValResult(typ) } - |> Error.toRuntimeError - |> raiseRTE callStack - - - -let rec valueTypeUnifies - (tst : TypeSymbolTable) - (expected : TypeReference) - (actual : ValueType) - : Ply = - let r = valueTypeUnifies tst - - let rMult (expected : List) (actual : List) : Ply = - if List.length expected <> List.length actual then - Ply false - else - List.zip expected actual - |> Ply.List.foldSequentially - (fun acc (e, a) -> - match acc with - | false -> Ply acc - | true -> r e a) - true - - uply { - match expected, actual with - | _, ValueType.Unknown -> return true - - | TUnit, ValueType.Known KTUnit -> return true - | TBool, ValueType.Known KTBool -> return true - - | TInt8, ValueType.Known KTInt8 -> return true - | TUInt8, ValueType.Known KTUInt8 -> return true - | TInt16, ValueType.Known KTInt16 -> return true - | TUInt16, ValueType.Known KTUInt16 -> return true - | TInt32, ValueType.Known KTInt32 -> return true - | TUInt32, ValueType.Known KTUInt32 -> return true - | TInt64, ValueType.Known KTInt64 -> return true - | TUInt64, ValueType.Known KTUInt64 -> return true - | TInt128, ValueType.Known KTInt128 -> return true - | TUInt128, ValueType.Known KTUInt128 -> return true - - | TFloat, ValueType.Known KTFloat -> return true - - | TChar, ValueType.Known KTChar -> return true - | TString, ValueType.Known KTString -> return true - - // | TUuid, ValueType.Known KTUuid -> return true - // | TDateTime, ValueType.Known KTDateTime -> return true - - | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV - - | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV - - | TTuple(tFirst, tSecond, tRest), - ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> - let expected = tFirst :: tSecond :: tRest - let actual = vFirst :: vSecond :: vRest - return! rMult expected actual - - // | TCustomType(Error err, _), _ -> - // return - // Exception.raiseInternal - // $"Unexpected - can't unify valueType against unknown/error type reference" - // [ "err", err ] - // | TCustomType(Ok _typeNameT, _typeArgsT), - // ValueType.Known(KTCustomType(_typeNameV, _typeArgsV)) -> - // // TODO: follow up here when: - // // - type name aliases are and resolved - // // - type args are properly passed around and handled - - // // TODO: assert type names are the same, - // // after we've handled all type aliases - // //return! rMult typeArgsT typeArgsV - // return true - - // | TFn(_argTypes, _returnType), ValueType.Known(KTFn(_vArgs, _vRet)) -> - // // TODO: follow up here when type args are properly passed around and handled - - // // let expected = returnType :: (NEList.toList argTypes) - // // let actual = vRet :: (NEList.toList vArgs) - // // return! rMult expected actual - // return true - - //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV - - | TVariable name, _ -> - match Map.get name tst with - | None -> return true - | Some t -> return! r t actual - - | _, _ -> return false - } - -let rec unify - (context : Context) - (types : Types) - (tst : TypeSymbolTable) - (expected : TypeReference) - (value : Dval) - : Ply> = - uply { - match! getTypeReferenceFromAlias types expected with - | Error rte -> return Error rte - | Ok expected -> - match (expected, value) with - // // Any should be removed, but we currently allow it as a param type - // // in user functions, so we should allow it here. - // // - // // Potentially needs to be removed before we use this type checker for DBs? - // // - Could always have a type checking context that allows/disallows any - | TVariable name, _ -> - match Map.get name tst with - // for now, allow undefined type variables. In the future, we would create a - // type from the value and return any variables defined this way for usage in - // further arguments and return values. - | None -> return Ok() - | Some t -> return! unify context types tst t value - - | TBool, DBool _ -> return Ok() - | TUnit, DUnit -> return Ok() - - | TInt8, DInt8 _ -> return Ok() - | TUInt8, DUInt8 _ -> return Ok() - | TInt16, DInt16 _ -> return Ok() - | TUInt16, DUInt16 _ -> return Ok() - | TInt32, DInt32 _ -> return Ok() - | TUInt32, DUInt32 _ -> return Ok() - | TInt64, DInt64 _ -> return Ok() - | TUInt64, DUInt64 _ -> return Ok() - | TInt128, DInt128 _ -> return Ok() - | TUInt128, DUInt128 _ -> return Ok() - - | TFloat, DFloat _ -> return Ok() - - | TChar, DChar _ -> return Ok() - | TString, DString _ -> return Ok() - - | TDateTime, DDateTime _ -> return Ok() - | TUuid, DUuid _ -> return Ok() - - | TList expected, DList(actual, _dvs) -> - match! valueTypeUnifies tst expected actual with - | false -> - return - { errorType = ValueNotExpectedType(value, TList expected) - context = context } - |> Error.toRuntimeError - |> Error - - | true -> return! Ply() - - | TDict _expected, DDict(_actual, _entries) -> - // VTTODO uncomment this - // match! valueTypeUnifies tst expected actual with - // | false -> - // return - // ValueNotExpectedType(value, expected, context) - // |> Error.toRuntimeError - // |> Error - - // | true -> return! Ply() - return Ok() - - | TFn(_argTypes, _returnType), DFnVal _fnVal -> return Ok() // TYPESTODO check lambdas and fnVals - // | TTuple(t1, t2, tRest), DTuple(v1, v2, vRest) -> - // let ts = t1 :: t2 :: tRest - // let vs = v1 :: v2 :: vRest - // if List.length ts <> List.length vs then - // return - // { errorType = ValueNotExpectedType(value, expected); context = context } - // |> Error.toRuntimeError - // |> Error - // else - // // let! results = - // // List.zip ts vs - // // |> Ply.List.mapSequentiallyWithIndex (fun i (t, v) -> - // // let context = TupleIndex(i, t, context) - // // unify context types tst t v) - // // return combineErrorsUnit results - // // CLEANUP DTuple should include a TypeReference for each part, in which - // // case the type-checking here would just be a comparison of typeRefs. - // // (the construction of that DTuple should have already checked that the - // // types match) - // return Ok() - - // // TYPESCLEANUP: handle typeArgs - // | TCustomType(typeName, _typeArgs), value -> - - // match typeName with - // | Error rte -> return Error rte - // | Ok typeName -> - // match! Types.find typeName types with - // | None -> - // return - // { errorType = TypeDoesntExist(typeName); context = context } - // |> Error.toRuntimeError - // |> Error - // | Some ut -> - // let err = - // { errorType = ValueNotExpectedType(value, expected) - // context = context } - // |> Error.toRuntimeError - // |> Error - - // match ut, value with - // | { definition = TypeDeclaration.Alias aliasType }, _ -> - // let! resolvedAliasType = getTypeReferenceFromAlias types aliasType - - // match resolvedAliasType with - // | Error rte -> return Error rte - // | Ok resolvedAliasType -> - // return! unify context types tst resolvedAliasType value - - // | { definition = TypeDeclaration.Record _ }, - // DRecord(tn, _, _valueTypesTODO, _fields) -> - // // TYPESCLEANUP: this search should no longer be required - // let! aliasedType = - // getTypeReferenceFromAlias types (TCustomType(Ok tn, [])) - // match aliasedType with - // | Ok(TCustomType(Error rte, _)) -> return Error rte - // | Ok(TCustomType(Ok concreteTn, _typeArgs)) -> - // if concreteTn <> typeName then - // return - // { errorType = ValueNotExpectedType(value, expected) - // context = context } - // |> Error.toRuntimeError - // |> Error - // else - // // CLEANUP DRecord should include a TypeReference, in which case - // // the type-checking here would just be a `tField = dField` check. - // // (the construction of that DRecord should have already checked - // // that the fields match) - // return Ok() - // | _ -> return err - - // | { definition = TypeDeclaration.Enum cases }, - // DEnum(tn, _, _typeArgsDEnumTODO, caseName, valFields) -> - // // TODO: deal with aliased type? - // if tn <> typeName then - // return - // { errorType = ValueNotExpectedType(value, expected) - // context = context } - // |> Error.toRuntimeError - // |> Error - // else - // let matchingCase : Option = - // cases |> NEList.find (fun c -> c.name = caseName) - - // match matchingCase with - // | None -> return err - // | Some case -> - // if List.length case.fields = List.length valFields then - // // let! unified = - // // List.zip case.fields valFields - // // |> List.mapi (fun i (expected, actual) -> - // // let context = - // // EnumField( - // // tn, - // // expected, - // // case.name, - // // i, - // // Context.toLocation context - // // ) - // // unify context types tst expected.typ actual) - // // |> Ply.List.mapSequentially identity - - // // return combineErrorsUnit unified - // // CLEANUP DEnum should include a TypeReference, in which case - // // the type-checking here would just be a `tField = dField` check. - // // (the construction of that DEnum should have already checked - // // that the fields match) - // return Ok() - // else - // return err - // | _, _ -> return err - - // | TDB _, DDB _ -> return Ok() // TODO: check DB type - - // See https://github.com/darklang/dark/issues/4239#issuecomment-1175182695 - // TODO: exhaustiveness check - | TUnit, _ - | TBool, _ - - | TInt8, _ - | TUInt8, _ - | TInt16, _ - | TUInt16, _ - | TInt32, _ - | TUInt32, _ - | TInt64, _ - | TUInt64, _ - | TInt128, _ - | TUInt128, _ - - | TFloat, _ - - | TChar, _ - | TString, _ - - | TDateTime, _ - | TUuid, _ - - | TList _, _ - | TDict _, _ - | TTuple _, _ - - // | TCustomType _, _ - - | TVariable _, _ - - | TFn _, _ - // | TDB _, _ - -> - return - { errorType = ValueNotExpectedType(value, expected); context = context } - |> Error.toRuntimeError - |> Error - } +module RTE = RuntimeError + + +// /// Returns `Ok ()` if no errors, or `Error first` otherwise +// let combineErrorsUnit (l : NEList>) : Result = +// l |> NEList.find Result.isError |> Option.unwrap (Ok()) + + + + +// let rec getTypeReferenceFromAlias +// (_types : Types) +// (typ : TypeReference) +// : Ply> = +// match typ with +// // | TCustomType(Ok outerTypeName, outerTypeArgs) -> +// // uply { +// // match! Types.find outerTypeName types with +// // | Some { definition = TypeDeclaration.Alias typ; typeParams = typeParams } -> +// // let typ = Types.substitute typeParams outerTypeArgs typ +// // return! getTypeReferenceFromAlias types typ +// // | _ -> return Ok typ +// // } + +// // | TCustomType(Error err, _) -> Ply(Error err) + +// | _ -> Ply(Ok typ) + + + +// let rec valueTypeUnifies +// (tst : TypeSymbolTable) +// (expected : TypeReference) +// (actual : ValueType) +// : Ply = +// let r = valueTypeUnifies tst + +// let rMult (expected : List) (actual : List) : Ply = +// if List.length expected <> List.length actual then +// Ply false +// else +// List.zip expected actual +// |> Ply.List.foldSequentially +// (fun acc (e, a) -> +// match acc with +// | false -> Ply acc +// | true -> r e a) +// true + +// uply { +// match expected, actual with +// | _, ValueType.Unknown -> return true + +// | TUnit, ValueType.Known KTUnit -> return true +// | TBool, ValueType.Known KTBool -> return true + +// | TInt8, ValueType.Known KTInt8 -> return true +// | TUInt8, ValueType.Known KTUInt8 -> return true +// | TInt16, ValueType.Known KTInt16 -> return true +// | TUInt16, ValueType.Known KTUInt16 -> return true +// | TInt32, ValueType.Known KTInt32 -> return true +// | TUInt32, ValueType.Known KTUInt32 -> return true +// | TInt64, ValueType.Known KTInt64 -> return true +// | TUInt64, ValueType.Known KTUInt64 -> return true +// | TInt128, ValueType.Known KTInt128 -> return true +// | TUInt128, ValueType.Known KTUInt128 -> return true + +// | TFloat, ValueType.Known KTFloat -> return true + +// | TChar, ValueType.Known KTChar -> return true +// | TString, ValueType.Known KTString -> return true + +// // | TUuid, ValueType.Known KTUuid -> return true +// // | TDateTime, ValueType.Known KTDateTime -> return true + +// | TList innerT, ValueType.Known(KTList innerV) -> return! r innerT innerV + +// | TDict innerT, ValueType.Known(KTDict innerV) -> return! r innerT innerV + +// | TTuple(tFirst, tSecond, tRest), +// ValueType.Known(KTTuple(vFirst, vSecond, vRest)) -> +// let expected = tFirst :: tSecond :: tRest +// let actual = vFirst :: vSecond :: vRest +// return! rMult expected actual + +// // | TCustomType(Error err, _), _ -> +// // return +// // Exception.raiseInternal +// // $"Unexpected - can't unify valueType against unknown/error type reference" +// // [ "err", err ] +// // | TCustomType(Ok _typeNameT, _typeArgsT), +// // ValueType.Known(KTCustomType(_typeNameV, _typeArgsV)) -> +// // // TODO: follow up here when: +// // // - type name aliases are and resolved +// // // - type args are properly passed around and handled + +// // // TODO: assert type names are the same, +// // // after we've handled all type aliases +// // //return! rMult typeArgsT typeArgsV +// // return true + +// // | TFn(_argTypes, _returnType), ValueType.Known(KTFn(_vArgs, _vRet)) -> +// // // TODO: follow up here when type args are properly passed around and handled + +// // // let expected = returnType :: (NEList.toList argTypes) +// // // let actual = vRet :: (NEList.toList vArgs) +// // // return! rMult expected actual +// // return true + +// //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV + +// | TVariable name, _ -> +// match Map.get name tst with +// | None -> return true +// | Some t -> return! r t actual + +// | _, _ -> return false +// } + +// let rec unify +// (context : RTE.TypeChecker.Context) +// (types : Types) +// (tst : TypeSymbolTable) +// (expected : TypeReference) +// (value : Dval) +// : Ply> = +// uply { +// match! getTypeReferenceFromAlias types expected with +// | Error rte -> return Error rte +// | Ok expected -> +// match (expected, value) with +// // // Any should be removed, but we currently allow it as a param type +// // // in user functions, so we should allow it here. +// // // +// // // Potentially needs to be removed before we use this type checker for DBs? +// // // - Could always have a type checking context that allows/disallows any +// | TVariable name, _ -> +// match Map.get name tst with +// // for now, allow undefined type variables. In the future, we would create a +// // type from the value and return any variables defined this way for usage in +// // further arguments and return values. +// | None -> return Ok() +// | Some t -> return! unify context types tst t value + +// | TBool, DBool _ -> return Ok() +// | TUnit, DUnit -> return Ok() + +// | TInt8, DInt8 _ -> return Ok() +// | TUInt8, DUInt8 _ -> return Ok() +// | TInt16, DInt16 _ -> return Ok() +// | TUInt16, DUInt16 _ -> return Ok() +// | TInt32, DInt32 _ -> return Ok() +// | TUInt32, DUInt32 _ -> return Ok() +// | TInt64, DInt64 _ -> return Ok() +// | TUInt64, DUInt64 _ -> return Ok() +// | TInt128, DInt128 _ -> return Ok() +// | TUInt128, DUInt128 _ -> return Ok() + +// | TFloat, DFloat _ -> return Ok() + +// | TChar, DChar _ -> return Ok() +// | TString, DString _ -> return Ok() + +// | TDateTime, DDateTime _ -> return Ok() +// | TUuid, DUuid _ -> return Ok() + +// | TList expected, DList(actual, _dvs) -> +// match! valueTypeUnifies tst expected actual with +// | false -> +// return +// RTE.ValueNotExpectedType(value, TList expected, context) +// |> Error + +// | true -> return! Ply() + +// | TDict _expected, DDict(_actual, _entries) -> +// // VTTODO uncomment this +// // match! valueTypeUnifies tst expected actual with +// // | false -> +// // return +// // ValueNotExpectedType(value, expected, context) +// // |> Error.toRuntimeError +// // |> Error + +// // | true -> return! Ply() +// return Ok() + +// | TFn(_argTypes, _returnType), DFnVal _fnVal -> return Ok() // TYPESTODO check lambdas and fnVals +// // | TTuple(t1, t2, tRest), DTuple(v1, v2, vRest) -> +// // let ts = t1 :: t2 :: tRest +// // let vs = v1 :: v2 :: vRest +// // if List.length ts <> List.length vs then +// // return +// // { errorType = ValueNotExpectedType(value, expected); context = context } +// // |> Error.toRuntimeError +// // |> Error +// // else +// // // let! results = +// // // List.zip ts vs +// // // |> Ply.List.mapSequentiallyWithIndex (fun i (t, v) -> +// // // let context = TupleIndex(i, t, context) +// // // unify context types tst t v) +// // // return combineErrorsUnit results +// // // CLEANUP DTuple should include a TypeReference for each part, in which +// // // case the type-checking here would just be a comparison of typeRefs. +// // // (the construction of that DTuple should have already checked that the +// // // types match) +// // return Ok() + +// // TYPESCLEANUP: handle typeArgs +// | TCustomType(typeName, _typeArgs), value -> + +// match typeName with +// | Error rte -> return Error rte +// | Ok typeName -> +// match! Types.find typeName types with +// | None -> +// return +// RTE.TypeDoesntExist typeName +// |> Error +// | Some ut -> +// let err = +// RTE.ValueNotExpectedType(value, expected, context) +// |> Error + +// match ut, value with +// | { definition = TypeDeclaration.Alias aliasType }, _ -> +// let! resolvedAliasType = getTypeReferenceFromAlias types aliasType + +// match resolvedAliasType with +// | Error rte -> return Error rte +// | Ok resolvedAliasType -> +// return! unify context types tst resolvedAliasType value + +// | { definition = TypeDeclaration.Record _ }, +// DRecord(tn, _, _valueTypesTODO, _fields) -> +// // TYPESCLEANUP: this search should no longer be required +// let! aliasedType = +// getTypeReferenceFromAlias types (TCustomType(Ok tn, [])) +// match aliasedType with +// | Ok(TCustomType(Error rte, _)) -> return Error rte +// | Ok(TCustomType(Ok concreteTn, _typeArgs)) -> +// if concreteTn <> typeName then +// return +// RTE.ValueNotExpectedType(value, expected, context) +// |> Error +// else +// // CLEANUP DRecord should include a TypeReference, in which case +// // the type-checking here would just be a `tField = dField` check. +// // (the construction of that DRecord should have already checked +// // that the fields match) +// return Ok() +// | _ -> return err + +// // | { definition = TypeDeclaration.Enum cases }, +// // DEnum(tn, _, _typeArgsDEnumTODO, caseName, valFields) -> +// // // TODO: deal with aliased type? +// // if tn <> typeName then +// // return +// // { errorType = ValueNotExpectedType(value, expected) +// // context = context } +// // |> Error.toRuntimeError +// // |> Error +// // else +// // let matchingCase : Option = +// // cases |> NEList.find (fun c -> c.name = caseName) + +// // match matchingCase with +// // | None -> return err +// // | Some case -> +// // if List.length case.fields = List.length valFields then +// // // let! unified = +// // // List.zip case.fields valFields +// // // |> List.mapi (fun i (expected, actual) -> +// // // let context = +// // // EnumField( +// // // tn, +// // // expected, +// // // case.name, +// // // i, +// // // Context.toLocation context +// // // ) +// // // unify context types tst expected.typ actual) +// // // |> Ply.List.mapSequentially identity + +// // // return combineErrorsUnit unified +// // // CLEANUP DEnum should include a TypeReference, in which case +// // // the type-checking here would just be a `tField = dField` check. +// // // (the construction of that DEnum should have already checked +// // // that the fields match) +// // return Ok() +// // else +// // return err +// | _, _ -> return err + +// // | TDB _, DDB _ -> return Ok() // TODO: check DB type + +// // See https://github.com/darklang/dark/issues/4239#issuecomment-1175182695 +// // TODO: exhaustiveness check +// | TUnit, _ +// | TBool, _ + +// | TInt8, _ +// | TUInt8, _ +// | TInt16, _ +// | TUInt16, _ +// | TInt32, _ +// | TUInt32, _ +// | TInt64, _ +// | TUInt64, _ +// | TInt128, _ +// | TUInt128, _ + +// | TFloat, _ + +// | TChar, _ +// | TString, _ + +// | TDateTime, _ +// | TUuid, _ + +// | TList _, _ +// | TDict _, _ +// | TTuple _, _ + +// // | TCustomType _, _ + +// | TVariable _, _ + +// | TFn _, _ +// // | TDB _, _ +// -> +// return +// RTE.ValueNotExpectedType(value, expected, context) +// |> Error +// } @@ -488,41 +364,41 @@ let rec unify // // These will involve updates in both `checkFunctionCall` and `checkFunctionReturnType`. -let checkFunctionCall - (types : Types) - (tst : TypeSymbolTable) - (fn : Fn) - (args : NEList) - : Ply> = - // The interpreter checks these are the same length - fn.parameters - |> NEList.map2WithIndex - (fun i value param -> - let context = FunctionCallParameter(fn.name, param, i) - unify context types tst param.typ value) - args - |> Ply.NEList.mapSequentially identity - |> Ply.map combineErrorsUnit - - -let checkFunctionReturnType - (types : Types) - (tst : TypeSymbolTable) - (fn : Fn) - (result : Dval) - : Ply> = - let context = FunctionCallResult(fn.name, fn.returnType) - unify context types tst fn.returnType result +// let checkFunctionCall +// (types : Types) +// (tst : TypeSymbolTable) +// (fn : Fn) +// (args : NEList) +// : Ply> = +// // The interpreter checks these are the same length +// fn.parameters +// |> NEList.map2WithIndex +// (fun i value param -> +// let context = FunctionCallParameter(fn.name, param, i) +// unify context types tst param.typ value) +// args +// |> Ply.NEList.mapSequentially identity +// |> Ply.map combineErrorsUnit + + +// let checkFunctionReturnType +// (types : Types) +// (tst : TypeSymbolTable) +// (fn : Fn) +// (result : Dval) +// : Ply> = +// let context = FunctionCallResult(fn.name, fn.returnType) +// unify context types tst fn.returnType result /// Helpers for creating type-checked Dvals /// (lists, records, enums, etc.) /// /// Dvals should be created carefully: -/// - to have the correct valueTypes, where appropriate -/// i.e. we should not have DList(Known KTInt64, [ DString("hi") ]) +/// - to have the correct `ValueType`s, where appropriate +/// i.e. we should not have `DList(Known KTInt64, [ DString("hi") ])` /// -/// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes +/// - similarly, we should fail when trying to merge `Dval`s with conflicting `ValueType`s /// i.e. `List.append [1] ["hi"]` should fail /// because we can't merge `Known KTInt64` and `Known KTString` /// @@ -530,185 +406,176 @@ let checkFunctionReturnType /// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types /// of a Dval in some F# code). /// -/// TODO: review _all_ usages of these functions -/// /// TODO: ideally we don't require a callStack to be input here -- too much data-passing /// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) module DvalCreator = - let list - (callStack : CallStack) - (initialType : ValueType) - (list : List) - : Dval = - let (typ, dvs) = - List.fold + + let list (cs : CallStack) (typ : ValueType) (items : List) : Dval = + let (typ, items) = + items + |> List.fold (fun (typ, list) dv -> let dvalType = Dval.toValueType dv match VT.merge typ dvalType with | Ok newType -> newType, dv :: list | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" - |> raiseRTE callStack) - (initialType, []) - (List.rev list) - - DList(typ, dvs) - - - let dict (typ : ValueType) (entries : List) : Dval = - // TODO: dictPush, etc. - DDict(typ, Map entries) - -// // let dictFromMap (typ : ValueType) (entries : Map) : Dval = -// // // TODO: dictPush, etc. -// // DDict(typ, entries) - -// // CLEANUP - this fn was unused so I commented it out -// // remove? or will it be handy? -// // let dict (fields : List) : Dval = -// // // Give a warning for duplicate keys -// // List.fold -// // (DDict(Map.empty)) -// // (fun m (k, v) -> -// // match m, k, v with -// // // TYPESCLEANUP: remove hacks -// // // If we're propagating a fakeval keep doing it. We handle it without this line but let's be certain -// // | m, _k, _v when isFake m -> m -// // // Errors should propagate (but only if we're not already propagating an error) -// // | DDict _, _, v when isFake v -> v -// // // Skip empty rows -// // | _, "", _ -> DError(None, $"Empty key: {k}") -// // // Error if the key appears twice -// // | DDict m, k, _v when Map.containsKey k m -> -// // DError(None, $"Duplicate key: {k}") -// // // Otherwise add it -// // | DDict m, k, v -> DDict(Map.add k v m) -// // // If we haven't got a DDict we're propagating an error so let it go -// // | m, _, _ -> m) -// // fields - - - -// let optionSome (callStack : CallStack) (innerType : ValueType) (dv : Dval) : Dval = -// let typeName = Dval.optionType - -// let dvalType = Dval.toValueType dv - -// match VT.merge innerType dvalType with -// | Ok typ -> -// DEnum(typeName, typeName, Dval.ignoreAndUseEmpty [ typ ], "Some", [ dv ]) -// | Error() -> -// RuntimeError.oldError -// $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" -// |> raiseRTE callStack - -// let optionNone (innerType : ValueType) : Dval = -// DEnum( -// Dval.optionType, -// Dval.optionType, -// Dval.ignoreAndUseEmpty [ innerType ], -// "None", -// [] -// ) - -// let option -// (callStack : CallStack) -// (innerType : ValueType) -// (dv : Option) -// : Dval = -// match dv with -// | Some dv -> optionSome callStack innerType dv -// | None -> optionNone innerType - - - -// let resultOk -// (callStack : CallStack) -// (okType : ValueType) -// (errorType : ValueType) -// (dvOk : Dval) -// : Dval = -// let dvalType = Dval.toValueType dvOk -// match VT.merge okType dvalType with -// | Ok typ -> -// DEnum( -// Dval.resultType, -// Dval.resultType, -// Dval.ignoreAndUseEmpty [ typ; errorType ], -// "Ok", -// [ dvOk ] -// ) -// | Error() -> -// RuntimeError.oldError -// $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" -// |> raiseRTE callStack - -// let resultError -// (callStack : CallStack) -// (okType : ValueType) -// (errorType : ValueType) -// (dvError : Dval) -// : Dval = -// let dvalType = Dval.toValueType dvError -// match VT.merge errorType dvalType with -// | Ok typ -> -// DEnum( -// Dval.resultType, -// Dval.resultType, -// Dval.ignoreAndUseEmpty [ okType; typ ], -// "Error", -// [ dvError ] -// ) -// | Error() -> -// RuntimeError.oldError -// $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" -// |> raiseRTE callStack - -// let result -// (callStack : CallStack) -// (okType : ValueType) -// (errorType : ValueType) -// (dv : Result) -// : Dval = -// match dv with -// | Ok dv -> resultOk callStack okType errorType dv -// | Error dv -> resultError callStack okType errorType dv - - -// /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape -// /// -// /// note: if provided, the typeArgs must match the # of typeArgs expected by the type -// let record -// (callStack : CallStack) -// (typeName : FQTypeName.FQTypeName) -// (fields : List) -// : Ply = -// let resolvedTypeName = typeName // TODO: alias lookup, etc. + RTE.Lists.Error.TriedToAddMismatchedData(typ, dvalType, dv) + |> RTE.Error.List + |> raiseRTE cs) + (typ, []) -// let fields = -// List.fold -// (fun fields (k, v) -> -// match fields, k, v with -// // skip empty rows -// | _, "", _ -> raiseRTE callStack (RuntimeError.oldError "Empty key") + DList(typ, List.rev items) -// // error if the key appears twice -// | fields, k, _v when Map.containsKey k fields -> -// raiseRTE callStack (RuntimeError.oldError $"Duplicate key: {k}") -// // otherwise add it -// | fields, k, v -> Map.add k v fields) -// Map.empty -// fields + let dict + (cs : CallStack) + (typ : ValueType) + (entries : List) + : Dval = + let (typ, entries) = + List.fold + (fun (typ, entries) (k, v) -> + if Map.containsKey k entries then + // should we warn here instead? CLEANUP + RTE.Dicts.Error.TriedToAddKeyAfterAlreadyPresent k + |> RTE.Error.Dict + |> raiseRTE cs + + let vt = Dval.toValueType v + match VT.merge typ vt with + | Ok merged -> (merged, Map.add k v entries) + | Error() -> + RTE.Dicts.Error.TriedToAddMismatchedData(typ, vt, v) + |> RTE.Error.Dict + |> raiseRTE cs) -// // TODO: -// // - pass in a (types: Types) arg -// // - use it to determine type args of resultant Dval -// // - ensure fields match the expected shape (defined by type args and field defs) -// // - this process should also effect the type args of the resultant Dval -// DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply + (typ, Map.empty) + entries + + DDict(typ, entries) + + + + + let optionNone (innerType : ValueType) : Dval = + DEnum(Dval.optionType, Dval.optionType, [ innerType ], "None", []) + + let optionSome + (callStack : CallStack) + (expectedType : ValueType) + (dv : Dval) + : Dval = + let typeName = Dval.optionType + + let vt = Dval.toValueType dv + + match VT.merge expectedType vt with + | Ok typ -> DEnum(typeName, typeName, [ typ ], "Some", [ dv ]) + | Error() -> + // TODO this should be a more general Enum RTE + // (and make sure you include the Option wrapper type -- this loses that) + RuntimeError.CannotMergeValues(expectedType, vt) |> raiseRTE callStack + + let option + (callStack : CallStack) + (expectedType : ValueType) + (dv : Option) + : Dval = + match dv with + | Some dv -> optionSome callStack expectedType dv + | None -> optionNone expectedType + + + // module Result = + // let typeName = Dval.resultType + + // let ok + // (callStack : CallStack) + // (okType : ValueType) + // (errorType : ValueType) + // (dvOk : Dval) + // : Dval = + // let dvalType = Dval.toValueType dvOk + // match VT.merge okType dvalType with + // | Ok typ -> + // DEnum(typeName, typeName, [ typ; errorType ], "Ok", [ dvOk ]) + // | Error() -> + // // RuntimeError.oldError + // // $"Could not merge types {ValueType.toString (VT.customType typeName [ okType; errorType ])} and {ValueType.toString (VT.customType typeName [ dvalType; errorType ])}" + // |> raiseRTE callStack + + // let error + // (callStack : CallStack) + // (okType : ValueType) + // (errorType : ValueType) + // (dvError : Dval) + // : Dval = + // let dvalType = Dval.toValueType dvError + // match VT.merge errorType dvalType with + // | Ok typ -> DEnum(typeName, typeName, [ okType; typ ], "Error", [ dvError ]) + // | Error() -> + // RuntimeError.oldError + // $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" + // |> raiseRTE callStack + + // let result + // (callStack : CallStack) + // (okType : ValueType) + // (errorType : ValueType) + // (dv : Result) + // : Dval = + // match dv with + // | Ok dv -> ok callStack okType errorType dv + // | Error dv -> error callStack okType errorType dv + + + /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape + /// + /// note: if provided, the typeArgs must match the # of typeArgs expected by the type + /// + /// TODO this probably needs to both _take in_ and _return_ the typeSymbolTable + /// (just pass it in as a ref -- but if this is happening concurrently with something else, ...) + let record + (callStack : CallStack) + (_types : Types) // is this Types thing what we want, or should we split tst and types? + (typeName : FQTypeName.FQTypeName) + (_typeArgs : List) + (fields : List) + : Ply = + + // hmm we need to know what fields the type expects, so we can raise the right errors + // should that happen here, or in the interpreter? + // Besides the interpreter, the only usage (so far) is Json.fs + + let resolvedTypeName = typeName // TODO: alias lookup, etc. + + let fields = + List.fold + (fun fields (k, v) -> + match fields, k, v with + // skip empty rows + | _, "", _ -> + RTE.Records.CreationEmptyKey |> RTE.Record |> raiseRTE callStack + + // error if the key appears twice + | fields, k, _v when Map.containsKey k fields -> + RTE.Records.CreationDuplicateField k |> RTE.Record |> raiseRTE callStack + + // otherwise add it + | fields, k, v -> + // TODO CreationMissingField + // TODO CreationFieldOfWrongType + Map.add k v fields) + Map.empty + fields + + // TODO: + // - pass in a (types: Types) arg + // - use it to determine type args of resultant Dval + // - ensure fields match the expected shape (defined by type args and field defs) + // - this process should also effect the type args of the resultant Dval + DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply // let enum diff --git a/backend/src/LibExecution/ValueType.fs b/backend/src/LibExecution/ValueType.fs new file mode 100644 index 0000000000..1235d7a612 --- /dev/null +++ b/backend/src/LibExecution/ValueType.fs @@ -0,0 +1,159 @@ +/// helper functions related to RT.ValueType +[] +module LibExecution.ValueType + +open Prelude +open RuntimeTypes + +// some helpers to reduce typing elsewhere +let unknown = ValueType.Unknown +let unknownTODO = ValueType.Unknown +let unknownDbTODO = ValueType.Unknown +let typeArgsTODO = [] + +let known inner = ValueType.Known inner + +let unit = known KTUnit +let bool = known KTBool +let int8 = known KTInt8 +let uint8 = known KTUInt8 +let int16 = known KTInt16 +let uint16 = known KTUInt16 +let int32 = known KTInt32 +let uint32 = known KTUInt32 +let int64 = known KTInt64 +let uint64 = known KTUInt64 +let int128 = known KTInt128 +let uint128 = known KTUInt128 +let float = known KTFloat +let char = known KTChar +let string = known KTString +let dateTime = known KTDateTime +let uuid = known KTUuid + +let list (inner : ValueType) : ValueType = known (KTList inner) +let dict (inner : ValueType) : ValueType = known (KTDict inner) +let tuple + (first : ValueType) + (second : ValueType) + (theRest : List) + : ValueType = + KTTuple(first, second, theRest) |> known + +let customType + (typeName : FQTypeName.FQTypeName) + (typeArgs : List) + : ValueType = + KTCustomType(typeName, typeArgs) |> known + +// let rec toString (vt : ValueType) : string = +// match vt with +// | ValueType.Unknown -> "_" +// | ValueType.Known kt -> +// match kt with +// | KTUnit -> "Unit" +// | KTBool -> "Bool" +// | KTInt8 -> "Int8" +// | KTUInt8 -> "UInt8" +// | KTInt16 -> "Int16" +// | KTUInt16 -> "UInt16" +// | KTInt32 -> "Int32" +// | KTUInt32 -> "UInt32" +// | KTInt64 -> "Int64" +// | KTUInt64 -> "UInt64" +// | KTInt128 -> "Int128" +// | KTUInt128 -> "UInt128" +// | KTFloat -> "Float" +// | KTChar -> "Char" +// | KTString -> "String" +// | KTUuid -> "Uuid" +// | KTDateTime -> "DateTime" + +// | KTList inner -> $"List<{toString inner}>" +// | KTDict inner -> $"Dict<{toString inner}>" +// | KTTuple(first, second, theRest) -> +// first :: second :: theRest +// |> List.map toString +// |> String.concat " * " +// |> fun inner -> $"({inner})" + +// | KTCustomType(typeName, typeArgs) -> +// let typeArgsPart = +// match typeArgs with +// | [] -> "" +// | _ -> +// typeArgs +// |> List.map toString +// |> String.concat ", " +// |> fun inner -> $"<{inner}>" + +// $"{FQTypeName.toString typeName}{typeArgsPart}" + +// // | KTFn(args, ret) -> +// // NEList.toList args @ [ ret ] |> List.map toString |> String.concat " -> " + +// //| KTDB inner -> $"DB<{toString inner}>" + + +let rec private mergeKnownTypes + (left : KnownType) + (right : KnownType) + : Result = + let r = merge + match left, right with + | KTUnit, KTUnit -> KTUnit |> Ok + | KTBool, KTBool -> KTBool |> Ok + | KTInt8, KTInt8 -> KTInt8 |> Ok + | KTUInt8, KTUInt8 -> KTUInt8 |> Ok + | KTInt16, KTInt16 -> KTInt16 |> Ok + | KTUInt16, KTUInt16 -> KTUInt16 |> Ok + | KTInt32, KTInt32 -> KTInt32 |> Ok + | KTUInt32, KTUInt32 -> KTUInt32 |> Ok + | KTInt64, KTInt64 -> KTInt64 |> Ok + | KTUInt64, KTUInt64 -> KTUInt64 |> Ok + | KTInt128, KTInt128 -> KTInt128 |> Ok + | KTUInt128, KTUInt128 -> KTUInt128 |> Ok + | KTFloat, KTFloat -> KTFloat |> Ok + | KTChar, KTChar -> KTChar |> Ok + | KTString, KTString -> KTString |> Ok + | KTUuid, KTUuid -> KTUuid |> Ok + | KTDateTime, KTDateTime -> KTDateTime |> Ok + + | KTList left, KTList right -> r left right |> Result.map KTList + | KTDict left, KTDict right -> r left right |> Result.map KTDict + | KTTuple(l1, l2, ls), KTTuple(r1, r2, rs) -> + let firstMerged = r l1 r1 + let secondMerged = r l2 r2 + let restMerged = List.map2 r ls rs |> Result.collect + + match firstMerged, secondMerged, restMerged with + | Ok first, Ok second, Ok rest -> Ok(KTTuple(first, second, rest)) + | _ -> Error() + + | KTCustomType(lName, lArgs), KTCustomType(rName, rArgs) -> + if lName <> rName then + Error() + else if List.length lArgs <> List.length rArgs then + Error() + else + List.map2 r lArgs rArgs + |> Result.collect + |> Result.map (fun args -> KTCustomType(lName, args)) + + // | KTFn(lArgs, lRet), KTFn(rArgs, rRet) -> + // let argsMerged = NEList.map2 r lArgs rArgs |> Result.collectNE + // let retMerged = r lRet rRet + + // match argsMerged, retMerged with + // | Ok args, Ok ret -> Ok(KTFn(args, ret)) + // | _ -> Error() + + | _ -> Error() + +and merge (left : ValueType) (right : ValueType) : Result = + match left, right with + | ValueType.Unknown, v + | v, ValueType.Unknown -> Ok v + + | ValueType.Known left, ValueType.Known right -> + mergeKnownTypes left right |> Result.map ValueType.Known diff --git a/backend/src/LibHttpMiddleware/Http.fs b/backend/src/LibHttpMiddleware/Http.fs index 9d10f3a56e..365629c7d8 100644 --- a/backend/src/LibHttpMiddleware/Http.fs +++ b/backend/src/LibHttpMiddleware/Http.fs @@ -73,7 +73,7 @@ module Response = | Ok headers -> { statusCode = int code headers = lowercaseHeaderKeys headers - body = body |> Dval.DlistToByteArray } + body = body |> Dval.dlistToByteArray } | Error msg -> { statusCode = 500 headers = [ "Content-Type", "text/plain; charset=utf-8" ] diff --git a/backend/src/LibParser/FSharpToWrittenTypes.fs b/backend/src/LibParser/FSharpToWrittenTypes.fs index 84736bef21..766b3f1776 100644 --- a/backend/src/LibParser/FSharpToWrittenTypes.fs +++ b/backend/src/LibParser/FSharpToWrittenTypes.fs @@ -189,16 +189,16 @@ module MatchPattern = let id = gid () let r = fromSynPat - let convertEnumArg (ast : SynPat) : List = - // if the arg is a tuple with one paren around it, it's just arguments to the - // enum. But if it has two parens around it, it's a single tuple. - // eg: (Foo(1, 2)) vs (Foo((1, 2))) - match ast with - | SynPat.Paren(SynPat.Paren(SynPat.Tuple(_, t1 :: t2 :: trest, _, _), _), _) -> - [ WT.MPTuple(gid (), r t1, r t2, List.map r trest) ] - | SynPat.Paren(SynPat.Tuple(_, args, _, _), _) -> List.map r args - | SynPat.Tuple(_, args, _, _) -> List.map r args - | e -> [ r e ] + // let convertEnumArg (ast : SynPat) : List = + // // if the arg is a tuple with one paren around it, it's just arguments to the + // // enum. But if it has two parens around it, it's a single tuple. + // // eg: (Foo(1, 2)) vs (Foo((1, 2))) + // match ast with + // | SynPat.Paren(SynPat.Paren(SynPat.Tuple(_, t1 :: t2 :: trest, _, _), _), _) -> + // [ WT.MPTuple(gid (), r t1, r t2, List.map r trest) ] + // | SynPat.Paren(SynPat.Tuple(_, args, _, _), _) -> List.map r args + // | SynPat.Tuple(_, args, _, _) -> List.map r args + // | e -> [ r e ] match pat with | SynPat.Paren(pat, _) -> r pat @@ -247,16 +247,16 @@ module MatchPattern = // parse enum pattern -- requires type name to be included - | SynPat.LongIdent(SynLongIdent(names, _, _), _, _, SynArgPats.Pats args, _, _) -> - let enumName = - List.last names |> Exception.unwrapOptionInternal "missing enum name" [] - let modules = List.initial names |> List.map _.idText - if modules <> [] then - Exception.raiseInternal - "Module in enum pattern casename. Only use the casename in Enum patterns" - [ "pat", pat ] - let args = List.map convertEnumArg args |> List.concat - WT.MPEnum(id, enumName.idText, args) + // | SynPat.LongIdent(SynLongIdent(names, _, _), _, _, SynArgPats.Pats args, _, _) -> + // let enumName = + // List.last names |> Exception.unwrapOptionInternal "missing enum name" [] + // let modules = List.initial names |> List.map _.idText + // if modules <> [] then + // Exception.raiseInternal + // "Module in enum pattern casename. Only use the casename in Enum patterns" + // [ "pat", pat ] + // let args = List.map convertEnumArg args |> List.concat + // WT.MPEnum(id, enumName.idText, args) | SynPat.ArrayOrList(_, pats, _) -> WT.MPList(id, List.map r pats) diff --git a/backend/src/LibParser/NameResolver.fs b/backend/src/LibParser/NameResolver.fs index 53bc8049fe..4119bae7bc 100644 --- a/backend/src/LibParser/NameResolver.fs +++ b/backend/src/LibParser/NameResolver.fs @@ -7,7 +7,7 @@ module WT = WrittenTypes module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module RT = LibExecution.RuntimeTypes -module NRE = LibExecution.NameResolutionError +type NRE = PT.NameResolutionError /// If a name is not found, should we raise an exception? @@ -84,15 +84,12 @@ let resolveTypeName (currentModule : List) (name : WT.Name) : Ply> = - let err errType : PT.NameResolution = - Error { nameType = NRE.Type; errorType = errType } - match name with // TODO remodel things appropriately so this is not needed | WT.KnownBuiltin(_name, _version) -> Exception.raiseInternal "Builtin types don't exist" [] | WT.Unresolved given -> - let notFoundError = err (NRE.NotFound(NEList.toList given)) + let notFoundError = Error(NRE.NotFound(NEList.toList given)) let tryPackageName (name : PT.PackageType.Name) @@ -123,7 +120,7 @@ let resolveTypeName // parses `TypeName_v2` into `(TypeName, 2)`, or just `TypeName` into `(TypeName, 0)`. // TODO: ensure we're validating fully and reasonably (e.g. include module) match FS2WT.Expr.parseTypeName name with - | Error _ -> return err (NRE.InvalidPackageName(NEList.toList given)) + | Error _ -> return Error(NRE.InvalidName(NEList.toList given)) | Ok name -> let genericName = { modules = modules; name = name; version = 0 } @@ -153,14 +150,11 @@ let resolveConstantName (currentModule : List) (name : WT.Name) : Ply> = - let err errType : PT.NameResolution = - Error { nameType = NRE.Constant; errorType = errType } - match name with | WT.KnownBuiltin(name, version) -> Ok(PT.FQConstantName.fqBuiltIn name version) |> Ply | WT.Unresolved given -> - let notFoundError = err (NRE.NotFound(NEList.toList given)) + let notFoundError = Error(NRE.NotFound(NEList.toList given)) let tryPackageName (name : PT.PackageConstant.Name) @@ -198,7 +192,7 @@ let resolveConstantName let (modules, name) = NEList.splitLast given match FS2WT.Expr.parseFnName name with - | Error _ -> return err (NRE.InvalidPackageName(NEList.toList given)) + | Error _ -> return Error(NRE.InvalidName(NEList.toList given)) | Ok(name, version) -> let genericName = { modules = modules; name = name; version = version } @@ -227,13 +221,10 @@ let resolveFnName (currentModule : List) (name : WT.Name) : Ply> = - let err errType : PT.NameResolution = - Error { nameType = NRE.Function; errorType = errType } - match name with | WT.KnownBuiltin(name, version) -> Ok(PT.FQFnName.fqBuiltIn name version) |> Ply | WT.Unresolved given -> - let notFoundError = err (NRE.NotFound(NEList.toList given)) + let notFoundError = Error(NRE.NotFound(NEList.toList given)) let tryPackageName (name : PT.PackageFn.Name) @@ -270,7 +261,7 @@ let resolveFnName let (modules, name) = NEList.splitLast given match FS2WT.Expr.parseFnName name with - | Error _ -> return err (NRE.InvalidPackageName(NEList.toList given)) + | Error _ -> return Error(NRE.InvalidName(NEList.toList given)) | Ok(name, version) -> let genericName = { modules = modules; name = name; version = version } diff --git a/backend/src/LibParser/WrittenTypes.fs b/backend/src/LibParser/WrittenTypes.fs index ec81589fda..c33170f413 100644 --- a/backend/src/LibParser/WrittenTypes.fs +++ b/backend/src/LibParser/WrittenTypes.fs @@ -82,7 +82,7 @@ type MatchPattern = | MPVariable of id * string - | MPEnum of id * caseName : string * fieldPats : List +//| MPEnum of id * caseName : string * fieldPats : List type BinaryOperation = | BinOpAnd @@ -137,7 +137,7 @@ type TypeReference = | TFn of NEList * TypeReference - | TDB of TypeReference + //| TDB of TypeReference | TVariable of string diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index d96278be83..92ebc38280 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -7,7 +7,7 @@ module WT = WrittenTypes module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes module FS2WT = FSharpToWrittenTypes -module NRE = LibExecution.NameResolutionError +type NRE = PT.NameResolutionError module NR = NameResolver module InfixFnName = @@ -75,7 +75,7 @@ module TypeReference = 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 |> Ply.map PT.TDB | WT.TVariable(name) -> return PT.TVariable(name) } @@ -104,8 +104,8 @@ module MatchPattern = let rec toPT (p : WT.MatchPattern) : PT.MatchPattern = match p with | WT.MPVariable(id, str) -> PT.MPVariable(id, str) - | WT.MPEnum(id, caseName, fieldPats) -> - PT.MPEnum(id, caseName, List.map toPT fieldPats) + // | WT.MPEnum(id, caseName, fieldPats) -> + // PT.MPEnum(id, caseName, List.map toPT fieldPats) | WT.MPInt64(id, i) -> PT.MPInt64(id, i) | WT.MPUInt64(id, i) -> PT.MPUInt64(id, i) | WT.MPInt8(id, i) -> PT.MPInt8(id, i) @@ -136,12 +136,7 @@ module Expr = (caseName : string) // used for errors : Ply> = match names with - | [] -> - Ply( - Error( - { nameType = NRE.Type; errorType = NRE.MissingEnumModuleName caseName } - ) - ) + | [] -> Ply(Error(NRE.InvalidName [ caseName ])) | head :: tail -> let name = NEList.ofList head tail |> WT.Unresolved NR.resolveTypeName pm onMissing currentModule name @@ -178,20 +173,21 @@ module Expr = | WT.EBool(id, b) -> return PT.EBool(id, b) | WT.EUnit id -> return PT.EUnit id | WT.EVariable(id, var) -> - // This could be a UserConstant - let! constant = - NR.resolveConstantName - (builtins.constants |> Map.keys |> Set) - pm - NR.OnMissing.Allow - currentModule - (WT.Unresolved(NEList.singleton var)) - match constant with - | Ok _ as name -> return PT.EConstant(id, name) - | Error _ -> return PT.EVariable(id, var) - | WT.ERecordFieldAccess(id, obj, fieldname) -> - let! obj = toPT obj - return PT.ERecordFieldAccess(id, obj, fieldname) + // // This could be a UserConstant + // let! constant = + // NR.resolveConstantName + // (builtins.constants |> Map.keys |> Set) + // pm + // NR.OnMissing.Allow + // currentModule + // (WT.Unresolved(NEList.singleton var)) + // match constant with + // | Ok _ as name -> return PT.EConstant(id, name) + // | Error _ -> + return PT.EVariable(id, var) + // | WT.ERecordFieldAccess(id, obj, fieldname) -> + // let! obj = toPT obj + // return PT.ERecordFieldAccess(id, obj, fieldname) | WT.EApply(id, (WT.EFnName(_, name)), [], { head = WT.EPlaceHolder }) -> // There are no arguments, so this could be a function name or a constant let! fnName = @@ -350,78 +346,78 @@ module Expr = toPT builtins pm onMissing currentModule expr |> Ply.map (fun interpolated -> PT.StringInterpolation interpolated) - and pipeExprToPT - (builtins : RT.Builtins) - (pm : PT.PackageManager) - (onMissing : NR.OnMissing) - (currentModule : List) - (pipeExpr : WT.PipeExpr) - : Ply = - let toPT = toPT builtins pm onMissing currentModule - - uply { - match pipeExpr with - | WT.EPipeVariableOrFnCall(id, name) -> - let! resolved = - let asUserFnName = WT.Name.Unresolved(NEList.singleton name) - NR.resolveFnName - (builtins.fns |> Map.keys |> Set) - pm - NR.OnMissing.Allow - currentModule - asUserFnName - - return - match resolved with - | Ok name -> PT.EPipeFnCall(id, Ok name, [], []) - | Error _ -> PT.EPipeVariable(id, name, []) - - | WT.EPipeLambda(id, pats, body) -> - let! body = toPT body - return PT.EPipeLambda(id, NEList.map LetPattern.toPT pats, body) - - | WT.EPipeInfix(id, infix, first) -> - let! first = toPT first - return PT.EPipeInfix(id, Infix.toPT infix, first) - - | WT.EPipeFnCall(id, - (WT.Unresolved { head = varName; tail = [] } as name), - [], - args) -> - // Special case for variables with arguments. Since it could be a userfn, we - // need to check that first. We do a similar thing converting EFnNames. - let! fnName = - NR.resolveFnName - (builtins.fns |> Map.keys |> Set) - pm - NR.OnMissing.Allow - currentModule - name - let! args = Ply.List.mapSequentially toPT args - match fnName with - | Ok name -> return PT.EPipeFnCall(id, Ok name, [], args) - | Error _ -> return PT.EPipeVariable(id, varName, args) - - | WT.EPipeFnCall(id, name, typeArgs, args) -> - let! fnName = - NR.resolveFnName - (builtins.fns |> Map.keys |> Set) - pm - onMissing - currentModule - name - let! typeArgs = - Ply.List.mapSequentially - (TypeReference.toPT pm onMissing currentModule) - typeArgs - let! args = Ply.List.mapSequentially toPT 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 fields - return PT.EPipeEnum(id, typeName, caseName, fields) - } +// and pipeExprToPT +// (builtins : RT.Builtins) +// (pm : PT.PackageManager) +// (onMissing : NR.OnMissing) +// (currentModule : List) +// (pipeExpr : WT.PipeExpr) +// : Ply = +// let toPT = toPT builtins pm onMissing currentModule + +// uply { +// match pipeExpr with +// | WT.EPipeVariableOrFnCall(id, name) -> +// let! resolved = +// let asUserFnName = WT.Name.Unresolved(NEList.singleton name) +// NR.resolveFnName +// (builtins.fns |> Map.keys |> Set) +// pm +// NR.OnMissing.Allow +// currentModule +// asUserFnName + +// return +// match resolved with +// | Ok name -> PT.EPipeFnCall(id, Ok name, [], []) +// | Error _ -> PT.EPipeVariable(id, name, []) + +// | WT.EPipeLambda(id, pats, body) -> +// let! body = toPT body +// return PT.EPipeLambda(id, NEList.map LetPattern.toPT pats, body) + +// | WT.EPipeInfix(id, infix, first) -> +// let! first = toPT first +// return PT.EPipeInfix(id, Infix.toPT infix, first) + +// | WT.EPipeFnCall(id, +// (WT.Unresolved { head = varName; tail = [] } as name), +// [], +// args) -> +// // Special case for variables with arguments. Since it could be a userfn, we +// // need to check that first. We do a similar thing converting EFnNames. +// let! fnName = +// NR.resolveFnName +// (builtins.fns |> Map.keys |> Set) +// pm +// NR.OnMissing.Allow +// currentModule +// name +// let! args = Ply.List.mapSequentially toPT args +// match fnName with +// | Ok name -> return PT.EPipeFnCall(id, Ok name, [], args) +// | Error _ -> return PT.EPipeVariable(id, varName, args) + +// | WT.EPipeFnCall(id, name, typeArgs, args) -> +// let! fnName = +// NR.resolveFnName +// (builtins.fns |> Map.keys |> Set) +// pm +// onMissing +// currentModule +// name +// let! typeArgs = +// Ply.List.mapSequentially +// (TypeReference.toPT pm onMissing currentModule) +// typeArgs +// let! args = Ply.List.mapSequentially toPT 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 fields +// return PT.EPipeEnum(id, typeName, caseName, fields) +// } module Const = let rec toPT diff --git a/backend/src/LocalExec/LocalExec.fsproj b/backend/src/LocalExec/LocalExec.fsproj index dc5c3e8cbe..ca4233d8df 100644 --- a/backend/src/LocalExec/LocalExec.fsproj +++ b/backend/src/LocalExec/LocalExec.fsproj @@ -16,14 +16,14 @@ - + - - + + diff --git a/backend/src/Prelude/Prelude.fsproj b/backend/src/Prelude/Prelude.fsproj index b8924afba6..747ecff2d0 100644 --- a/backend/src/Prelude/Prelude.fsproj +++ b/backend/src/Prelude/Prelude.fsproj @@ -18,6 +18,7 @@ + diff --git a/backend/src/Prelude/StringBuilder.fs b/backend/src/Prelude/StringBuilder.fs new file mode 100644 index 0000000000..e34e8902d7 --- /dev/null +++ b/backend/src/Prelude/StringBuilder.fs @@ -0,0 +1,6 @@ +module StringBuilder + +open System.Text + +let append (sb : StringBuilder) (s: string): unit = + sb.Append s |> ignore diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index ac5e95c41b..f3df406eb0 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -13,7 +13,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module PT = LibExecution.ProgramTypes module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes @@ -26,24 +26,24 @@ module PackageIDs = LibExecution.PackageIDs //let varB = TVariable "b" -// let constants : List = -// [ { name = constant "testNan" 0 -// typ = TFloat -// description = "Return a NaN" -// body = DFloat(System.Double.NaN) -// deprecated = NotDeprecated } +let constants : List = + [ { name = constant "testNan" 0 + typ = TFloat + description = "Return a NaN" + body = DFloat(System.Double.NaN) + deprecated = NotDeprecated } -// { name = constant "testInfinity" 0 -// typ = TFloat -// description = "Returns positive infitity" -// body = DFloat(System.Double.PositiveInfinity) -// deprecated = NotDeprecated } + { name = constant "testInfinity" 0 + typ = TFloat + description = "Returns positive infitity" + body = DFloat(System.Double.PositiveInfinity) + deprecated = NotDeprecated } -// { name = constant "testNegativeInfinity" 0 -// typ = TFloat -// description = "Returns negative infinity" -// body = DFloat(System.Double.NegativeInfinity) -// deprecated = NotDeprecated } ] + { name = constant "testNegativeInfinity" 0 + typ = TFloat + description = "Returns negative infinity" + body = DFloat(System.Double.NegativeInfinity) + deprecated = NotDeprecated } ] let fns : List = [ @@ -277,4 +277,4 @@ let fns : List = // deprecated = NotDeprecated } ] -let builtins = LibExecution.Builtin.make fns +let builtins = LibExecution.Builtin.make constants fns diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 35603a5d74..ab0a5d64b7 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -4,6 +4,10 @@ module TestUtils.PTShortcuts open Prelude open LibExecution.ProgramTypes + +let typeNamePkg id = FQTypeName.fqPackage id + + let eUnit () : Expr = EUnit(gid ()) let eBool (b : bool) : Expr = EBool(gid (), b) @@ -52,12 +56,15 @@ let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = let eMatch (expr : Expr) (cases : List) : Expr = EMatch(gid (), expr, cases) -// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = -// ERecordFieldAccess(gid (), expr, fieldName) +let eRecord + (typeName : FQTypeName.FQTypeName) + (typeArgs : List) + (fields : List) + : Expr = + ERecord(gid (), Ok typeName, typeArgs, fields) -// let eLambda (pats : List) (body : Expr) : Expr = -// let pats = NEList.ofListUnsafe "eLambda" [] pats -// ELambda(gid (), pats, body) +let eFieldAccess (expr : Expr) (fieldName : string) : Expr = + ERecordFieldAccess(gid (), expr, fieldName) // let eEnum // (typeName : FQTypeName.FQTypeName) @@ -72,6 +79,10 @@ let eMatch (expr : Expr) (cases : List) : Expr = // |> PT2RT.FQFnName.toRT // |> fun x -> EFnName(gid (), x) +// let eLambda (pats : List) (body : Expr) : Expr = +// let pats = NEList.ofListUnsafe "eLambda" [] pats +// ELambda(gid (), pats, body) + // let eFn' // (function_ : string) @@ -91,13 +102,13 @@ let eMatch (expr : Expr) (cases : List) : Expr = // eFn' function_ version typeArgs args -let eApply - (target : Expr) - (typeArgs : List) - (args : List) - : Expr = - let args = NEList.ofListUnsafe "eApply" [] args - EApply(gid (), target, typeArgs, args) +// let eApply +// (target : Expr) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eApply" [] args +// EApply(gid (), target, typeArgs, args) diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index d659fcc53d..96cff0833f 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -14,7 +14,7 @@ open Prelude module DarkDateTime = LibExecution.DarkDateTime module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module AT = LibExecution.AnalysisTypes @@ -116,12 +116,12 @@ let nameToTestDomain (name : string) : string = let builtins - //(httpConfig : BuiltinExecution.Libs.HttpClient.Configuration) + (httpConfig : BuiltinExecution.Libs.HttpClient.Configuration) (_pm : PT.PackageManager) : RT.Builtins = LibExecution.Builtin.combine [ LibTest.builtins - BuiltinExecution.Builtin.builtins //httpConfig pm + BuiltinExecution.Builtin.builtins httpConfig // pm // BuiltinCloudExecution.Builtin.builtins // BuiltinDarkInternal.Builtin.builtins // BuiltinCli.Builtin.builtins @@ -136,10 +136,9 @@ let builtins // builtins httpConfig pm let localBuiltIns (pm : PT.PackageManager) = - // let httpConfig = - // { BuiltinExecution.Libs.HttpClient.defaultConfig with timeoutInMs = 5000 } - // builtins httpConfig pm - builtins pm + let httpConfig = + { BuiltinExecution.Libs.HttpClient.defaultConfig with timeoutInMs = 5000 } + builtins httpConfig pm @@ -204,8 +203,7 @@ let executionStateFor localBuiltIns pmPT let state = let pmRT = PT2RT.PackageManager.toRT pmPT - let tracing = Exe.noTracing (RT.CallStack.fromEntryPoint RT.Script) - Exe.createState builtins pmRT tracing exceptionReporter notifier program + Exe.createState builtins pmRT Exe.noTracing exceptionReporter notifier program let state = { state with test = testContext } return state } @@ -389,8 +387,8 @@ module Expect = | DTuple(first, second, rest) -> List.all r ([ first; second ] @ rest) | DDict(_, entries) -> entries |> Map.values |> List.all r - // | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all r - // | DEnum(_, _, _, _, fields) -> fields |> List.all r + | DRecord(_, _, _, fields) -> fields |> Map.values |> List.all r + | DEnum(_, _, _, _, fields) -> fields |> List.all r type Path = string list @@ -431,16 +429,16 @@ module Expect = // | LPTuple _, _ -> errorFn path (string actual) (string expected) - // let rec userTypeNameEqualityBaseFn - // (path : Path) - // (actual : FQTypeName.FQTypeName) - // (expected : FQTypeName.FQTypeName) - // (errorFn : Path -> string -> string -> unit) - // : unit = - // let err () = errorFn path (string actual) (string expected) + let rec userTypeNameEqualityBaseFn + (path : Path) + (actual : FQTypeName.FQTypeName) + (expected : FQTypeName.FQTypeName) + (errorFn : Path -> string -> string -> unit) + : unit = + let err () = errorFn path (string actual) (string expected) - // match actual, expected with - // | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () + match actual, expected with + | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () // let rec matchPatternEqualityBaseFn // (checkIDs : bool) @@ -807,48 +805,48 @@ module Expect = rs - // | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> - // // check type name - // userTypeNameEqualityBaseFn path ltn rtn errorFn + | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> + // check type name + userTypeNameEqualityBaseFn path ltn rtn errorFn - // // check type args - // check - // ("TypeArgsLength" :: path) - // (List.length ltypeArgs) - // (List.length rtypeArgs) - // List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs + // check type args + check + ("TypeArgsLength" :: path) + (List.length ltypeArgs) + (List.length rtypeArgs) + List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs - // check ("Length" :: path) (Map.count ls) (Map.count rs) + check ("Length" :: path) (Map.count ls) (Map.count rs) - // // check keys - // // -- keys from ls are in both, check matching values - // Map.iterWithIndex - // (fun key v1 -> - // match Map.find key rs with - // | Some v2 -> de (key :: path) v1 v2 - // | None -> check (key :: path) ls rs) - // ls + // check keys + // -- keys from ls are in both, check matching values + Map.iterWithIndex + (fun key v1 -> + match Map.find key rs with + | Some v2 -> de (key :: path) v1 v2 + | None -> check (key :: path) ls rs) + ls - // // -- keys from rs are in both - // Map.iterWithIndex - // (fun key _ -> - // match Map.find key rs with - // | Some _ -> () // already checked - // | None -> check (key :: path) ls rs) - // rs + // -- keys from rs are in both + Map.iterWithIndex + (fun key _ -> + match Map.find key rs with + | Some _ -> () // already checked + | None -> check (key :: path) ls rs) + rs - // | DEnum(typeName, _, typeArgs, caseName, fields), - // DEnum(typeName', _, typeArgs', caseName', fields') -> - // userTypeNameEqualityBaseFn path typeName typeName' errorFn - // check ("caseName" :: path) caseName caseName' + | DEnum(_, typeName, typeArgs, caseName, fields), + DEnum(_, typeName', typeArgs', caseName', fields') -> + userTypeNameEqualityBaseFn path typeName typeName' errorFn + check ("caseName" :: path) caseName caseName' - // check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') - // List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' + check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') + List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' - // check ("fields.Length" :: path) (List.length fields) (List.length fields) - // List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' - // () + check ("fields.Length" :: path) (List.length fields) (List.length fields) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' + () // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> // NEList.iter2 @@ -881,8 +879,8 @@ module Expect = | DList _, _ | DTuple _, _ | DDict _, _ - // | DRecord _, _ - // | DEnum _, _ + | DRecord _, _ + | DEnum _, _ | DFnVal _, _ // | DDB _, _ -> check path actual expected @@ -933,10 +931,10 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = | DTuple(first, second, theRest) -> List.map visit ([ first; second ] @ theRest) |> ignore> - // | DRecord(_, _, _, fields) -> - // Map.values fields |> List.map visit |> ignore> + | DRecord(_, _, _, fields) -> + Map.values fields |> List.map visit |> ignore> - // | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> + | DEnum(_, _, _, _, fields) -> fields |> List.map visit |> ignore> // Keep for exhaustiveness checking | DUnit @@ -1203,7 +1201,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int64 ], +// [ VT.int64 ], // "None", // [] // ), @@ -1212,7 +1210,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int64 ], +// [ VT.int64 ], // "Some", // [ Dval.int64 15 ] // ), @@ -1221,7 +1219,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.string ], +// [ VT.string ], // "Some", // [ DString "a string" ] // ), @@ -1230,7 +1228,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int8 ], +// [ VT.int8 ], // "Some", // [ Dval.int8 15y ] // ), @@ -1239,7 +1237,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.uint8 ], +// [ VT.uint8 ], // "Some", // [ Dval.uint8 15uy ] // ), @@ -1248,7 +1246,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int16 ], +// [ VT.int16 ], // "Some", // [ Dval.int16 16s ] // ), @@ -1257,7 +1255,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.uint16 ], +// [ VT.uint16 ], // "Some", // [ Dval.uint16 16us ] // ), @@ -1266,7 +1264,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int32 ], +// [ VT.int32 ], // "Some", // [ Dval.int32 32l ] // ), @@ -1275,7 +1273,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.uint32 ], +// [ VT.uint32 ], // "Some", // [ Dval.uint32 32ul ] // ), @@ -1284,7 +1282,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.int128 ], +// [ VT.int128 ], // "Some", // [ Dval.int128 128Q ] // ), @@ -1293,7 +1291,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.uint128 ], +// [ VT.uint128 ], // "Some", // [ Dval.uint128 128Z ] // ), @@ -1302,7 +1300,7 @@ let interestingInts : List = // DEnum( // Dval.optionType, // Dval.optionType, -// Dval.ignoreAndUseEmpty [ VT.uint64 ], +// [ VT.uint64 ], // "Some", // [ Dval.uint64 64UL ] // ), @@ -1332,7 +1330,7 @@ let interestingInts : List = // DEnum( // Dval.resultType, // Dval.resultType, -// Dval.ignoreAndUseEmpty [ VT.unknown; VT.string ], +// [ VT.unknown; VT.string ], // "Error", // [ DString "error" ] // ), @@ -1349,71 +1347,71 @@ let interestingInts : List = // interestingDvals ] // |> List.map (fun (k, v, t) -> k, (v, t)) -// // Utilties shared among tests -// module Http = -// type T = { status : string; headers : (string * string) list; body : byte array } - -// let setHeadersToCRLF (text : byte array) : byte array = -// // We keep our test files with an LF line ending, but the HTTP spec -// // requires headers (but not the body, nor the first line) to have CRLF -// // line endings -// let mutable justSawNewline = false -// let mutable inBody = false - -// text -// |> Array.toList -// |> List.collect (fun b -> -// if not inBody && b = byte '\n' then -// if justSawNewline then inBody <- true -// justSawNewline <- true -// [ byte '\r'; b ] -// else -// justSawNewline <- false -// [ b ]) -// |> List.toArray - -// let split (response : byte array) : T = -// // read a single line of bytes (a line ends with \r\n) -// let rec consume (existing : byte list) (l : byte list) : byte list * byte list = -// match l with -// | [] -> [], [] -// | 13uy :: 10uy :: tail -> existing, tail -// | head :: tail -> consume (existing @ [ head ]) tail - -// // read all headers (ends when we get two \r\n in a row), return headers -// // and remaining byte string (the body). Assumes the status line is not -// // present. Headers are returned reversed -// let rec consumeHeaders -// (headers : string list) -// (l : byte list) -// : string list * byte list = -// let (line, remaining) = consume [] l - -// if line = [] then -// (headers, remaining) -// else -// let str = line |> Array.ofList |> UTF8.ofBytesUnsafe -// consumeHeaders (str :: headers) remaining - -// let bytes = Array.toList response - -// // read the status like (eg HTTP 200 OK) -// let status, bytes = consume [] bytes - -// let headers, body = consumeHeaders [] bytes - -// let headers = -// headers -// |> List.reverse -// |> List.map (fun s -> -// match String.split ":" s with -// | k :: vs -> (k, vs |> String.concat ":" |> String.trimLeft) -// | _ -> Exception.raiseInternal $"not a valid header" [ "header", s ]) - - -// { status = status |> List.toArray |> UTF8.ofBytesUnsafe -// headers = headers -// body = List.toArray body } +// Utilties shared among tests +module Http = + type T = { status : string; headers : (string * string) list; body : byte array } + +// let setHeadersToCRLF (text : byte array) : byte array = +// // We keep our test files with an LF line ending, but the HTTP spec +// // requires headers (but not the body, nor the first line) to have CRLF +// // line endings +// let mutable justSawNewline = false +// let mutable inBody = false + +// text +// |> Array.toList +// |> List.collect (fun b -> +// if not inBody && b = byte '\n' then +// if justSawNewline then inBody <- true +// justSawNewline <- true +// [ byte '\r'; b ] +// else +// justSawNewline <- false +// [ b ]) +// |> List.toArray + +// let split (response : byte array) : T = +// // read a single line of bytes (a line ends with \r\n) +// let rec consume (existing : byte list) (l : byte list) : byte list * byte list = +// match l with +// | [] -> [], [] +// | 13uy :: 10uy :: tail -> existing, tail +// | head :: tail -> consume (existing @ [ head ]) tail + +// // read all headers (ends when we get two \r\n in a row), return headers +// // and remaining byte string (the body). Assumes the status line is not +// // present. Headers are returned reversed +// let rec consumeHeaders +// (headers : string list) +// (l : byte list) +// : string list * byte list = +// let (line, remaining) = consume [] l + +// if line = [] then +// (headers, remaining) +// else +// let str = line |> Array.ofList |> UTF8.ofBytesUnsafe +// consumeHeaders (str :: headers) remaining + +// let bytes = Array.toList response + +// // read the status like (eg HTTP 200 OK) +// let status, bytes = consume [] bytes + +// let headers, body = consumeHeaders [] bytes + +// let headers = +// headers +// |> List.reverse +// |> List.map (fun s -> +// match String.split ":" s with +// | k :: vs -> (k, vs |> String.concat ":" |> String.trimLeft) +// | _ -> Exception.raiseInternal $"not a valid header" [ "header", s ]) + + +// { status = status |> List.toArray |> UTF8.ofBytesUnsafe +// headers = headers +// body = List.toArray body } // // For an ASP.NET http server, remove the default loggers and add a file logger that // // saves the output in rundir/logs @@ -1506,7 +1504,7 @@ let interestingInts : List = // match d with // | DRecord(_, _, _, fields) -> // { name = fields |> D.stringField "name" -// lineNumber = fields |> D.intField "lineNumber" +// lineNumber = fields |> D.int32Field "lineNumber" // actual = fields |> D.field "actual" |> PT2DT.Expr.fromDT // expected = fields |> D.field "expected" |> PT2DT.Expr.fromDT } // | _ -> Exception.raiseInternal "Invalid Test" [] diff --git a/backend/tests/TestUtils/TestUtils.fsproj b/backend/tests/TestUtils/TestUtils.fsproj index 16a5ca730f..401b4db6f1 100644 --- a/backend/tests/TestUtils/TestUtils.fsproj +++ b/backend/tests/TestUtils/TestUtils.fsproj @@ -11,7 +11,7 @@ - + diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index ec0804bdec..5cfb9ba8ea 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -6,14 +6,19 @@ open TestUtils.TestUtils module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes +module RTE = RT.RuntimeError module E = TestValues.Expressions +module PM = TestValues.PM let t name ptExpr expectedInsts = testTask name { - let vmState = ptExpr |> PT2RT.Expr.toRT 0 |> RT.VMState.fromInstructions + let vmState = + ptExpr + |> PT2RT.Expr.toRT 0 + |> RT.VMState.fromInstructions RT.ExecutionPoint.Script let! exeState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false @@ -41,9 +46,16 @@ let tFail name ptExpr expectedRte = module Basic = // CLEANUP back fill with more simple stuff - let onePlusTwo = t "1+2" E.Basic.onePlusTwo (RT.DInt64 3L) + let one = t "1" E.Basic.one (RT.DInt64 1L) - let tests = testList "Basic" [ onePlusTwo ] + //let onePlusTwo = t "1+2" E.Basic.onePlusTwo (RT.DInt64 3L) + + let tests = + testList + "Basic" + [ one + //onePlusTwo + ] module List = @@ -67,9 +79,9 @@ module List = tFail "[1; true]" E.List.mixed - (RT.RuntimeError.fromDT ( - RT.DString "Could not merge types List and List" - )) + // RT.DString "Could not merge types List and List" + (RTE.Lists.TriedToAddMismatchedData(VT.int64, VT.bool, RT.DBool true) + |> RTE.List) let tests = testList "Lists" [ simple; nested; mixed ] @@ -84,24 +96,30 @@ module Let = tFail "let (a, b) = 1 in a" E.Let.tupleNotTuple - (RT.RuntimeError.fromDT (RT.DString "Let Pattern did not match")) + (RTE.Error.Let( + RTE.Lets.Error.PatternDoesNotMatch( + RT.DInt64 1, + RT.LPTuple(RT.LPVariable "a", RT.LPVariable "b", []) + ) + )) /// `let (a, b) = (1, 2, 3) in a` let tupleIncorrectLen = tFail "let (a, b) = (1, 2, 3) in a" E.Let.tupleIncorrectLen - (RT.RuntimeError.fromDT (RT.DString "Let Pattern did not match")) + (RTE.Error.Let( + RTE.Lets.Error.PatternDoesNotMatch( + RT.DTuple(RT.DInt64 1, RT.DInt64 2, [ RT.DInt64 3 ]), + RT.LPTuple(RT.LPVariable "a", RT.LPVariable "b", []) + ) + )) let tupleNested = t "let (a, (b, c)) = (1, (2, 3))\nb" E.Let.tupleNested (RT.DInt64 2L) /// `a` - let undefinedVar = - tFail - "a" - E.Let.undefinedVar - (RT.RuntimeError.fromDT (RT.DString "Variable not found: a")) + let undefinedVar = tFail "a" E.Let.undefinedVar (RTE.VariableNotFound "a") let tests = testList @@ -128,19 +146,19 @@ module Dict = t "Dict { t: true}" E.Dict.simple - (RT.DDict(VT.unknown, Map [ "key", RT.DBool true ])) + (RT.DDict(VT.bool, Map [ "key", RT.DBool true ])) let multEntries = t "Dict {t: true; f: false}" E.Dict.multEntries - (RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ])) + (RT.DDict(VT.bool, Map [ "t", RT.DBool true; "f", RT.DBool false ])) let dupeKey = - t + tFail "Dict {t: true; f: false; t: false}" E.Dict.dupeKey - (RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ])) + (RTE.Dict(RTE.Dicts.TriedToAddKeyAfterAlreadyPresent "t")) let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] @@ -187,15 +205,15 @@ module Match = tFail "match true with\n| false -> \"first branch\"" E.Match.notMatched - (RT.RuntimeError.fromDT (RT.DString "match not matched")) + RTE.MatchUnmatched let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) - let withVarAndWhenCondition = - t - "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - E.Match.withVarAndWhenCondition - (RT.DString "second branch") + // let withVarAndWhenCondition = + // t + // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + // E.Match.withVarAndWhenCondition + // (RT.DString "second branch") let list = t @@ -227,6 +245,63 @@ module Match = tuple ] +module Records = + let simple = + let typeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField + t + "Test.Test { key = true }" + E.Records.simple + (RT.DRecord(typeName, typeName, [], Map [ "key", RT.DBool true ])) + + let nested = + let outerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.nested + let innerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField + t + "Test.Test2 { outer = (Test.Test { key = true }) }" + E.Records.nested + (RT.DRecord( + outerTypeName, + outerTypeName, + [], + Map + [ "outer", + RT.DRecord( + innerTypeName, + innerTypeName, + [], + Map [ "key", RT.DBool true ] + ) ] + )) + + + let tests = testList "Records" [ simple; nested ] + + +module RecordFieldAccess = + let simple = + t "(Test.Test { key = true }).key" E.RecordFieldAccess.simple (RT.DBool true) + let notRecord = + tFail + "1.key" + E.RecordFieldAccess.notRecord + (RTE.Record(RTE.Records.FieldAccessNotRecord VT.int64)) + + let missingField = + tFail + "(Test.Test { key = true }).missing" + E.RecordFieldAccess.missingField + (RTE.Record(RTE.Records.FieldAccessFieldNotFound "missing")) + + let nested = + t + "(Test.Test2 { outer = (Test.Test { key = true }) }).outer.key" + E.RecordFieldAccess.nested + (RT.DBool true) + + let tests = + testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + + let tests = testList "Interpreter" @@ -237,4 +312,6 @@ let tests = Dict.tests If.tests Tuples.tests - Match.tests ] + Match.tests + Records.tests + RecordFieldAccess.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 2dae5f4d6b..8ec25e4cf8 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -6,11 +6,12 @@ open TestUtils.TestUtils module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs module E = TestValues.Expressions +module PM = TestValues.PM // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists @@ -24,23 +25,28 @@ let t name expr expected = module Basic = let one = t "1" E.Basic.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) - let onePlusTwo = - t - "1+2" - E.Basic.onePlusTwo - (4, - [ RT.LoadVal( - 0, - RT.DFnVal( - RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) - ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], - 3) + // let onePlusTwo = + // t + // "1+2" + // E.Basic.onePlusTwo + // (4, + // [ RT.LoadVal( + // 0, + // RT.DFnVal( + // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + // ) + // ) + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], + // 3) - let tests = testList "Basic" [ one; onePlusTwo ] + let tests = + testList + "Basic" + [ one + //onePlusTwo + ] module Let = @@ -144,32 +150,18 @@ module List = module String = let simple = - t - "[\"hello\"]" - E.String.simple - (2, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString "hello") - RT.AppendString(0, 1) ], - 0) + t "[\"hello\"]" E.String.simple (1, [ RT.LoadVal(0, RT.DString "hello") ], 0) let withInterpolation = t "[let x = \"world\"\n$\"hello {x}\"]" E.String.withInterpolation - (5, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString ", world") - RT.AppendString(0, 1) - + (3, + [ RT.LoadVal(0, RT.DString ", world") RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "hello") - RT.AppendString(2, 3) - - RT.GetVar(4, "x") - RT.AppendString(2, 4) ], + RT.GetVar(1, "x") + RT.CreateString(2, [ RT.Text "hello"; RT.Interpolated 1 ]) ], 2) let tests = testList "String" [ simple; withInterpolation ] @@ -319,25 +311,21 @@ module Match = t "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" E.Match.simple - (4, + (3, [ // handle the value we're matching on RT.LoadVal(0, RT.DBool true) // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) + RT.LoadVal(2, RT.DString "first branch") RT.CopyVal(1, 2) - RT.JumpBy 7 + RT.JumpBy 5 // SECOND BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 3) // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "second branch") - RT.AppendString(2, 3) + RT.LoadVal(2, RT.DString "second branch") RT.CopyVal(1, 2) RT.JumpBy 1 @@ -349,16 +337,14 @@ module Match = t "match true with\n| false -> \"first branch\"" E.Match.notMatched - (4, + (3, [ // handle the value we're matching on RT.LoadVal(0, RT.DBool true) // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 5) + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) // rhs - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) + RT.LoadVal(2, RT.DString "first branch") RT.CopyVal(1, 2) RT.JumpBy 1 @@ -381,45 +367,45 @@ module Match = RT.MatchUnmatched ], 1) - let withVarAndWhenCondition = - t - "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - E.Match.withVarAndWhenCondition - (10, - [ RT.LoadVal(0, RT.DInt64 4L) - - // first branch - RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "first branch") - RT.AppendString(2, 3) - RT.CopyVal(1, 2) - RT.JumpBy 14 - - // second branch - RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) - RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) - RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) - RT.GetVar(4, "x") - RT.Apply(5, 3, [], NEList.ofList 4 []) - RT.LoadVal(6, RT.DInt64 2L) - RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) - RT.JumpByIfFalse(5, 7) - RT.LoadVal(8, RT.DString "") - RT.LoadVal(9, RT.DString "second branch") - RT.AppendString(8, 9) - RT.CopyVal(1, 8) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) + // let withVarAndWhenCondition = + // t + // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + // E.Match.withVarAndWhenCondition + // (10, + // [ RT.LoadVal(0, RT.DInt64 4L) + + // // first branch + // RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) + // RT.LoadVal(2, RT.DString "") + // RT.LoadVal(3, RT.DString "first branch") + // RT.AppendString(2, 3) + // RT.CopyVal(1, 2) + // RT.JumpBy 14 + + // // second branch + // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) + // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + // RT.GetVar(4, "x") + // RT.Apply(5, 3, [], NEList.ofList 4 []) + // RT.LoadVal(6, RT.DInt64 2L) + // RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + // RT.JumpByIfFalse(5, 7) + // RT.LoadVal(8, RT.DString "") + // RT.LoadVal(9, RT.DString "second branch") + // RT.AppendString(8, 9) + // RT.CopyVal(1, 8) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 1) let list = t "match [1, 2] with\n| [1, 2] -> \"first branch\"" E.Match.list - (6, + (5, [ // expr, whose result we store in 0 RT.LoadVal(1, RT.DInt64 1L) RT.LoadVal(2, RT.DInt64 2L) @@ -429,11 +415,9 @@ module Match = RT.CheckMatchPatternAndExtractVars( 0, RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], - 5 + 3 ) - RT.LoadVal(4, RT.DString "") - RT.LoadVal(5, RT.DString "first branch") - RT.AppendString(4, 5) + RT.LoadVal(4, RT.DString "first branch") RT.CopyVal(3, 4) RT.JumpBy 1 @@ -469,7 +453,7 @@ module Match = t "match (1, 2) with\n| (1, 2) -> \"first branch\"" E.Match.tuple - (6, + (5, [ // expr, whose result we store in 0 RT.LoadVal(1, RT.DInt64 1L) RT.LoadVal(2, RT.DInt64 2L) @@ -479,11 +463,9 @@ module Match = RT.CheckMatchPatternAndExtractVars( 0, RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), - 5 + 3 ) - RT.LoadVal(4, RT.DString "") - RT.LoadVal(5, RT.DString "first branch") - RT.AppendString(4, 5) + RT.LoadVal(4, RT.DString "first branch") RT.CopyVal(3, 4) RT.JumpBy 1 @@ -503,6 +485,119 @@ module Match = tuple ] +module Records = + let simple = + t + "Test.Test { key = true }" + E.Records.simple + (2, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) ], + 0) + + let nested = + t + "Test.Test2 { outer = (Test.Test { key = true }) }" + E.Records.nested + (3, + [ RT.LoadVal(2, RT.DBool true) + + // inner record + RT.CreateRecord( + 1, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 2) ] + ) + + // outer record + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.nested, + [], + [ ("outer", 1) ] + ) ], + 0) + + let tests = testList "Records" [ simple; nested ] + + +module RecordFieldAccess = + let simple = + t + "let r = Test.Test { key = true }\nr.key" + E.RecordFieldAccess.simple + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.GetRecordField(2, 0, "key") ], + 2) + + let notRecord = + t + "1.key" + E.RecordFieldAccess.notRecord + (2, [ RT.LoadVal(0, RT.DInt64 1L); RT.GetRecordField(1, 0, "key") ], 1) + + let missingField = + t + "(Test.Test { key = true }).missing" + E.RecordFieldAccess.missingField + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.GetRecordField(2, 0, "missing") ], + 2) + + let nested = + t + "(Test.Test2 { outer = Test.Test { key = true } }).outer.key" + E.RecordFieldAccess.nested + (5, + [ RT.LoadVal(2, RT.DBool true) + RT.CreateRecord( + 1, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 2) ] + ) + + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.nested, + [], + [ ("outer", 1) ] + ) + RT.GetRecordField(3, 0, "outer") + RT.GetRecordField(4, 3, "key") ], + 4) + + + let tests = + testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + + +module RecordUpdate = + // TODO + + let tests = testList "RecordUpdate" [] + + let tests = testList "PT2RT" @@ -513,4 +608,7 @@ let tests = Dict.tests If.tests Tuples.tests - Match.tests ] + Match.tests + Records.tests + RecordFieldAccess.tests + RecordUpdate.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 05bb497242..6dc7d45bff 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -11,15 +11,64 @@ open TestUtils.PTShortcuts // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists +module PM = + module Types = + let make id name definition : PT.PackageType.PackageType = + { id = id + name = name + declaration = { typeParams = []; definition = definition } + description = "TODO" + deprecated = PT.NotDeprecated } + + module Records = + let make id name fields = + make id name (PT.TypeDeclaration.Record(NEList.ofListUnsafe "" [] fields)) + + let singleField = System.Guid.NewGuid() + let nested = System.Guid.NewGuid() + + let all : List = + [ make + singleField + (PT.PackageType.name "Test" [] "Test") + [ { name = "key"; typ = PT.TBool; description = "TODO" } ] + + make + nested + (PT.PackageType.name "Test" [] "Test2") + [ { name = "outer" + typ = PT.TCustomType(Ok(PT.FQTypeName.fqPackage singleField), []) + description = "TODO" } ] ] + + module Enums = + let all = [] + + let all = Records.all @ Enums.all + + module Constants = + let all = [] + + module Functions = + let all = [] + + + // TODO + let fake : PT.PackageManager = + PT.PackageManager.withExtras + PT.PackageManager.empty + Types.all + Constants.all + Functions.all + module Expressions = module Basic = let one = eInt64 1 - let onePlusTwo = - eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) - [] - [ eInt64 1; eInt64 2 ] + // let onePlusTwo = + // eApply + // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) + // [] + // [ eInt64 1; eInt64 2 ] module Let = @@ -131,29 +180,29 @@ module Expressions = (eBool true) [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] - /// match 4 with - /// | 1 -> "first branch" - /// | x when x % 2 == 0 -> "second branch" - let withVarAndWhenCondition = - eMatch - (eInt64 4) - [ { pat = PT.MPInt64(gid (), 1) - whenCondition = None - rhs = eStr [ strText "first branch" ] } - { pat = PT.MPVariable(gid (), "x") - // "is even" - whenCondition = - Some( - eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) - [] - [ eApply - (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) - [] - [ eVar "x" ] - eInt64 2 ] - ) - rhs = eStr [ strText "second branch" ] } ] + // /// match 4 with + // /// | 1 -> "first branch" + // /// | x when x % 2 == 0 -> "second branch" + // let withVarAndWhenCondition = + // eMatch + // (eInt64 4) + // [ { pat = PT.MPInt64(gid (), 1) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } + // { pat = PT.MPVariable(gid (), "x") + // // "is even" + // whenCondition = + // Some( + // eApply + // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + // [] + // [ eApply + // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + // [] + // [ eVar "x" ] + // eInt64 2 ] + // ) + // rhs = eStr [ strText "second branch" ] } ] let list = eMatch @@ -181,3 +230,16 @@ module Expressions = PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) whenCondition = None rhs = eStr [ strText "first branch" ] } ] + + + module Records = + let simple = + eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] + + let nested = eRecord (typeNamePkg PM.Types.Records.nested) [] [ "outer", simple ] + + module RecordFieldAccess = + let simple = eFieldAccess Records.simple "key" + let notRecord = eFieldAccess (eInt64 1) "key" + let missingField = eFieldAccess Records.simple "missing" + let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index ec6284e84d..189e797e4e 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -34,34 +34,32 @@ let main (args : string array) : int = let tests = [ // core Tests.Prelude.tests + Tests.TreeSitter.tests + Tests.RuntimeTypes.tests Tests.ProgramTypes.tests Tests.ProgramTypesToRuntimeTypes.tests Tests.Interpreter.tests - //Tests.AnalysisTypes.tests - //Tests.TreeSitter.tests - - // Tests.DvalRepr.tests + Tests.AnalysisTypes.tests + // Tests.Execution.tests + Tests.Builtin.tests + // Tests.DvalRepr.tests -- maybe this gets deleted TODO // Tests.PackageManager.tests + //Tests.LibParser.tests + // Tests.NewParser.tests + // Tests.HttpClient.tests - // cloud + // cloud // Tests.BwdServer.tests // Tests.Canvas.tests // Tests.Cron.tests // Tests.QueueSchedulingRules.tests // TODO: bring back Tests.Queue.tests - // TRACINGTODO - // Tests.Execution.tests - // Tests.LibParser.tests - // Tests.NewParser.tests - // Tests.HttpClient.tests // Tests.Routing.tests - // Tests.RuntimeTypes.tests // Tests.BinarySerialization.tests // Tests.VanillaSerialization.tests // Tests.DarkTypesSerialization.tests // Tests.SqlCompiler.tests - // Tests.Builtin.tests // Tests.StorageTraces.tests // cross-cutting diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 9f58b00101..8795b7bcdf 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -21,8 +21,8 @@ - + @@ -35,35 +35,38 @@ + + + + - - + + + + + + + + - + - - - - - - - - + diff --git a/notes.dark b/notes.dark deleted file mode 100644 index 6e765ed696..0000000000 --- a/notes.dark +++ /dev/null @@ -1,281 +0,0 @@ -module Darklang = -module LanguageTools = -// It's worth noting that all RTE is provided paired with a context -// of where that error happened. -// "RuntimeErrorContext"? -module RuntimeErrors = - - module NameResolution = - type ErrorType = - | NotFound of names: List - | ExpectedEnumButNot of packageTypeID: uuid - | ExpectedRecordButNot of packageTypeID: uuid - | MissingEnumModuleName of caseName: String - | InvalidPackageName of names: List - - type NameType = | Function | Type | Constant - - type Error = { errorType: ErrorType nameType: NameType } - - - - - - - - module TypeChecker = - type Context = - | FunctionCallParameter of fnName: FQFnName * parameter: RTParam * paramIndex: Int64 - | FunctionCallResult of fnName: FQFnName * returnType: TypeReference - | RecordField of recordTypeName: FQTypeName * fieldName: String * fieldType: TypeReference - | DictKey of key: String * typ: TypeReference - | EnumField of enumTypeName: FQTypeName * caseName: String * fieldIndex: Int64 * fieldCount: Int64 * fieldType: TypeReference - | DBQueryVariable of varName: String * expected: TypeReference - | DBSchemaType of name: String * expectedType: TypeReference - | ListIndex of index: Int64 * listTyp: TypeReference * parent: Context - | TupleIndex of index: Int64 * elementType: TypeReference * parent: Context - | FnValResult of returnType: TypeReference - - type ErrorType = - | ValueNotExpectedType of actualValue: Dval * expectedType: TypeReference - | TypeDoesntExist of FQTypeName - - type Error = { errorType: ErrorType context: Context } - - - module Cli = - type Error = - | NoExpressionsToExecute - | UncaughtException of String * List - | NonIntReturned of actuallyReturned: Dval.Dval - - - module Json = - type Error = UnsupportedType of RuntimeTypes.TypeReference - - - module Int = - type Error = - | DivideByZeroError - | OutOfRange - | NegativeExponent - | NegativeModulus - | ZeroModulus - - - module Execution = - type Error = - | MatchExprUnmatched of RuntimeTypes.Dval.Dval - | NonStringInStringInterpolation of RuntimeTypes.Dval.Dval - | ConstDoesntExist of RuntimeTypes.FQConstantName.FQConstantName - | EnumConstructionCaseNotFound of typeName: RuntimeTypes.FQTypeName * caseName: String - | WrongNumberOfFnArgs of fn: RuntimeTypes.FQFnName * expectedTypeArgs: Int64 * expectedArgs: Int64 * actualTypeArgs: Int64 * actualArgs: Int64 - - // TODO: Record submodule - | RecordConstructionFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * fieldName: String - | RecordConstructionMissingField of RuntimeTypes.FQTypeName * missingFieldName: String - | RecordConstructionDuplicateField of RuntimeTypes.FQTypeName * duplicateFieldName: String - | FieldAccessFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * invalidFieldName: String - | FieldAccessNotRecord of RuntimeTypes.ValueType * String - - module Unwrap = - type Error = - | GotNone - | GotError of Dval - | NonOptionOrResult of Dval - - - - // TODO: this needs a way to be extensible - // users should have _some_ way to add their own RuntimeErrors - // and we don't want to have to rebuild everything to add a new RTE - type Error = - // reframe as "Encountered unresolved name" - | NameResolution of NameResolution.Error - - | Int of Int.Error - | Json of Json.Error - - | Record of Record.Error - | Enum of Enum.Error - - | List of List.Error - - | Unwrap of Unwrap.Error - - // probably break this down.. - | TypeChecker of TypeChecker.Error - - | ExpectedBoolInCondition of Dval - | VariableNotFound of attemptedVarName : String - - - | SqlCompiler of Error // -- or maybe this should happen during PT2RT? hmm. - - // lol aren't they all execution errors? - // remove this level... - | Execution of Execution.Error - - | Cli of Cli.Error - - | OldStringTODO of String - - - - /// Sometimes, very-unexpected things happen. This is a catch-all for those. - /// For local/private runtimes+hosting, allow users to see the details, - /// but for _our_ hosting, users shouldn't see the whole call stack or - /// whatever, for (our) safety. But, they can use the error ID to refer to - /// the error in a support ticket. - | UncaughtException of reference: Uuid - -backend/src/BuiltinExecution/Libs/NoModule.fs: -413 // $"unwrap called with multiple arguments: {multipleArgs}" -414: // |> RuntimeError.oldError - -backend/src/LibCloud/SqlCompiler.fs: -1220 let err = RuntimeError.sqlCompilerRuntimeError internalError -1221 return Error err -1222 -1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) -1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) -1225 } - -backend/src/LibExecution/Interpreter.fs: -263: "Let Pattern did not match" - -265: | Fail \_rte -> rte <- Some(RuntimeError.oldError "TODO") - -351 $"Function {FQFnName.toString fnName} is not found") - -backend/src/LibExecution/Interpreter.Old.fs: -123: RuntimeError.oldError "TODO" - -161: $"Invalid const name: {msg}") - -904 $"Expected {expectedLength} arguments, got {actualLength}") - -988 $"Function {FQFnName.toString fnToCall} is not found") - -1044: "Unknown error" - -backend/src/LibExecution/NameResolutionError.fs: -105 let toRuntimeError (\_e : Error) : RT.RuntimeError = -107: "TODO" |> RT.RuntimeError.oldError - -backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs: -411 // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. -412 // maybe the 'value' here is (still) some unresolved name? -413 // (which should fail when we apply it) -414: (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) - -591: // // RT.RuntimeError.oldError "Record must have at least one field", - -673: // // RT.RuntimeError.oldError "Match must have at least one case", - -backend/src/LibExecution/RuntimeTypes.fs: -813 -814 -815 // TODO remove all usages of this in favor of better error cases -816: let oldError (msg : string) : RuntimeError = -817 //case "OldStringErrorTODO" [ DString msg ] -818 RuntimeError(DString msg) -819 - -839 -840 // TODO remove all usages of this in favor of better error cases -841 let raiseUntargetedString (s : string) : 'a = -842: raiseUntargetedRTE (RuntimeError.oldError s) -843 -844 /// Internally in the runtime, we allow throwing RuntimeErrorExceptions. At the -845 /// boundary, typically in Execution.fs, we will catch the exception, and return this - -backend/src/LibExecution/TypeChecker.fs: -130 RuntimeError.oldError "TODO" - -552 $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" - -604 $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" - -645 $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" - -666 $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" - -695: "Empty key" - -699: $"Duplicate key: {k}") - -backend/tests/TestUtils/LibTest.fs: -71 // previewable = Pure -72 // deprecated = NotDeprecated } -73 -74: // // CLEANUP consider renaming to `oldError` or something more clear -75 // { name = fn "testRuntimeError" 0 -76 // typeParams = [] -77 // parameters = [ Param.make "errorString" TString "" ] - -80 // fn = -81 // (function -82 // | _, _, [ DString errorString ] -> -83: // raiseUntargetedRTE (RuntimeError.oldError errorString) -84 // | \_ -> incorrectArgs ()) -85 // sqlSpec = NotQueryable -86 // previewable = Pure - -backend/src/LibCloud/SqlCompiler.fs: -1221 return Error err -1222 -1223: | SqlCompilerException errStr -> return Error(RuntimeError.oldError errStr) -1224: // return Error(RuntimeError.oldError (errStr + $"\n\nIn body: {body}")) -1225 } -1226 -1227 /home/dark/app/backend/src/LibExecution/Interpreter.Old.fs -1228: 177,10: // let errStr msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) -1229: 184,40: // | LPUnit _ -> if dv <> DUnit then errStr "Unit pattern does not match" else [] -1230: 198,12: // errStr "Tuple pattern has wrong number of elements" -1231: 199,15: // | _ -> errStr "Tuple pattern does not match" -1232: 343,7: let errStr callStack msg : 'a = raiseRTE callStack (RuntimeError.oldError msg) -1233: 480,41: // | _, "", _ -> return errStr callStack $"Empty key for value `{dv}`" -1234: 503,24: // errStr -1235: 508,24: // | _ -> return errStr callStack "Expected a record in record update" -1236: 529,11: errStr -1237: 538,19: // return errStr callStack "Field name is empty" -1238: 554,21: // return errStr callStack msg -1239: 775,34: // | _ -> return errStr callStack "When condition should be a boolean" -1240: 795,24: // | _ -> return errStr callStack "If only supports Booleans" -1241: 804,26: // | _ -> return errStr callStack "|| only supports Booleans" -1242: "|| only supports Booleans" -1243: "&& only supports Booleans" -1244: "&& only supports Booleans" - -backend/src/LibExecution/Interpreter.Old.fs: -184: "Unit pattern does not match" - -198: "Tuple pattern has wrong number of elements" - -199: "Tuple pattern does not match" - -480: $"Empty key for value `{dv}`" - -505 $"Expected a record but {typeStr} is something else" - -508: "Expected a record in record update" - -531 $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" - -538: "Field name is empty" - -552 "(use `DB.*` standard library functions to interact with Datastores. " -553 + "Field access only work with records)" - -775: "When condition should be a boolean" - -795: "If only supports Booleans" - -804: "|| only supports Booleans" - -814: "&& only supports Booleans" - -834 $"Case `{caseName}` expected {case.fields.Length} fields but got {fields.Length}" - -incorrectArgs diff --git a/scripts/build/compile b/scripts/build/compile index 61db03c3c8..b7ba938cb1 100755 --- a/scripts/build/compile +++ b/scripts/build/compile @@ -14,7 +14,7 @@ optimize = in_ci fsharp_thing_to_build = "fsdark.sln" # sometimes it's handy to only build a specific project -fsharp_thing_to_build = "tests/Tests" +#fsharp_thing_to_build = "tests/Tests" #fsharp_thing_to_build = "src/LibExecution" # Make io unbuffered From a0097e1ca2a911c36aa324a846f739b3b671ca35 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 9 Sep 2024 09:57:52 -0400 Subject: [PATCH 19/60] More interpreter rewrite --- backend/src/BuiltinExecution/Libs/Json.fs | 110 +++-- backend/src/BuiltinExecution/Libs/NoModule.fs | 20 +- backend/src/LibExecution/Builtin.fs | 2 +- backend/src/LibExecution/Execution.fs | 12 +- backend/src/LibExecution/Interpreter.fs | 58 ++- backend/src/LibExecution/LibExecution.fsproj | 1 + backend/src/LibExecution/ProgramTypes.fs | 33 +- backend/src/LibExecution/ProgramTypesAst.fs | 85 ++++ .../ProgramTypesToRuntimeTypes.fs | 358 +++++++++------ backend/src/LibExecution/RuntimeTypes.fs | 411 +++++++----------- backend/src/Prelude/StringBuilder.fs | 2 +- backend/tests/TestUtils/PTShortcuts.fs | 20 +- backend/tests/TestUtils/TestUtils.fs | 6 +- backend/tests/Tests/Builtin.Tests.fs | 4 +- backend/tests/Tests/Interpreter.Tests.fs | 35 +- backend/tests/Tests/PT2RT.Tests.fs | 44 +- backend/tests/Tests/ProgramTypes.Tests.fs | 18 +- backend/tests/Tests/RuntimeTypes.Tests.fs | 171 ++++++-- backend/tests/Tests/TestValues.fs | 10 + 19 files changed, 856 insertions(+), 544 deletions(-) create mode 100644 backend/src/LibExecution/ProgramTypesAst.fs diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index 69003451f9..d3b3d39e69 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -809,62 +809,60 @@ let parse let fns : List = - [ - // { name = fn "jsonSerialize" 0 - // typeParams = [ "a" ] - // parameters = [ Param.make "arg" (TVariable "a") "" ] - // returnType = TString - // description = "Serializes a Dark value to a JSON string." - // fn = - // (function - // | state, [ typeToSerializeAs ], [ arg ] -> - // uply { - // // TODO: somehow collect list of TVariable -> TypeReference - // // "'b = Int", - // // so we can Json.serialize<'b>, if 'b is in the surrounding context - // let types = ExecutionState.availableTypes state - // let! response = - // writeJson (fun w -> - // serialize state.tracing.callStack types w typeToSerializeAs arg) - // return DString response - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "jsonParse" 0 - // typeParams = [ "a" ] - // parameters = [ Param.make "json" TString "" ] - // returnType = - // TypeReference.result - // (TVariable "a") - // (TCustomType(Ok ParseError.typeName, [])) - // description = - // "Parses a JSON string as a Dark value, matching the type " - // fn = - // (function - // | state, [ typeArg ], [ DString arg ] -> - // let callStack = state.tracing.callStack - - // let okType = VT.unknownTODO // "a" - // let errType = KTCustomType(ParseError.typeName, []) |> VT.known - // let resultOk = TypeChecker.DvalCreator.resultOk callStack okType errType - // let resultError = - // TypeChecker.DvalCreator.resultError callStack okType errType - - // let types = ExecutionState.availableTypes state - // uply { - // match! parse callStack types typeArg arg with - // | Ok v -> return resultOk v - // | Error e -> return resultError (ParseError.toDT e) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - ] + [ { name = fn "jsonSerialize" 0 + typeParams = [ "a" ] + parameters = [ Param.make "arg" (TVariable "a") "" ] + returnType = TString + description = "Serializes a Dark value to a JSON string." + fn = + (function + | state, [ typeToSerializeAs ], [ arg ] -> + uply { + // TODO: somehow collect list of TVariable -> TypeReference + // "'b = Int", + // so we can Json.serialize<'b>, if 'b is in the surrounding context + let types = ExecutionState.availableTypes state + let! response = + writeJson (fun w -> + serialize state.tracing.callStack types w typeToSerializeAs arg) + return DString response + } + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "jsonParse" 0 + typeParams = [ "a" ] + parameters = [ Param.make "json" TString "" ] + returnType = + TypeReference.result + (TVariable "a") + (TCustomType(Ok ParseError.typeName, [])) + description = + "Parses a JSON string as a Dark value, matching the type " + fn = + (function + | state, [ typeArg ], [ DString arg ] -> + let callStack = state.tracing.callStack + + let okType = VT.unknownTODO // "a" + let errType = KTCustomType(ParseError.typeName, []) |> VT.known + let resultOk = TypeChecker.DvalCreator.resultOk callStack okType errType + let resultError = + TypeChecker.DvalCreator.resultError callStack okType errType + + let types = ExecutionState.availableTypes state + uply { + match! parse callStack types typeArg arg with + | Ok v -> return resultOk v + | Error e -> return resultError (ParseError.toDT e) + } + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } ] let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 5edd04920e..8d65d171d8 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -69,13 +69,19 @@ let rec equals (a : Dval) (b : Dval) : bool = | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 r a3 b3 - | DFnVal a, DFnVal b -> + | DApplicable a, DApplicable b -> match a, b with - // | Lambda a, Lambda b -> equalsLambdaImpl a b - | NamedFn a, NamedFn b -> a = b - // | Lambda _, _ - - //| NamedFn _, _ -> false + | Lambda _a, Lambda _b -> + //equalsLambdaImpl a b + // TODO + true + | NamedFn _a, NamedFn _b -> + //a = b + // TODO + true + | Lambda _, _ + + | NamedFn _, _ -> false // | DDB a, DDB b -> a = b // exhaustiveness check @@ -101,7 +107,7 @@ let rec equals (a : Dval) (b : Dval) : bool = | DDict _, _ | DRecord _, _ | DEnum _, _ - | DFnVal _, _ + | DApplicable _, _ // | DDB _, _ -> // type errors; should be caught above by the caller diff --git a/backend/src/LibExecution/Builtin.fs b/backend/src/LibExecution/Builtin.fs index 3392e1622e..5768df5909 100644 --- a/backend/src/LibExecution/Builtin.fs +++ b/backend/src/LibExecution/Builtin.fs @@ -1,4 +1,4 @@ -/// Helper functions for stdlibs +/// Helper functions for declaraing built-in functions and constants module LibExecution.Builtin open Prelude diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 7ad1e1a836..62d1cd13b7 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -46,20 +46,20 @@ let createState let executeExpr (exeState : RT.ExecutionState) (inputVars : RT.Symtable) - (instructionsWithContext : RT.InstructionsWithContext) + (instrs : RT.Instructions) : Task = task { - let registersNeeded, instructions, resultReg = instructionsWithContext let vmState : RT.VMState = { pc = 0 - instructions = List.toArray instructions - registers = Array.zeroCreate registersNeeded - resultReg = resultReg + instructions = List.toArray instrs.instructions + registers = Array.zeroCreate instrs.registerCount + resultReg = instrs.resultIn callStack = RT.CallStack.fromEntryPoint RT.ExecutionPoint.Script // TODO symbolTable = inputVars - typeSymbolTable = Map.empty } + typeSymbolTable = Map.empty + lambdas = Map.empty } try try vmState.symbolTable <- diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 6979fb211d..cedfaacb40 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -162,8 +162,8 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = segments |> List.iter (fun seg -> match seg with - | StringSegment.Text s -> sb.Append s |> ignore - | StringSegment.Interpolated reg -> + | Text s -> sb.Append s |> ignore + | Interpolated reg -> match vm.registers[reg] with | DString s -> sb.Append s |> ignore | _ -> raiseRTE (RTE.String RTE.Strings.Error.InvalidStringAppend)) @@ -281,20 +281,48 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = vm.registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) counter <- counter + 1 + | CreateLambda(lambdaReg, impl) -> + vm.lambdas <- Map.add impl.exprId impl vm.lambdas + vm.registers[lambdaReg] <- + { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } + |> Applicable.Lambda + |> DApplicable + counter <- counter + 1 - // == Working with things that Apply (like fns, lambdas) == - // // `add (increment 1L) (3L)` and store results in `putResultIn` - // // At this point, the 'increment' has already been evaluated. - // // But maybe that's something we should change, (CLEANUP) - // // so that we don't execute things until they're needed - // | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> - // // should we instead pass in register indices? probably... - // let args = argRegs |> NEList.map (fun r -> vm.registers[r]) - // //debuG "args" (NEList.length args) - // let thingToCall = vm.registers[thingToCallReg] - // let! result = call exeState vm thingToCall typeArgs args - // vm.registers[putResultIn] <- result - // counter <- counter + 1 + + // == Working with things that Apply (fns, lambdas) == + // `add (increment 1L) (3L)` and store results in `putResultIn` + | Apply(putResultIn, thingToCallReg, _typeArgs, argRegs) -> + let thingToCall = vm.registers[thingToCallReg] + + let result = + match thingToCall with + | DApplicable applicable -> + match applicable with + | Lambda lambda -> + let impl = Map.findUnsafe lambda.exprId vm.lambdas + + // TODO: too many args + if + (NEList.length impl.patterns) = (lambda.argsSoFar.Length + + NEList.length argRegs) + then + DUnit // TODO + else + // TODO + DApplicable applicable + + | NamedFn _namedFn -> + // TODO + DApplicable applicable + + | _ -> + RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) + |> raiseRTE + + vm.registers[putResultIn] <- result + + counter <- counter + 1 | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index b661eb81b2..e7524c6e73 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -33,6 +33,7 @@ + diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 6fe8c75042..606a130510 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -142,6 +142,17 @@ type LetPattern = /// `let () = ()` | LPUnit of id +module LetPattern = + let rec symbolsUsed (pattern : LetPattern) : Set = + match pattern with + | LPVariable(_, name) -> Set.singleton name + | LPTuple(_, first, second, rest) -> + Set.unionMany + [ symbolsUsed first + symbolsUsed second + rest |> List.map symbolsUsed |> Set.unionMany ] + | LPUnit _ -> Set.empty + /// Used for pattern matching in a match statement type MatchPattern = @@ -312,19 +323,19 @@ type Expr = | ETuple of id * Expr * Expr * List // // -- "Applying" args to things, such as fns and lambdas -- - // /// This is a function call, the first expression is the value of the function. - // /// - `expr (args[0])` - // /// - `expr (args[0]) (args[1])` - // /// - `expr (args[0])` - // | EApply of id * expr : Expr * typeArgs : List * args : NEList + /// This is a function call, the first expression is the value of the function. + /// - `expr (args[0])` + /// - `expr (args[0]) (args[1])` + /// - `expr (args[0])` + | EApply of id * expr : Expr * typeArgs : List * args : NEList /// Reference a function name, _usually_ so we can _apply_ it with args | EFnName of id * NameResolution - // // Composed of a parameters * the expression itself - // // The id in the varname list is the analysis id, used to get a livevalue - // // from the analysis engine - // | ELambda of id * pats : NEList * body : Expr + // Composed of a parameters * the expression itself + // The id in the varname list is the analysis id, used to get a livevalue + // from the analysis engine + | ELambda of id * pats : NEList * body : Expr // /// Calls upon an infix function // | EInfix of id * Infix * lhs : Expr * rhs : Expr @@ -417,11 +428,11 @@ module Expr = | ELet(id, _, _, _) | EIf(id, _, _, _) //| EInfix(id, _, _, _) - // | ELambda(id, _, _) + | ELambda(id, _, _) | EFnName(id, _) | ERecordFieldAccess(id, _, _) | EVariable(id, _) - //| EApply(id, _, _, _) + | EApply(id, _, _, _) | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs new file mode 100644 index 0000000000..2ff69614e7 --- /dev/null +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -0,0 +1,85 @@ +module LibExecution.ProgramTypesAst + +open Prelude +open ProgramTypes + +/// TODO type symbols, too +let rec symbolsUsedIn (expr : Expr) : Set = + let r = symbolsUsedIn + + match expr with + // simple values + | EUnit _ + | EBool _ + + | EInt8 _ + | EUInt8 _ + | EInt16 _ + | EUInt16 _ + | EInt32 _ + | EUInt32 _ + | EInt64 _ + | EUInt64 _ + | EInt128 _ + | EUInt128 _ + + | EFloat _ + + | EChar _ -> Set.empty + + | EString(_, segments) -> + segments + |> List.map (fun s -> + match s with + | StringText _ -> Set.empty + | StringInterpolation e -> r e) + |> Set.unionMany + + // simple structures + | ETuple(_, first, second, theRest) -> + [ r first; r second; theRest |> List.map r |> Set.unionMany ] |> Set.unionMany + + | EList(_, exprs) -> exprs |> List.map r |> Set.unionMany + + | EDict(_, pairs) -> pairs |> List.map (fun (_k, v) -> r v) |> Set.unionMany + + + // variables + | EVariable(_, var) -> Set.singleton var + + | ELet(_, _, rhs, next) -> Set.union (r rhs) (r next) + + + // flow control + | EIf(_, condExpr, ifExpr, elseExprMaybe) -> + match elseExprMaybe with + | None -> Set.union (r condExpr) (r ifExpr) + | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] + + | EMatch(_, target, cases) -> + let targetVars = r target + let whenVars = + cases + |> List.map (fun c -> + match c.whenCondition with + | None -> Set.empty + | Some w -> r w) + |> Set.unionMany + let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany + Set.unionMany [ targetVars; whenVars; rhsVars ] + + + // custom data + | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany + + | ERecord(_, _, _, fields) -> + fields |> List.map (fun (_, e) -> r e) |> Set.unionMany + + | ERecordFieldAccess(_, expr, _) -> r expr + + // things that can be applied + | EFnName(_, _) -> Set.empty + | ELambda(_, _, body) -> r body + | EApply(_, thingToApply, _, args) -> + Set.unionMany + [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 22d41ae07e..27bf197265 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -215,7 +215,7 @@ module MatchCase = matchValueInstrFn : int -> RT.Instruction /// Evaluation of the `whenCondition` (if it exists -- might be empty) - whenCondInstructions : RT.Instructions + whenCondInstructions : List /// (jumpBy) -> instr /// `RT.JumpByIfFalse(jumpBy, whenCondResultReg)` @@ -225,7 +225,7 @@ module MatchCase = /// Evaluation of the RHS /// /// Includes `CopyVal(resultReg, rhsResultReg)` - rhsInstrs : RT.Instructions + rhsInstrs : List /// RC after all instructions /// @@ -236,35 +236,39 @@ module MatchCase = module Expr = - let rec toRT (rc : int) (e : PT.Expr) : (int * RT.Instructions * RT.Register) = + let rec toRT (rc : int) (e : PT.Expr) : RT.Instructions = + let justLoadDval dv : RT.Instructions = + { registerCount = rc + 1 + instructions = [ RT.LoadVal(rc, dv) ] + resultIn = rc } + match e with - | PT.EUnit _id -> (rc + 1, [ RT.LoadVal(rc, RT.DUnit) ], rc) + | PT.EUnit _id -> justLoadDval RT.DUnit - | PT.EBool(_id, b) -> (rc + 1, [ RT.LoadVal(rc, RT.DBool b) ], rc) + | PT.EBool(_id, b) -> justLoadDval (RT.DBool b) - | PT.EInt8(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt8 num) ], rc) - | PT.EInt16(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt16 num) ], rc) - | PT.EInt32(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt32 num) ], rc) - | PT.EInt64(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt64 num) ], rc) - | PT.EInt128(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DInt128 num) ], rc) - | PT.EUInt8(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt8 num) ], rc) - | PT.EUInt16(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt16 num) ], rc) - | PT.EUInt32(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt32 num) ], rc) - | PT.EUInt64(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt64 num) ], rc) - | PT.EUInt128(_id, num) -> (rc + 1, [ RT.LoadVal(rc, RT.DUInt128 num) ], rc) + | PT.EInt8(_id, num) -> justLoadDval (RT.DInt8 num) + | PT.EInt16(_id, num) -> justLoadDval (RT.DInt16 num) + | PT.EInt32(_id, num) -> justLoadDval (RT.DInt32 num) + | PT.EInt64(_id, num) -> justLoadDval (RT.DInt64 num) + | PT.EInt128(_id, num) -> justLoadDval (RT.DInt128 num) + | PT.EUInt8(_id, num) -> justLoadDval (RT.DUInt8 num) + | PT.EUInt16(_id, num) -> justLoadDval (RT.DUInt16 num) + | PT.EUInt32(_id, num) -> justLoadDval (RT.DUInt32 num) + | PT.EUInt64(_id, num) -> justLoadDval (RT.DUInt64 num) + | PT.EUInt128(_id, num) -> justLoadDval (RT.DUInt128 num) | PT.EFloat(_id, sign, whole, fraction) -> let whole = if whole = "" then "0" else whole let fraction = if fraction = "" then "0" else fraction - (rc + 1, [ RT.LoadVal(rc, RT.DFloat(makeFloat sign whole fraction)) ], rc) + justLoadDval (RT.DFloat(makeFloat sign whole fraction)) - | PT.EChar(_id, c) -> (rc + 1, [ RT.LoadVal(rc, RT.DChar c) ], rc) + | PT.EChar(_id, c) -> justLoadDval (RT.DChar c) | PT.EString(_id, segments) -> match segments with // if there's only one segment, just load it directly - | [ PT.StringText text ] -> - (rc + 1, [ RT.LoadVal(rc, RT.DString text) ], rc) + | [ PT.StringText text ] -> justLoadDval (RT.DString text) // otherwise, handle each segment separately // and then create a string from the parts @@ -277,14 +281,17 @@ module Expr = (rc, instrs, segments @ [ RT.StringSegment.Text text ]) | PT.StringInterpolation expr -> - let (rcAfterExpr, exprInstrs, exprReg) = toRT rc expr - (rcAfterExpr, - instrs @ exprInstrs, - segments @ [ RT.Interpolated exprReg ])) + let exprInstrs = toRT rc expr + + (exprInstrs.registerCount, + instrs @ exprInstrs.instructions, + segments @ [ RT.Interpolated exprInstrs.resultIn ])) (rc, [], []) segments - (rc + 1, instrs @ [ RT.CreateString(rc, segments) ], rc) + { registerCount = rc + 1 + instructions = instrs @ [ RT.CreateString(rc, segments) ] + resultIn = rc } | PT.EList(_id, items) -> @@ -295,11 +302,15 @@ module Expr = items |> List.fold (fun (rc, instrs, itemResultRegs) item -> - let (newRc, itemInstrs, innerResultReg) = toRT rc item - (newRc, instrs @ itemInstrs, itemResultRegs @ [ innerResultReg ])) + let itemInstrs = toRT rc item + (itemInstrs.registerCount, + instrs @ itemInstrs.instructions, + itemResultRegs @ [ itemInstrs.resultIn ])) init - (regCounter, instrs @ [ RT.CreateList(listReg, itemResultRegs) ], listReg) + { registerCount = regCounter + instructions = instrs @ [ RT.CreateList(listReg, itemResultRegs) ] + resultIn = listReg } | PT.EDict(_id, items) -> @@ -310,50 +321,58 @@ module Expr = items |> List.fold (fun (rc, instrs, entryPairs) (key, value) -> - let (newRc, valueInstrs, valueReg) = toRT rc value - (newRc, instrs @ valueInstrs, entryPairs @ [ (key, valueReg) ])) + let itemInstrs = toRT rc value + (itemInstrs.registerCount, + instrs @ itemInstrs.instructions, + entryPairs @ [ (key, itemInstrs.resultIn) ])) init - (regCounter, instrs @ [ RT.CreateDict(dictReg, entryPairs) ], dictReg) + { registerCount = regCounter + instructions = instrs @ [ RT.CreateDict(dictReg, entryPairs) ] + resultIn = dictReg } | PT.ETuple(_id, first, second, theRest) -> // save the 'first' register for the result let tupleReg, rc = rc, rc + 1 - let (rcAfterFirst, firstInstrs, firstReg) = toRT rc first - let (rcAfterSecond, secondInstrs, secondReg) = toRT rcAfterFirst second + let first = toRT rc first + let second = toRT first.registerCount second let (rcAfterAll, _rcsAfterTheRest, theRestInstrs, theRestRegs) = theRest |> List.fold (fun (rc, rcs, instrs, resultRegs) item -> - let (rcAfterItem, itemInstrs, itemResultReg) = toRT rc item - (rcAfterItem, - rcs @ [ rcAfterItem ], - instrs @ itemInstrs, - resultRegs @ [ itemResultReg ])) - (rcAfterSecond, [], [], []) - - let instrs = - firstInstrs - @ secondInstrs - @ theRestInstrs - @ [ RT.CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) ] - - (rcAfterAll, instrs, tupleReg) + let itemInstrs = toRT rc item + (itemInstrs.registerCount, + rcs @ [ itemInstrs.registerCount ], + instrs @ itemInstrs.instructions, + resultRegs @ [ itemInstrs.resultIn ])) + (second.registerCount, [], [], []) + + { registerCount = rcAfterAll + instructions = + first.instructions + @ second.instructions + @ theRestInstrs + @ [ RT.CreateTuple(tupleReg, first.resultIn, second.resultIn, theRestRegs) ] + resultIn = tupleReg } // let x = 1 | PT.ELet(_id, pat, expr, body) -> - let (regCounter, exprInstrs, exprReg) = toRT rc expr - let patInstr = LetPattern.toInstr exprReg pat - let (regCounter, bodyInstrs, bodyExprReg) = toRT regCounter body - (regCounter, exprInstrs @ [ patInstr ] @ bodyInstrs, bodyExprReg) + let exprInstrs = toRT rc expr + let patInstr = LetPattern.toInstr exprInstrs.resultIn pat + let bodyInstrs = toRT exprInstrs.registerCount body + { registerCount = bodyInstrs.registerCount + instructions = + exprInstrs.instructions @ [ patInstr ] @ bodyInstrs.instructions + resultIn = bodyInstrs.resultIn } | PT.EVariable(_id, varName) -> - let reg = rc - (rc + 1, [ RT.GetVar(reg, varName) ], reg) + { registerCount = rc + 1 + instructions = [ RT.GetVar(rc, varName) ] + resultIn = rc } | PT.EIf(_id, cond, thenExpr, elseExpr) -> @@ -361,56 +380,64 @@ module Expr = // so we'll create this, and copy to it at the end of each branch let resultReg, rc = rc, rc + 1 - let (rcAfterCond, condInstrs, condReg) = toRT rc cond - let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, condReg) ] + let cond = toRT rc cond + let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, cond.resultIn) ] - let (rcAfterThen, thenInstrs, thenResultReg) = toRT rcAfterCond thenExpr - let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenResultReg) ] + let thenInstrs = toRT cond.registerCount thenExpr + let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenInstrs.resultIn) ] match elseExpr with | None -> let instrs = [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit - @ condInstrs + @ cond.instructions @ jumpIfCondFalse ( // goto the first instruction past the `if` // (the 1 is for the copy instruction) - List.length thenInstrs + 1 + List.length thenInstrs.instructions + 1 ) - @ thenInstrs + @ thenInstrs.instructions @ copyThenToResultInstr - (rcAfterThen, instrs, resultReg) + { registerCount = thenInstrs.registerCount + instructions = instrs + resultIn = resultReg } | Some elseExpr -> - let (rcAfterElse, elseInstrs, elseResultReg) = toRT rcAfterThen elseExpr - let copyToResultInstr = [ RT.CopyVal(resultReg, elseResultReg) ] + let elseInstrs = toRT thenInstrs.registerCount elseExpr + let copyToResultInstr = [ RT.CopyVal(resultReg, elseInstrs.resultIn) ] let instrs = // cond -- if cond `false`, jump to start of 'else' block - condInstrs + cond.instructions @ jumpIfCondFalse ( // goto the first instruction past the `if` // (first 1 is for the copy instruction) // (second 1 is for the jump instruction) - List.length thenInstrs + 1 + 1 + List.length thenInstrs.instructions + 1 + 1 ) // then - @ thenInstrs + @ thenInstrs.instructions @ copyThenToResultInstr - @ [ RT.JumpBy(List.length elseInstrs + 1) ] + @ [ RT.JumpBy(List.length elseInstrs.instructions + 1) ] // else - @ elseInstrs + @ elseInstrs.instructions @ copyToResultInstr - (rcAfterElse, instrs, resultReg) + { registerCount = elseInstrs.registerCount + instructions = instrs + resultIn = resultReg } | PT.EFnName(_, Ok name) -> - let reg = rc - (rc + 1, [ RT.LoadVal(reg, RT.DFnVal(RT.NamedFn(FQFnName.toRT name))) ], reg) + let namedFn : RT.ApplicableNamedFn = + { name = FQFnName.toRT name; argsSoFar = [] } + let applicable = RT.DApplicable(RT.NamedFn namedFn) + { registerCount = rc + 1 + instructions = [ RT.LoadVal(rc, applicable) ] + resultIn = rc } | PT.EFnName(_, Error nre) -> // TODO improve @@ -418,47 +445,51 @@ module Expr = // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. // maybe the 'value' here is (still) some unresolved name? // (which should fail when we apply it) - (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], rc) - - - // | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> - // let (regCounter, thingToApplyInstrs, thingToApplyReg) = - // // (usually, a fn name) - // toRT rc thingToApplyExpr - // // TODO: maybe one or both of these lists should be an `NEList`? - - // // CLEANUP find a way to get rid of silly NEList stuff - // let (regCounter, argInstrs, argRegs) = - // let init = (regCounter, [], []) - - // args - // |> NEList.fold - // (fun (rc, instrs, argResultRegs) arg -> - // let (newRc, newInstrs, argResultReg) = toRT rc arg - // (newRc, instrs @ newInstrs, argResultRegs @ [ argResultReg ])) - // init + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = rc } + + + | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> + let thingToApply = toRT rc thingToApplyExpr + // TODO: maybe one or both of these lists should be an `NEList`? + + // CLEANUP find a way to get rid of silly NEList stuff + let (regCounter, argInstrs, argRegs) = + let init = (thingToApply.registerCount, [], []) + + args + |> NEList.fold + (fun (rc, instrs, argResultRegs) arg -> + let newInstrs = toRT rc arg + (newInstrs.registerCount, + instrs @ newInstrs.instructions, + argResultRegs @ [ newInstrs.resultIn ])) + init - // let putResultIn = regCounter - // let callInstr = - // RT.Apply( - // putResultIn, - // thingToApplyReg, - // List.map TypeReference.toRT typeArgs, - // NEList.ofListUnsafe "" [] argRegs - // ) + let putResultIn = regCounter + let callInstr = + RT.Apply( + putResultIn, + thingToApply.resultIn, + List.map TypeReference.toRT typeArgs, + NEList.ofListUnsafe "" [] argRegs + ) - // (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) + { registerCount = regCounter + 1 + instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] + resultIn = putResultIn } | PT.EMatch(_id, expr, cases) -> // first, the easy part - compile the expression we're `match`ing against. - let (rcAfterExpr, exprInstrs, exprResultReg) = toRT rc expr + let expr = toRT rc expr // Shortly, we'll compile each of the cases. // We'll use this `resultReg` to store the final result of the match // , so we have a consistent place to look for it. // (similar to how we handle `EIf` -- refer to that for a simpler example) - let resultReg, rcAfterResult = rcAfterExpr, rcAfterExpr + 1 + let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 // We compile each `case` in two phases, because some instrs require knowing // how many instrs to jump over, which we can't know until we know the basics @@ -473,21 +504,20 @@ module Expr = match c.whenCondition with | None -> (rcAfterResult, [], None) | Some whenCond -> - let (rcAfterWhenCond, whenCondInstrs, whenCondReg) = - toRT rcAfterResult whenCond - (rcAfterWhenCond, - whenCondInstrs, - Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCondReg))) + let whenCond = toRT rcAfterResult whenCond + (whenCond.registerCount, + whenCond.instructions, + Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) // compile the `rhs` of the case - let rcAfterRhs, rhsInstrs, rhsResultReg = toRT rcAfterWhenCond c.rhs + let rhs = toRT rcAfterWhenCond c.rhs // return the intermediate results, as far along as they are - { matchValueInstrFn = MatchPattern.toMatchInstr exprResultReg c.pat + { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat whenCondInstructions = whenCondInstrs whenCondJump = whenCondJump - rhsInstrs = rhsInstrs @ [ RT.CopyVal(resultReg, rhsResultReg) ] - rc = rcAfterRhs }) + rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] + rc = rhs.registerCount }) let countInstrsForCase (c : MatchCase.IntermediateValue) : int = 1 // for the `MatchValue` instruction @@ -535,17 +565,19 @@ module Expr = instrs @ caseInstrs) [] - let instrs = exprInstrs @ caseInstrs @ [ RT.MatchUnmatched ] + let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max - (rcAtEnd, instrs, resultReg) + { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } // -- Records -- | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> let returnReg = 0 // TODO - not sure what to do here - (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], returnReg) + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = returnReg } | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> // fields : List @@ -557,19 +589,34 @@ module Expr = fields |> List.fold (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> - let (newRc, newInstrs, fieldReg) = toRT rc fieldExpr - (newRc, instrs @ newInstrs, fieldRegs @ [ (fieldName, fieldReg) ])) + let field = toRT rc fieldExpr + (field.registerCount, + instrs @ field.instructions, + fieldRegs @ [ (fieldName, field.resultIn) ])) (rc, [], []) - (rcAfterFields, - instrs - @ [ RT.CreateRecord( - recordReg, - FQTypeName.toRT typeName, - List.map TypeReference.toRT typeArgs, - fields - ) ], - recordReg) + + + // (rcAfterFields, + // instrs + // @ [ RT.CreateRecord( + // recordReg, + // FQTypeName.toRT typeName, + // List.map TypeReference.toRT typeArgs, + // fields + // ) ], + // recordReg) + + { registerCount = rcAfterFields + instructions = + instrs + @ [ RT.CreateRecord( + recordReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + fields + ) ] + resultIn = recordReg } // | PT.ERecordUpdate(_id, expr, updates) -> // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = @@ -592,16 +639,21 @@ module Expr = // (rc, instrs, targetReg) | PT.ERecordFieldAccess(_id, expr, fieldName) -> - let (rcAfterExpr, exprInstrs, exprReg) = toRT rc expr - (rcAfterExpr + 1, - exprInstrs @ [ RT.GetRecordField(rcAfterExpr, exprReg, fieldName) ], - rcAfterExpr) + let expr = toRT rc expr + + { registerCount = expr.registerCount + 1 + instructions = + expr.instructions + @ [ RT.GetRecordField(expr.registerCount, expr.resultIn, fieldName) ] + resultIn = expr.registerCount } // -- Enums -- | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> let returnReg = 0 // TODO - not sure what to do here - (rc, [ RT.RaiseNRE(NameResolutionError.toRT nre) ], returnReg) + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = returnReg } | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> // fields : List @@ -611,20 +663,46 @@ module Expr = fields |> List.fold (fun (rc, instrs, fieldRegs) fieldExpr -> - let (newRc, newInstrs, fieldReg) = toRT rc fieldExpr - (newRc, instrs @ newInstrs, fieldRegs @ [ fieldReg ])) + let afterField = toRT rc fieldExpr + (afterField.registerCount, + instrs @ afterField.instructions, + fieldRegs @ [ afterField.resultIn ])) (rc, [], []) - (rcAfterFields, - instrs - @ [ RT.CreateEnum( - enumReg, - FQTypeName.toRT typeName, - List.map TypeReference.toRT typeArgs, - caseName, - fields - ) ], - enumReg) + { registerCount = rcAfterFields + instructions = + instrs + @ [ RT.CreateEnum( + enumReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + caseName, + fields + ) ] + resultIn = enumReg } + + + | PT.ELambda(id, pats, body) -> + let symbolsToClose = + // exclude symbols that are defined/overridden in the lambda's parameters/pats + let usedInBody = ProgramTypesAst.symbolsUsedIn body + let usedInPats = + pats + |> NEList.toList + |> List.map PT.LetPattern.symbolsUsed + |> Set.unionMany + Set.difference usedInBody usedInPats + + let impl : RT.LambdaImpl = + { exprId = id + patterns = NEList.map LetPattern.toRT pats + symbolsToClose = symbolsToClose + instructions = toRT 0 body } + + { registerCount = rc + 1 + instructions = [ RT.CreateLambda(rc, impl) ] + resultIn = rc } + diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 011f9fce83..fcda2c75c3 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -1,43 +1,19 @@ -/// The core types and functions used by the Dark language's runtime. These -/// are not identical to the serialized types or the types used in the Editor, -/// as those have unique constraints (typically, backward compatibility or -/// continuous delivery). +/// The core types and functions used by the Dark language's runtime. +/// +/// If you need to save data of this format, create a set of new +/// types and convert this type into them. (even if they are identical). +/// +/// This format is lossy, relative to the serialized types; use IDs to refer back. module LibExecution.RuntimeTypes -// The design of these types is intended to accomodate the unique design of -// Dark, that it's being run sometimes in an editor and sometimes in -// production, etc. - -// This typically represents our most accurate representation of the language -// as it is today, however, slight variations of these types are expected to -// exist in other places representing different constraints, such as how -// we've put something in some kind of storage, sending it to some API, etc. -// Those types will always be converted to these types for execution. -// -// The reason these are distinct formats from the serialized types is that -// those types are very difficult to change, while we want this to be -// straightforward to change. So we transform any serialized formats into -// this one for running. We remove any "syntactic sugar" (editor/display only -// features). -// -// These formats should never be serialized/deserialized, that defeats the -// purpose. If you need to save data of this format, create a set of new -// types and convert this type into them. (even if they are identical). -// -// This format is lossy, relative to the serialized types. Use IDs to refer -// back. - open System.Threading.Tasks open FSharp.Control.Tasks open Prelude -let modulePattern = @"^[A-Z][a-z0-9A-Z_]*$" -let fnNamePattern = @"^[a-z][a-z0-9A-Z_']*$" let builtinNamePattern = @"^(__|[a-z])[a-z0-9A-Z_]\w*$" let constantNamePattern = @"^[a-z][a-z0-9A-Z_']*$" - let assertBuiltin (name : string) (version : int) @@ -60,10 +36,6 @@ module FQTypeName = let fqPackage (id : uuid) : FQTypeName = Package id -// let toString (name : FQTypeName) : string = -// match name with -// | Package p -> string p // TODO: better - /// A Fully-Qualified Constant Name /// @@ -94,11 +66,6 @@ module FQConstantName = let name = s.name if s.version = 0 then name else $"{name}_v{s.version}" -// let toString (name : FQConstantName) : string = -// match name with -// | Builtin b -> builtinToString b -// | Package p -> string p // TODO: better - /// A Fully-Qualified Function Name /// @@ -127,19 +94,15 @@ module FQFnName = let fqPackage (id : uuid) : FQFnName = Package id - let builtinToString (s : Builtin) : string = - let name = s.name - if s.version = 0 then name else $"{name}_v{s.version}" - let packageToString (s : Package) : string = string s // TODO: better + let isInternalFn (fnName : Builtin) : bool = fnName.name.Contains "darkInternal" - let toString (name : FQFnName) : string = - match name with - | Builtin b -> builtinToString b - | Package pkg -> packageToString pkg - let isInternalFn (fnName : Builtin) : bool = fnName.name.Contains("darkInternal") +type NameResolutionError = + | NotFound of List + | InvalidName of List +type NameResolution<'a> = Result<'a, NameResolutionError> /// A KnownType represents the type of a dval. @@ -167,12 +130,12 @@ type KnownType = | KTUuid | KTDateTime - /// let empty = [] // KTList Unknown - /// let intList = [1] // KTList (ValueType.Known KTInt64) + /// `let empty = []` // KTList Unknown + /// `let intList = [1]` // KTList (ValueType.Known KTInt64) | KTList of ValueType - /// Intuitively, since Dvals generate KnownTypes, you would think that we can - /// use KnownTypes in a KTTuple. + /// Intuitively, since `Dval`s generate `KnownType`s, you would think that we can + /// use `KnownType`s in a `KTTuple`. /// /// However, we sometimes construct a KTTuple to repesent the type of a Tuple /// which doesn't exist. For example, in `List.zip [] []`, we create the result @@ -219,10 +182,6 @@ and [] ValueType = | Known of KnownType -// ------------ -// Exprs -// ------------ - /// The LHS pattern in /// - a `let` binding (in `let x = 1`, the `x`) /// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` @@ -240,23 +199,7 @@ type LetPattern = | LPUnit - - - -// ------------ -// Instructions ("bytecode") -// ------------ - -[] -type register - -type NameResolutionError = - | NotFound of List - | InvalidName of List - -type NameResolution<'a> = Result<'a, NameResolutionError> - -and TypeReference = +type TypeReference = | TUnit | TBool | TInt8 @@ -322,9 +265,19 @@ and TypeReference = isConcrete this -and Register = int // // TODO: unit of measure -and MatchPattern = +/// Our record/tracking of any type arguments in scope +/// +/// i.e. within the execution of +/// `let serialize<'a> (x : 'a) : string = ...`, +/// called with inputs +/// `serialize 1`, +/// we would have a TypeSymbolTable of +/// { "a" => TInt64 } +type TypeSymbolTable = Map + + +type MatchPattern = | MPUnit | MPBool of bool | MPInt8 of int8 @@ -348,7 +301,17 @@ and MatchPattern = theRest : List | MPVariable of string -and StringSegment = + +// ------------ +// Instructions ("bytecode") +// ------------ + +[] +type register + +type Register = int // // TODO: unit of measure + +type StringSegment = | Text of string | Interpolated of Register @@ -360,7 +323,7 @@ and StringSegment = /// We could also record the Instruction Index -> ExprID mapping _adjacent_ to RT, /// and only load it when needed. /// That way, the Interpreter could be lighter-weight. -and Instruction = +type Instruction = // == Simple register operations == /// Push a ("constant") value into a register | LoadVal of loadTo : Register * Dval @@ -451,44 +414,117 @@ and Instruction = // == Working with things that Apply == - // /// Apply some args (and maybe type args) to something - // /// (a named function, or lambda, etc) - // | Apply of - // putResultIn : Register * - // thingToApply : Register * - // typeArgs : List * - // args : NEList + | CreateLambda of createTo : Register * lambda : LambdaImpl + + /// Apply some args (and maybe type args) to something + /// (a named function, or lambda, etc) + | Apply of + putResultIn : Register * + thingToApply : Register * + //symbolsToClose : List * // any symbols referenced in the thingToApply that should be closed + //typeSymbolsToClose : List * + typeArgs : List * + args : NEList // == Errors == | RaiseNRE of NameResolutionError +/// (rc, instructions, result register) +and Instructions = + { + /// How many registers are used in evaluating these instructions + registerCount : int + /// The instructions themselves + instructions : List -and Instructions = List - -/// (rc, instructions, result register) -and InstructionsWithContext = (int * Instructions * Register) + /// The register that will hold the result of the instructions + resultIn : Register + } and DvalMap = Map -// // Note to self: trying to remove symTable and typeSymbolTable here -// // causes all sorts of scoping issues. Beware. -// // (that said, typeSymbolTable seems the less-risky to remove...) -// and LambdaImpl = -// { typeSymbolTable : TypeSymbolTable -// symtable : Symtable -// parameters : NEList -// body : Expr } +/// Lambdas are a bit special: +/// they have to close over variables, and have their own set of instructions, not embedded in the main set +/// +/// Note to self: trying to remove symTable and typeSymbolTable here +/// causes all sorts of scoping issues. Beware. +/// (that said, typeSymbolTable seems the less-risky to remove...) +and LambdaImpl = + { + // -- Things we know as soon as we create the lambda -- + // maybe we need the TL ID as well? + exprId : id + + /// How should the arguments be deconstructed? + /// + /// When we've received as many args as there are patterns, + /// we should either apply the lambda, or error. + patterns : NEList + + /// When the lambda is bound/used, what symbols should be closed? + symbolsToClose : Set + + // Hmm do these actually belong here, or somewhere else? idk how we get this to work. + // do we need to call eval within eval or something? would love to avoid that. + // if so, we might need a pc or something to keep track of where we are in the 'above' instructions + instructions : Instructions + } + +/// Note: the fn's instructions are loaded to VMState +/// but -- where is the pc and return address stored +/// in a way that doesn't require us to go deeper in some call stack? +and ApplicableNamedFn = { name : FQFnName.FQFnName; argsSoFar : List } + +and ApplicableLambda = + { + /// The lambda's ID, corresponding to the PT.Expr + /// (the actual implementation is stored in the VMState) + exprId : id + + // TODO maybe we need a returnRegister or something + // or maybe that's handled by the apply + + /// The symtable at the time of creation + /// (only copy what's noted in `symbolsToClose`) + symtable : Symtable + + // TODO: typeSymbolTable : TypeSymbolTable + + argsSoFar : List + } +// member this.withAdditionalArgs (args : Dval) : ApplicableLambda = +// // ah but these should be type-checked as we add them. move this to TypeChecker instead. +// { this with argsSoFar = this.argsSoFar @ args } + +/// Any thing that can be applied, +/// along with anything needed within their application closure +/// TODO: follow up with typeSymbols +/// TODO needs a better name, clearly. +and Applicable = + /// The details are in the LambdaImpl + /// , stored in the VMState after being loaded by a LoadLambda instruction + | Lambda of ApplicableLambda + + | NamedFn of ApplicableNamedFn -and FnValImpl = - // TODO: consider inlining these cases (DLambnda, DNamedBuiltinFn, DNamedPackageFn) - // maybe this includes partially-applied stuff? - // or maybe we have a separate type for that? idk. - //| Lambda of LambdaImpl - | NamedFn of FQFnName.FQFnName +(* +let someOtherData = true +let partiallyApplied = List.map (fun url -> (url, someOtherData, String.length url)) +let someOtherData = false +let urls = ["https://stachu.net"; "https://darklang.com"] +let urlsAndLengths = partiallyApplied urls +*) +(* +fn myAdd (x: Int) (y: Int): Int = + x + y + +let increment = myAdd (3 - 2) +let result = increment 5 +*) // We use NoComparison here to avoid accidentally using structural comparison @@ -551,13 +587,13 @@ and [] Dval = caseName : string * fields : List - // Functions - | DFnVal of FnValImpl // VTTODO I'm not sure how ValueType fits in here + | DApplicable of Applicable // // References // | DDB of name : string + and DvalTask = Ply /// Our record/tracking of any variable bindings in scope @@ -568,15 +604,6 @@ and DvalTask = Ply /// `{ "x" => DInt64 1; "y" => DInt64 2 }` and Symtable = Map -/// Our record/tracking of any type arguments in scope -/// -/// i.e. within the execution of -/// `let serialize<'a> (x : 'a) : string = ...`, -/// called with inputs -/// `serialize 1`, -/// we would have a TypeSymbolTable of -/// { "a" => TInt64 } -and TypeSymbolTable = Map and ExecutionPoint = /// User is executing some "arbitrary" expression, passed in by a user. @@ -592,6 +619,9 @@ and ExecutionPoint = // Executing some function | Function of FQFnName.FQFnName +// Executing some lambda +//| Lambda of parent: ExecutionPoint * exprId: id + /// Record the source expression of an error. /// This is to show the code that was responsible for it. /// TODO maybe rename to ExprLocation @@ -904,7 +934,9 @@ module RuntimeError = // - "Field name is empty" // - "When condition should be a boolean" -- this _could_ warn _or_ error. which? // - $"Expected a record but {typeStr} is something else" - // - $"Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" + + /// "Expected a function value, got something else: {DvalReprDeveloper.toRepr other}" + | ExpectedApplicableButNot of actualTyp : ValueType * actualValue : Dval // - "Attempting to access field '{fieldName}' of a Datastore // (use `DB.*` standard library functions to interact with Datastores. Field access only work with records)" @@ -1004,101 +1036,6 @@ module TypeDeclaration = // Functions for working with Dark runtime values module Dval = - // - // Checks if a runtime's value matches a given type - // - // - // We have nested types so they need to be checked deeper. CLEANUP: - // there is also "real" type checking elsewhere - this should be unified. - // Note, this is primarily used to figure out which argument has ALREADY not - // matched the actual runtime parameter type of the called function. So more - // accuracy is better, as the runtime is perfectly accurate. - // - let rec typeMatches (typ : TypeReference) (dv : Dval) : bool = - let r = typeMatches - - match (dv, typ) with - //| _, TVariable _ -> true - - | DUnit, TUnit - | DBool _, TBool - - | DInt8 _, TInt8 - | DUInt8 _, TUInt8 - | DInt16 _, TInt16 - | DUInt16 _, TUInt16 - | DInt32 _, TInt32 - | DUInt32 _, TUInt32 - | DInt64 _, TInt64 - | DUInt64 _, TUInt64 - | DInt128 _, TInt128 - | DUInt128 _, TUInt128 - - | DFloat _, TFloat - - | DChar _, TChar - | DString _, TString - - | DDateTime _, TDateTime - | DUuid _, TUuid - - -> true - - | DList(_vtTODO, l), TList t -> List.all (r t) l - | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> - let pairs = - [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes - - pairs |> List.all (fun (v, subtype) -> r subtype v) - | DDict(_vtTODO, m), TDict t -> Map.all (r t) m - - | DRecord(typeName, _, _typeArgsTODO, _fields), - TCustomType(Ok typeName', _typeArgs) -> - // TYPESCLEANUP: should load type by name - // TYPESCLEANUP: are we handling type arguments here? - // TYPESCLEANUP: do we need to check fields? - typeName = typeName' - - | DEnum(_, typeName, _typeArgsDEnumTODO, _casename, _fields), - TCustomType(Ok typeName', _typeArgsExpected) -> - // TYPESCLEANUP: should load type by name - // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare - // against the typeArgs in the DEnum - their zipped values should merge OK - typeName = typeName' - - // | DFnVal(Lambda l), TFn(parameters, _) -> - // NEList.length parameters = NEList.length l.parameters - - // | DDB _, TDB _ - - // exhaustiveness checking - | DUnit, _ - | DBool _, _ - | DInt8 _, _ - | DUInt8 _, _ - | DInt16 _, _ - | DUInt16 _, _ - | DInt32 _, _ - | DUInt32 _, _ - | DInt64 _, _ - | DUInt64 _, _ - | DInt128 _, _ - | DUInt128 _, _ - | DFloat _, _ - | DChar _, _ - | DString _, _ - | DDateTime _, _ - | DUuid _, _ - | DList _, _ - | DTuple _, _ - | DDict _, _ - | DRecord _, _ - | DEnum _, _ - | DFnVal _, _ - // | DDB _, _ - -> false - - let rec toValueType (dv : Dval) : ValueType = match dv with | DUnit -> ValueType.Known KTUnit @@ -1134,14 +1071,15 @@ module Dval = | DEnum(typeName, _, typeArgs, _, _) -> KTCustomType(typeName, typeArgs) |> ValueType.Known - | DFnVal fnImpl -> - match fnImpl with - // | Lambda lambda -> - // KTFn( - // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, - // ValueType.Unknown - // ) - // |> ValueType.Known + | DApplicable applicable -> + match applicable with + | Lambda _lambda -> + // KTFn( + // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, + // ValueType.Unknown + // ) + // |> ValueType.Known + ValueType.Unknown // VTTODO look up type, etc | NamedFn _named -> ValueType.Unknown @@ -1200,7 +1138,7 @@ module PackageFn = typeParams : List parameters : NEList returnType : TypeReference - body : InstructionsWithContext } + body : Instructions } // // ------------ @@ -1334,7 +1272,7 @@ and BuiltInFnSig = and FnImpl = | BuiltInFunction of BuiltInFnSig - | PackageFunction of FQFnName.Package * InstructionsWithContext //* localCount: int + | PackageFunction of FQFnName.Package * Instructions //* localCount: int and FunctionRecord = Source * FQFnName.FQFnName @@ -1473,40 +1411,29 @@ and VMState = mutable pc : int instructions : Instruction array - registers : Registers // mutable because array? resultReg : Register - mutable callStack : CallStack - - mutable symbolTable : Symtable - mutable typeSymbolTable : TypeSymbolTable - } - // static member empty = - // { pc = 0 - // callStack = CallStack.fromEntryPoint(ExecutionPoint.BuiltIn) + mutable callStack : CallStack - // instructions = Array.empty - // registers = Array.empty - // resultReg = 0 + registers : Registers // mutable because array? + mutable symbolTable : Symtable // should this be a ConcurrentDictionary rather than a Map that's `mutable`? + mutable typeSymbolTable : TypeSymbolTable // same here - // symbolTable = Map.empty - // typeSymbolTable = Map.empty } + mutable lambdas : Map + } - static member fromInstructions - (entrypoint) - (instructions : InstructionsWithContext) - : VMState = - let registersNeeded, instructions, resultReg = instructions + static member fromInstructions (entrypoint) (instrs : Instructions) : VMState = { pc = 0 callStack = CallStack.fromEntryPoint entrypoint - instructions = List.toArray instructions - registers = Array.zeroCreate registersNeeded - resultReg = resultReg + instructions = List.toArray instrs.instructions + registers = Array.zeroCreate instrs.registerCount + resultReg = instrs.resultIn symbolTable = Map.empty - typeSymbolTable = Map.empty } + typeSymbolTable = Map.empty + lambdas = Map.empty } and Types = { typeSymbolTable : TypeSymbolTable diff --git a/backend/src/Prelude/StringBuilder.fs b/backend/src/Prelude/StringBuilder.fs index e34e8902d7..cba4e04334 100644 --- a/backend/src/Prelude/StringBuilder.fs +++ b/backend/src/Prelude/StringBuilder.fs @@ -2,5 +2,5 @@ module StringBuilder open System.Text -let append (sb : StringBuilder) (s: string): unit = +let append (sb : StringBuilder) (s : string) : unit = sb.Append s |> ignore diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index ab0a5d64b7..30839477cb 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -79,9 +79,9 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // |> PT2RT.FQFnName.toRT // |> fun x -> EFnName(gid (), x) -// let eLambda (pats : List) (body : Expr) : Expr = -// let pats = NEList.ofListUnsafe "eLambda" [] pats -// ELambda(gid (), pats, body) +let eLambda id (pats : List) (body : Expr) : Expr = + let pats = NEList.ofListUnsafe "eLambda" [] pats + ELambda(id, pats, body) // let eFn' @@ -102,13 +102,13 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // eFn' function_ version typeArgs args -// let eApply -// (target : Expr) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eApply" [] args -// EApply(gid (), target, typeArgs, args) +let eApply + (target : Expr) + (typeArgs : List) + (args : List) + : Expr = + let args = NEList.ofListUnsafe "eApply" [] args + EApply(gid (), target, typeArgs, args) diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 96cff0833f..86fc706270 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -376,7 +376,7 @@ module Expect = | DDateTime _ | DUuid _ - | DFnVal _ + | DApplicable _ // | DDB _ -> true @@ -881,7 +881,7 @@ module Expect = | DDict _, _ | DRecord _, _ | DEnum _, _ - | DFnVal _, _ + | DApplicable _, _ // | DDB _, _ -> check path actual expected @@ -954,7 +954,7 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = | DString _ // TODO: should actually traverse in interpolations | DUuid _ | DDateTime _ - | DFnVal _ + | DApplicable _ // | DDB _ -> f dv f dv diff --git a/backend/tests/Tests/Builtin.Tests.fs b/backend/tests/Tests/Builtin.Tests.fs index 9e450bfa1d..2467eecb40 100644 --- a/backend/tests/Tests/Builtin.Tests.fs +++ b/backend/tests/Tests/Builtin.Tests.fs @@ -18,6 +18,8 @@ module Exe = LibExecution.Execution open TestUtils.TestUtils +let builtinToString (name : RT.FQFnName.Builtin) = $"{name.name}_v{name.version}" + let oldFunctionsAreDeprecated = testTask "old functions are deprecated" { let mutable counts = Map.empty @@ -26,7 +28,7 @@ let oldFunctionsAreDeprecated = fns |> List.iter (fun fn -> - let key = RT.FQFnName.builtinToString { fn.name with version = 0 } + let key = builtinToString fn.name if fn.deprecated = RT.NotDeprecated then counts <- diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 5cfb9ba8ea..d93f840675 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -13,7 +13,12 @@ module RTE = RT.RuntimeError module E = TestValues.Expressions module PM = TestValues.PM -let t name ptExpr expectedInsts = +let tCheckVM + name + ptExpr + expectedInsts + (extraVmStateAssertions : RT.VMState -> unit) + = testTask name { let vmState = ptExpr @@ -24,9 +29,16 @@ let t name ptExpr expectedInsts = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false let! actual = LibExecution.Interpreter.eval exeState vmState |> Ply.toTask - return Expect.equal actual expectedInsts "" + Expect.equal actual expectedInsts "" + + extraVmStateAssertions vmState } +let t name ptExpr expectedInsts = + tCheckVM name ptExpr expectedInsts (ignore) + + + let tFail name ptExpr expectedRte = testTask name { let instructionsWithContext = ptExpr |> PT2RT.Expr.toRT 0 @@ -302,6 +314,22 @@ module RecordFieldAccess = testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] +module Lambdas = + let identityUnapplied = + tCheckVM + "fn x -> x" + E.Lambdas.identityUnapplied + (RT.DApplicable( + RT.Lambda + { exprId = E.Lambdas.identityID; symtable = Map.empty; argsSoFar = [] } + )) + (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + + let identityApplied = t "(fn x -> x) 1" E.Lambdas.identityApplied (RT.DInt64 1L) + + let tests = testList "Lambdas" [ identityUnapplied; identityApplied ] + + let tests = testList "Interpreter" @@ -314,4 +342,5 @@ let tests = Tuples.tests Match.tests Records.tests - RecordFieldAccess.tests ] + RecordFieldAccess.tests + Lambdas.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 8ec25e4cf8..609d14ee7d 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -19,6 +19,7 @@ module PM = TestValues.PM let t name expr expected = testTask name { let actual = PT2RT.Expr.toRT 0 expr + let actual = (actual.registerCount, actual.instructions, actual.resultIn) return Expect.equal actual expected "" } @@ -598,6 +599,46 @@ module RecordUpdate = let tests = testList "RecordUpdate" [] +module Lambda = + let identityUnapplied = + t + "fn x -> x" + E.Lambdas.identityUnapplied + (1, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.identityID + patterns = NEList.ofList (RT.LPVariable "x") [] + symbolsToClose = [] |> Set.ofList + instructions = + { registerCount = 1 + instructions = [ RT.GetVar(0, "x") ] + resultIn = 0 } } + ) ], + 0) + + let identityApplied = + t + "(fn x -> x) 1" + E.Lambdas.identityApplied + (3, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.identityID + patterns = NEList.ofList (RT.LPVariable "x") [] + symbolsToClose = [] |> Set.ofList + instructions = + { registerCount = 1 + instructions = [ RT.GetVar(0, "x") ] + resultIn = 0 } } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + let tests = testList "Lambda" [ identityUnapplied; identityApplied ] + + let tests = testList "PT2RT" @@ -611,4 +652,5 @@ let tests = Match.tests Records.tests RecordFieldAccess.tests - RecordUpdate.tests ] + RecordUpdate.tests + Lambda.tests ] diff --git a/backend/tests/Tests/ProgramTypes.Tests.fs b/backend/tests/Tests/ProgramTypes.Tests.fs index af34fa6ea6..4d9ebb8099 100644 --- a/backend/tests/Tests/ProgramTypes.Tests.fs +++ b/backend/tests/Tests/ProgramTypes.Tests.fs @@ -36,11 +36,11 @@ module PackageIDs = LibExecution.PackageIDs // | _ -> return Exception.raiseInternal "Error executing parsePTExpr function" [] // } -let ptFQFnName = - testMany - "ProgramTypes.FnName.ToString" - (fun name -> name |> PT2RT.FQFnName.toRT |> RT.FQFnName.toString) - [ (PT.FQFnName.fqBuiltIn "stringAppend" 1), "stringAppend_v1" ] +// let ptFQFnName = +// testMany +// "ProgramTypes.FnName.ToString" +// (fun name -> name |> PT2RT.FQFnName.toRT |> RT.FQFnName.toString) +// [ (PT.FQFnName.fqBuiltIn "stringAppend" 1), "stringAppend_v1" ] let pmPT = PT.PackageManager.empty @@ -148,7 +148,7 @@ let tests = testList "ProgramTypes" [ //testPipesToRuntimeTypes - //testProgramTypesToRuntimeTypes - ptFQFnName - //testInfixProgramTypesToSerializedTypes - ] + //testProgramTypesToRuntimeTypes + //ptFQFnName + //testInfixProgramTypesToSerializedTypes + ] diff --git a/backend/tests/Tests/RuntimeTypes.Tests.fs b/backend/tests/Tests/RuntimeTypes.Tests.fs index 00e514d9e9..51d301e709 100644 --- a/backend/tests/Tests/RuntimeTypes.Tests.fs +++ b/backend/tests/Tests/RuntimeTypes.Tests.fs @@ -6,41 +6,136 @@ open TestUtils.TestUtils module RT = LibExecution.RuntimeTypes -let dvalTypeMatches = - testList - "dvalTypeMatches" - [ test "matching tuple" { - let v = - RT.Dval.DTuple( - RT.Dval.DInt64 1, - RT.Dval.DString "two", - [ RT.Dval.DFloat 3.14 ] - ) - let tipe = - RT.TypeReference.TTuple( - RT.TypeReference.TInt64, - RT.TypeReference.TString, - [ RT.TypeReference.TFloat ] - ) - - Expect.isTrue (RT.Dval.typeMatches tipe v) "" - } - - test "non-matching tuple" { - let v = - RT.Dval.DTuple( - RT.Dval.DInt64 1, - RT.Dval.DString "two", - [ RT.Dval.DFloat 3.14 ] - ) - let tipe = - RT.TypeReference.TTuple( - RT.TypeReference.TInt64, - RT.TypeReference.TString, - [ RT.TypeReference.TChar ] - ) - - Expect.isFalse (RT.Dval.typeMatches tipe v) "" - } ] - -let tests = testList "RuntimeTypes" [ dvalTypeMatches ] + +// // +// // Checks if a runtime's value matches a given type +// // +// // +// // We have nested types so they need to be checked deeper. CLEANUP: +// // there is also "real" type checking elsewhere - this should be unified. +// // Note, this is primarily used to figure out which argument has ALREADY not +// // matched the actual runtime parameter type of the called function. So more +// // accuracy is better, as the runtime is perfectly accurate. +// // +// let rec typeMatches (typ : TypeReference) (dv : Dval) : bool = +// let r = typeMatches + +// match (dv, typ) with +// //| _, TVariable _ -> true + +// | DUnit, TUnit +// | DBool _, TBool + +// | DInt8 _, TInt8 +// | DUInt8 _, TUInt8 +// | DInt16 _, TInt16 +// | DUInt16 _, TUInt16 +// | DInt32 _, TInt32 +// | DUInt32 _, TUInt32 +// | DInt64 _, TInt64 +// | DUInt64 _, TUInt64 +// | DInt128 _, TInt128 +// | DUInt128 _, TUInt128 + +// | DFloat _, TFloat + +// | DChar _, TChar +// | DString _, TString + +// | DDateTime _, TDateTime +// | DUuid _, TUuid + +// -> true + +// | DList(_vtTODO, l), TList t -> List.all (r t) l +// | DTuple(first, second, theRest), TTuple(firstType, secondType, otherTypes) -> +// let pairs = +// [ (first, firstType); (second, secondType) ] @ List.zip theRest otherTypes + +// pairs |> List.all (fun (v, subtype) -> r subtype v) +// | DDict(_vtTODO, m), TDict t -> Map.all (r t) m + +// | DRecord(typeName, _, _typeArgsTODO, _fields), +// TCustomType(Ok typeName', _typeArgs) -> +// // TYPESCLEANUP: should load type by name +// // TYPESCLEANUP: are we handling type arguments here? +// // TYPESCLEANUP: do we need to check fields? +// typeName = typeName' + +// | DEnum(_, typeName, _typeArgsDEnumTODO, _casename, _fields), +// TCustomType(Ok typeName', _typeArgsExpected) -> +// // TYPESCLEANUP: should load type by name +// // TYPESCLEANUP: convert TCustomType's typeArgs to valueTypes, and compare +// // against the typeArgs in the DEnum - their zipped values should merge OK +// typeName = typeName' + +// // | DFnVal(Lambda l), TFn(parameters, _) -> +// // NEList.length parameters = NEList.length l.parameters + +// // | DDB _, TDB _ + +// // exhaustiveness checking +// | DUnit, _ +// | DBool _, _ +// | DInt8 _, _ +// | DUInt8 _, _ +// | DInt16 _, _ +// | DUInt16 _, _ +// | DInt32 _, _ +// | DUInt32 _, _ +// | DInt64 _, _ +// | DUInt64 _, _ +// | DInt128 _, _ +// | DUInt128 _, _ +// | DFloat _, _ +// | DChar _, _ +// | DString _, _ +// | DDateTime _, _ +// | DUuid _, _ +// | DList _, _ +// | DTuple _, _ +// | DDict _, _ +// | DRecord _, _ +// | DEnum _, _ +// | DFnVal _, _ +// // | DDB _, _ +// -> false + +// let dvalTypeMatches = +// testList +// "dvalTypeMatches" +// [ test "matching tuple" { +// let v = +// RT.Dval.DTuple( +// RT.Dval.DInt64 1, +// RT.Dval.DString "two", +// [ RT.Dval.DFloat 3.14 ] +// ) +// let tipe = +// RT.TypeReference.TTuple( +// RT.TypeReference.TInt64, +// RT.TypeReference.TString, +// [ RT.TypeReference.TFloat ] +// ) + +// Expect.isTrue (RT.Dval.typeMatches tipe v) "" +// } + +// test "non-matching tuple" { +// let v = +// RT.Dval.DTuple( +// RT.Dval.DInt64 1, +// RT.Dval.DString "two", +// [ RT.Dval.DFloat 3.14 ] +// ) +// let tipe = +// RT.TypeReference.TTuple( +// RT.TypeReference.TInt64, +// RT.TypeReference.TString, +// [ RT.TypeReference.TChar ] +// ) + +// Expect.isFalse (RT.Dval.typeMatches tipe v) "" +// } ] + +let tests = testList "RuntimeTypes" [] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 6dc7d45bff..975860f243 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -243,3 +243,13 @@ module Expressions = let notRecord = eFieldAccess (eInt64 1) "key" let missingField = eFieldAccess Records.simple "missing" let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" + + + //module RecordUpdate = + + module Lambdas = + let identityID = gid () + + let identityUnapplied = eLambda identityID [ lpVar "x" ] (eVar "x") + + let identityApplied = eApply identityUnapplied [] [ eInt64 1 ] From 4c12a968b47e914dbf033bb6e8e5d9c10ddacba6 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 12 Sep 2024 12:47:01 -0400 Subject: [PATCH 20/60] goodbye symtable --- backend/src/BuiltinExecution/Builtin.fs | 48 +- .../BuiltinExecution/BuiltinExecution.fsproj | 48 +- .../src/BuiltinExecution/Libs/HttpClient.fs | 252 ++-- backend/src/BuiltinExecution/Libs/NoModule.fs | 33 +- backend/src/LibExecution/Execution.fs | 25 +- backend/src/LibExecution/Interpreter.fs | 464 ++---- backend/src/LibExecution/ProgramTypes.fs | 139 +- backend/src/LibExecution/ProgramTypesAst.fs | 66 +- .../ProgramTypesToRuntimeTypes.fs | 811 +++++----- backend/src/LibExecution/RuntimeTypes.fs | 488 +++--- backend/src/LibExecution/TypeChecker.fs | 30 +- backend/src/Prelude/Prelude.fs | 3 + backend/tests/TestUtils/PTShortcuts.fs | 44 +- backend/tests/TestUtils/TestUtils.fs | 6 +- backend/tests/Tests/Interpreter.Tests.fs | 298 ++-- backend/tests/Tests/PT2RT.Tests.fs | 1310 +++++++++-------- backend/tests/Tests/TestValues.fs | 226 +-- .../darklang/languageTools/runtimeTypes.dark | 38 - 18 files changed, 2160 insertions(+), 2169 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 242dfb9988..3e6df8ab25 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -14,46 +14,46 @@ let builtins httpConfig : Builtins = Builtin.combine [ Libs.NoModule.builtins - Libs.Bool.builtins + // Libs.Bool.builtins - Libs.Int8.builtins - Libs.UInt8.builtins - Libs.Int16.builtins - Libs.UInt16.builtins - Libs.Int32.builtins - Libs.UInt32.builtins - Libs.Int64.builtins - Libs.UInt64.builtins - Libs.Int128.builtins - Libs.UInt128.builtins + // Libs.Int8.builtins + // Libs.UInt8.builtins + // Libs.Int16.builtins + // Libs.UInt16.builtins + // Libs.Int32.builtins + // Libs.UInt32.builtins + // Libs.Int64.builtins + // Libs.UInt64.builtins + // Libs.Int128.builtins + // Libs.UInt128.builtins - Libs.Float.builtins + // Libs.Float.builtins - Libs.Math.builtins + // Libs.Math.builtins - Libs.Bytes.builtins + // Libs.Bytes.builtins - Libs.Char.builtins - Libs.String.builtins + // Libs.Char.builtins + // Libs.String.builtins - Libs.List.builtins - Libs.Dict.builtins + // Libs.List.builtins + // Libs.Dict.builtins - Libs.DateTime.builtins - Libs.Uuid.builtins + // Libs.DateTime.builtins + // Libs.Uuid.builtins - Libs.Base64.builtins + // Libs.Base64.builtins // Libs.Json.builtins // Libs.AltJson.builtins Libs.HttpClient.builtins httpConfig - Libs.LanguageTools.builtins + // Libs.LanguageTools.builtins //Libs.Parser.builtins - Libs.Crypto.builtins - Libs.X509.builtins + // Libs.Crypto.builtins + // Libs.X509.builtins //Libs.Packages.builtins pm ] diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index fbae2424c1..441c69d5df 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -12,46 +12,46 @@ - + - - - - - - - - - - + + + + + + + + + + - + - + - + - - + + - - + + - - + + - + - + - - + + diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 804056596b..4a1e462650 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -384,131 +384,133 @@ open LibExecution.Builtin.Shortcuts let fns (config : Configuration) : List = - let httpClient = BaseClient.create config - [ { name = fn "httpClientRequest" 0 - typeParams = [] - parameters = - [ Param.make "method" TString "" - Param.make "uri" TString "" - Param.make "headers" headersType "" - Param.make "body" (TList TUInt8) "" ] - returnType = - TypeReference.result - (TCustomType( - Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response), - [] - )) - (TCustomType( - Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError), - [] - )) - description = - "Make blocking HTTP call to . Returns a where - the response is wrapped in {{ Ok }} if a response was successfully - received and parsed, and is wrapped in {{ Error }} otherwise" - fn = - let typ = FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response - - let responseType = KTCustomType(typ, []) - let resultOk = Dval.resultOk responseType KTString - let typeName = - FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError - let resultError = Dval.resultError responseType (KTCustomType(typeName, [])) - (function - | _, - vmState, - _, - [ DString method; DString uri; DList(_, reqHeaders); DList(_, reqBody) ] -> - uply { - let! (reqHeaders : Result, BadHeader.BadHeader>) = - reqHeaders - |> Ply.List.mapSequentially (fun item -> - uply { - match item with - | DTuple(DString k, DString v, []) -> - let k = String.trim k - if k = "" then - // CLEANUP reconsider if we should error here - return Error BadHeader.BadHeader.EmptyKey - else - return Ok((k, v)) - - | notAPair -> - return! - RuntimeError.ValueNotExpectedType( - notAPair, - TList(TTuple(TString, TString, [])), - RTE.TypeChecker.Context.FunctionCallParameter( - FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, - ({ name = "headers"; typ = headersType }), - 2 - ) - ) - |> raiseRTE vmState.callStack - - }) - |> Ply.map (Result.collect) - - let method = - try - Some(HttpMethod method) - with _ -> - None - - let! (result : Result) = - uply { - match reqHeaders, method with - | Ok reqHeaders, Some method -> - let request = - { url = uri - method = method - headers = reqHeaders - body = Dval.dlistToByteArray reqBody } - - let! response = makeRequest config httpClient request - - match response with - | Ok response -> - let responseHeaders = - response.headers - |> List.map (fun (k, v) -> - DTuple( - DString(String.toLowercase k), - DString(String.toLowercase v), - [] - )) - |> Dval.list (KTTuple(VT.string, VT.string, [])) - - let typ = - FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response - - let fields = - [ ("statusCode", DInt64(int64 response.statusCode)) - ("headers", responseHeaders) - ("body", Dval.byteArrayToDvalList response.body) ] - - return Ok(DRecord(typ, typ, [], Map fields) |> resultOk) - - | Error err -> return Error err - - | Error reqHeadersErr, _ -> - let reqHeadersErr = reqHeadersErr - return Error(RequestError.RequestError.BadHeader reqHeadersErr) - - | _, None -> - let error = RequestError.RequestError.BadMethod - return Error error - } - match result with - | Ok result -> return result - | Error err -> - let err = RequestError.toDT err - return resultError err - } - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } ] + let _httpClient = BaseClient.create config + [ + // { name = fn "httpClientRequest" 0 + // typeParams = [] + // parameters = + // [ Param.make "method" TString "" + // Param.make "uri" TString "" + // Param.make "headers" headersType "" + // Param.make "body" (TList TUInt8) "" ] + // returnType = + // TypeReference.result + // (TCustomType( + // Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response), + // [] + // )) + // (TCustomType( + // Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError), + // [] + // )) + // description = + // "Make blocking HTTP call to . Returns a where + // the response is wrapped in {{ Ok }} if a response was successfully + // received and parsed, and is wrapped in {{ Error }} otherwise" + // fn = + // let typ = FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response + + // let responseType = KTCustomType(typ, []) + // let resultOk = Dval.resultOk responseType KTString + // let typeName = + // FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError + // let resultError = Dval.resultError responseType (KTCustomType(typeName, [])) + // (function + // | _, + // vmState, + // _, + // [ DString method; DString uri; DList(_, reqHeaders); DList(_, reqBody) ] -> + // uply { + // let! (reqHeaders : Result, BadHeader.BadHeader>) = + // reqHeaders + // |> Ply.List.mapSequentially (fun item -> + // uply { + // match item with + // | DTuple(DString k, DString v, []) -> + // let k = String.trim k + // if k = "" then + // // CLEANUP reconsider if we should error here + // return Error BadHeader.BadHeader.EmptyKey + // else + // return Ok((k, v)) + + // | notAPair -> + // return! + // RuntimeError.ValueNotExpectedType( + // notAPair, + // TList(TTuple(TString, TString, [])), + // RTE.TypeChecker.Context.FunctionCallParameter( + // FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, + // ({ name = "headers"; typ = headersType }), + // 2 + // ) + // ) + // |> raiseRTE vmState.callStack + + // }) + // |> Ply.map (Result.collect) + + // let method = + // try + // Some(HttpMethod method) + // with _ -> + // None + + // let! (result : Result) = + // uply { + // match reqHeaders, method with + // | Ok reqHeaders, Some method -> + // let request = + // { url = uri + // method = method + // headers = reqHeaders + // body = Dval.dlistToByteArray reqBody } + + // let! response = makeRequest config httpClient request + + // match response with + // | Ok response -> + // let responseHeaders = + // response.headers + // |> List.map (fun (k, v) -> + // DTuple( + // DString(String.toLowercase k), + // DString(String.toLowercase v), + // [] + // )) + // |> Dval.list (KTTuple(VT.string, VT.string, [])) + + // let typ = + // FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response + + // let fields = + // [ ("statusCode", DInt64(int64 response.statusCode)) + // ("headers", responseHeaders) + // ("body", Dval.byteArrayToDvalList response.body) ] + + // return Ok(DRecord(typ, typ, [], Map fields) |> resultOk) + + // | Error err -> return Error err + + // | Error reqHeadersErr, _ -> + // let reqHeadersErr = reqHeadersErr + // return Error(RequestError.RequestError.BadHeader reqHeadersErr) + + // | _, None -> + // let error = RequestError.RequestError.BadMethod + // return Error error + // } + // match result with + // | Ok result -> return result + // | Error err -> + // let err = RequestError.toDT err + // return resultError err + // } + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + ] let builtins config = Builtin.make [] (fns config) diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 8d65d171d8..c49c4266cc 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -69,19 +69,20 @@ let rec equals (a : Dval) (b : Dval) : bool = | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 r a3 b3 - | DApplicable a, DApplicable b -> - match a, b with - | Lambda _a, Lambda _b -> - //equalsLambdaImpl a b - // TODO - true - | NamedFn _a, NamedFn _b -> - //a = b - // TODO - true - | Lambda _, _ - - | NamedFn _, _ -> false + // | DApplicable a, DApplicable b -> + // match a, b with + // | Lambda _a, Lambda _b -> + // //equalsLambdaImpl a b + // // TODO + // true + // | NamedFn _a, NamedFn _b -> + // //a = b + // // TODO + // true + // | Lambda _, _ + + // | NamedFn _, _ -> false + // | DDB a, DDB b -> a = b // exhaustiveness check @@ -107,7 +108,7 @@ let rec equals (a : Dval) (b : Dval) : bool = | DDict _, _ | DRecord _, _ | DEnum _, _ - | DApplicable _, _ + //| DApplicable _, _ // | DDB _, _ -> // type errors; should be caught above by the caller @@ -364,7 +365,7 @@ let fns : List = let (vtA, vtB) = (Dval.toValueType a, Dval.toValueType b) match ValueType.merge vtA vtB with | Error _ -> - raiseRTE vm.callStack (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) + raiseRTE vm.threadID (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) | Ok _ -> equals a b |> DBool |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "=" @@ -383,7 +384,7 @@ let fns : List = let (vtA, vtB) = (Dval.toValueType a, Dval.toValueType b) match ValueType.merge vtA vtB with | Error _ -> - raiseRTE vm.callStack (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) + raiseRTE vm.threadID (RTE.EqualityCheckOnIncompatibleTypes(vtA, vtB)) | Ok _ -> equals a b |> not |> DBool |> Ply | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "<>" diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 62d1cd13b7..fbb505e66d 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -45,33 +45,22 @@ let createState let executeExpr (exeState : RT.ExecutionState) - (inputVars : RT.Symtable) (instrs : RT.Instructions) : Task = task { - let vmState : RT.VMState = - { pc = 0 - instructions = List.toArray instrs.instructions - registers = Array.zeroCreate instrs.registerCount - resultReg = instrs.resultIn - - callStack = RT.CallStack.fromEntryPoint RT.ExecutionPoint.Script // TODO - - symbolTable = inputVars - typeSymbolTable = Map.empty - lambdas = Map.empty } + let vmState = RT.VMState.fromExpr instrs try try - vmState.symbolTable <- - // todo - //Interpreter.withGlobals state inputVars - inputVars + // TODO: handle secrets and DBs by explicit references instead of relying on symbol table + // vmState.symbolTable <- Interpreter.withGlobals state inputVars let! result = Interpreter.eval exeState vmState return Ok result with - | RT.RuntimeErrorException(callStack, rte) -> return Error(callStack, rte) + | RT.RuntimeErrorException(_threadID, rte) -> + // TODO: we need some call stack or something on the RHS + return Error(rte) | ex -> let context : Metadata = //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] @@ -79,7 +68,7 @@ let executeExpr exeState.reportException exeState context ex let id = System.Guid.NewGuid() // TODO: log the error and details or something - return (RTE.UncaughtException id) |> RT.raiseRTE vmState.callStack + return (RTE.UncaughtException id) |> RT.raiseRTE vmState.threadID finally // Does nothing in non-tests diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index cedfaacb40..cf72fea933 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -14,7 +14,7 @@ module VT = ValueType let rec checkAndExtractLetPattern (pat : LetPattern) (dv : Dval) - : bool * List = + : bool * List = let r = checkAndExtractLetPattern let rec rList pats items = @@ -31,7 +31,7 @@ let rec checkAndExtractLetPattern false, [] match pat, dv with - | LPVariable name, dv -> true, [ (name, dv) ] + | LPVariable extractTo, dv -> true, [ (extractTo, dv) ] | LPUnit, DUnit -> true, [] | LPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> match r first firstVal, r second secondVal with @@ -113,48 +113,53 @@ let rec checkAndExtractMatchPattern /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = +let rec private execute (_exeState : ExecutionState) (vm : VMState) : Ply = uply { - let mutable counter = vm.pc // what instruction (by index) we're on + let callFrame = Map.findUnsafe vm.currentFrame vm.callFrames + + let mutable counter = callFrame.pc // what instruction (by index) we're on + let registers = callFrame.registers - let raiseRTE rte = raiseRTE vm.callStack rte + let raiseRTE rte = raiseRTE vm.threadID rte - while counter < vm.instructions.Length do + while counter < callFrame.instructions.Length do - match vm.instructions[counter] with + match callFrame.instructions[counter] with // == Simple register operations == | LoadVal(reg, value) -> - vm.registers[reg] <- value + registers[reg] <- value counter <- counter + 1 | CopyVal(copyTo, copyFrom) -> - vm.registers[copyTo] <- vm.registers[copyFrom] + registers[copyTo] <- registers[copyFrom] counter <- counter + 1 - // == Working with Variables == - | GetVar(loadTo, varName) -> - match Map.find varName vm.symbolTable with - | Some value -> - vm.registers[loadTo] <- value - counter <- counter + 1 - | None -> raiseRTE (RTE.Error.VariableNotFound varName) + // // == Working with Variables == + // | GetVar(loadTo, varName) -> + // match Map.find varName vm.symbolTable with + // | Some value -> + // vm.registers[loadTo] <- value + // counter <- counter + 1 + // | None -> raiseRTE (RTE.Error.VariableNotFound varName) | CheckLetPatternAndExtractVars(valueReg, pat) -> - let dv = vm.registers[valueReg] - let matches, vars = checkAndExtractLetPattern pat dv - - if matches then - vm.symbolTable <- - List.fold - (fun symbolTable (varName, value) -> Map.add varName value symbolTable) - vm.symbolTable - vars + let dv = registers[valueReg] + let doesMatch, registersToAssign = checkAndExtractLetPattern pat dv + + if doesMatch then + registersToAssign + |> List.iter (fun (reg, value) -> registers[reg] <- value) + counter <- counter + 1 else raiseRTE (RTE.Let(RTE.Lets.PatternDoesNotMatch(dv, pat))) + + | VarNotFound varName -> raiseRTE (RTE.VariableNotFound varName) + + // == Working with Basic Types == | CreateString(targetReg, segments) -> let sb = new System.Text.StringBuilder() @@ -164,345 +169,174 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = match seg with | Text s -> sb.Append s |> ignore | Interpolated reg -> - match vm.registers[reg] with + match registers[reg] with | DString s -> sb.Append s |> ignore | _ -> raiseRTE (RTE.String RTE.Strings.Error.InvalidStringAppend)) - vm.registers[targetReg] <- DString(sb.ToString()) + registers[targetReg] <- DString(sb.ToString()) counter <- counter + 1 - // == Flow Control == - // -- Jumps -- - | JumpBy jumpBy -> counter <- counter + jumpBy + 1 - - | JumpByIfFalse(jumpBy, condReg) -> - match vm.registers[condReg] with - | DBool false -> counter <- counter + jumpBy + 1 - | DBool true -> counter <- counter + 1 - | dv -> - let vt = Dval.toValueType dv - raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) - - // -- Match -- - | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> - let matches, vars = checkAndExtractMatchPattern pat vm.registers[valueReg] - - if matches then - vm.symbolTable <- - List.fold - (fun symbolTable (varName, value) -> Map.add varName value symbolTable) - vm.symbolTable - vars - counter <- counter + 1 - else - counter <- counter + failJump + 1 + // // == Flow Control == + // // -- Jumps -- + // | JumpBy jumpBy -> counter <- counter + jumpBy + 1 + + // | JumpByIfFalse(jumpBy, condReg) -> + // match vm.registers[condReg] with + // | DBool false -> counter <- counter + jumpBy + 1 + // | DBool true -> counter <- counter + 1 + // | dv -> + // let vt = Dval.toValueType dv + // raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) + + // // -- Match -- + // | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> + // let matches, vars = checkAndExtractMatchPattern pat vm.registers[valueReg] + + // if matches then + // vm.symbolTable <- + // List.fold + // (fun symbolTable (varName, value) -> Map.add varName value symbolTable) + // vm.symbolTable + // vars + // counter <- counter + 1 + // else + // counter <- counter + failJump + 1 - | MatchUnmatched -> raiseRTE RTE.MatchUnmatched + // | MatchUnmatched -> raiseRTE RTE.MatchUnmatched // == Working with Collections == | CreateList(listReg, itemsToAddRegs) -> // CLEANUP reference registers directly in DvalCreator.list, // so we don't have to copy things - let itemsToAdd = itemsToAddRegs |> List.map (fun r -> vm.registers[r]) - vm.registers[listReg] <- - TypeChecker.DvalCreator.list vm.callStack VT.unknown itemsToAdd + let itemsToAdd = itemsToAddRegs |> List.map (fun r -> registers[r]) + registers[listReg] <- + TypeChecker.DvalCreator.list vm.threadID VT.unknown itemsToAdd counter <- counter + 1 | CreateDict(dictReg, entries) -> // CLEANUP reference registers directly in DvalCreator.dict, // so we don't have to copy things let entries = - entries |> List.map (fun (key, valueReg) -> (key, vm.registers[valueReg])) - vm.registers[dictReg] <- - TypeChecker.DvalCreator.dict vm.callStack VT.unknown entries + entries |> List.map (fun (key, valueReg) -> (key, registers[valueReg])) + registers[dictReg] <- + TypeChecker.DvalCreator.dict vm.threadID VT.unknown entries counter <- counter + 1 | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> - let first = vm.registers[firstReg] - let second = vm.registers[secondReg] - let theRest = theRestRegs |> List.map (fun r -> vm.registers[r]) - vm.registers[tupleReg] <- DTuple(first, second, theRest) + let first = registers[firstReg] + let second = registers[secondReg] + let theRest = theRestRegs |> List.map (fun r -> registers[r]) + registers[tupleReg] <- DTuple(first, second, theRest) counter <- counter + 1 - // == Working with Custom Data == - // -- Records -- - | CreateRecord(recordReg, typeName, typeArgs, fields) -> - let fields = - fields |> List.map (fun (name, valueReg) -> (name, vm.registers[valueReg])) + // // == Working with Custom Data == + // // -- Records -- + // | CreateRecord(recordReg, typeName, typeArgs, fields) -> + // let fields = + // fields |> List.map (fun (name, valueReg) -> (name, vm.registers[valueReg])) - let! record = - TypeChecker.DvalCreator.record - vm.callStack - exeState.types - typeName - typeArgs - fields - - vm.registers[recordReg] <- record - counter <- counter + 1 - - // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> - // let originalRecord = vm.registers[originalRecordReg] - // let updates = - // updates - // |> List.map (fun (fieldName, valueReg) -> - // (fieldName, vm.registers[valueReg])) - // let updatedRecord = + // let! record = // TypeChecker.DvalCreator.record - // exeState.tracing.callStack + // vm.callStack + // exeState.types // typeName // typeArgs - // updates + // fields - // vm.registers[targetReg] <- updatedRecord + // vm.registers[recordReg] <- record // counter <- counter + 1 - | GetRecordField(targetReg, recordReg, fieldName) -> - match vm.registers[recordReg] with - | DRecord(_, _, _, fields) -> - match Map.find fieldName fields with - | Some value -> - vm.registers[targetReg] <- value - counter <- counter + 1 - | None -> - RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE - | dv -> - RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) - |> RTE.Record - |> raiseRTE - - // -- Enums -- - | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> - // TODO: safe dval creation - let fields = fields |> List.map (fun (valueReg) -> vm.registers[valueReg]) - vm.registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) - counter <- counter + 1 + // // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> + // // let originalRecord = vm.registers[originalRecordReg] + // // let updates = + // // updates + // // |> List.map (fun (fieldName, valueReg) -> + // // (fieldName, vm.registers[valueReg])) + // // let updatedRecord = + // // TypeChecker.DvalCreator.record + // // exeState.tracing.callStack + // // typeName + // // typeArgs + // // updates + + // // vm.registers[targetReg] <- updatedRecord + // // counter <- counter + 1 + + // | GetRecordField(targetReg, recordReg, fieldName) -> + // match vm.registers[recordReg] with + // | DRecord(_, _, _, fields) -> + // match Map.find fieldName fields with + // | Some value -> + // vm.registers[targetReg] <- value + // counter <- counter + 1 + // | None -> + // RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE + // | dv -> + // RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) + // |> RTE.Record + // |> raiseRTE + + // // -- Enums -- + // | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> + // // TODO: safe dval creation + // let fields = fields |> List.map (fun (valueReg) -> vm.registers[valueReg]) + // vm.registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) + // counter <- counter + 1 - | CreateLambda(lambdaReg, impl) -> - vm.lambdas <- Map.add impl.exprId impl vm.lambdas - vm.registers[lambdaReg] <- - { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } - |> Applicable.Lambda - |> DApplicable - counter <- counter + 1 + // | CreateLambda(lambdaReg, impl) -> + // vm.lambdas <- Map.add impl.exprId impl vm.lambdas + // vm.registers[lambdaReg] <- + // { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } + // |> Applicable.Lambda + // |> DApplicable + // counter <- counter + 1 - // == Working with things that Apply (fns, lambdas) == - // `add (increment 1L) (3L)` and store results in `putResultIn` - | Apply(putResultIn, thingToCallReg, _typeArgs, argRegs) -> - let thingToCall = vm.registers[thingToCallReg] + // // == Working with things that Apply (fns, lambdas) == + // // `add (increment 1L) (3L)` and store results in `putResultIn` + // | Apply(putResultIn, thingToCallReg, _typeArgs, argRegs) -> + // let thingToCall = vm.registers[thingToCallReg] - let result = - match thingToCall with - | DApplicable applicable -> - match applicable with - | Lambda lambda -> - let impl = Map.findUnsafe lambda.exprId vm.lambdas + // let result = + // match thingToCall with + // | DApplicable applicable -> + // match applicable with + // | Lambda lambda -> + // let impl = Map.findUnsafe lambda.exprId vm.lambdas - // TODO: too many args - if - (NEList.length impl.patterns) = (lambda.argsSoFar.Length - + NEList.length argRegs) - then - DUnit // TODO - else - // TODO - DApplicable applicable + // // TODO: too many args + // if + // (NEList.length impl.patterns) = (lambda.argsSoFar.Length + // + NEList.length argRegs) + // then + // DUnit // TODO + // else + // // TODO + // DApplicable applicable - | NamedFn _namedFn -> - // TODO - DApplicable applicable + // | NamedFn _namedFn -> + // // TODO + // DApplicable applicable - | _ -> - RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) - |> raiseRTE + // | _ -> + // RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) + // |> raiseRTE - vm.registers[putResultIn] <- result + // vm.registers[putResultIn] <- result - counter <- counter + 1 + // counter <- counter + 1 | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) // If we've reached the end of the instructions, return the result - return vm.registers[vm.resultReg] + return callFrame.registers[callFrame.resultReg] } -// and call -// (exeState : ExecutionState) -// (vmState : VMState) -// (thingToCall : Dval) -// (typeArgs : List) -// (args : NEList) -// : Ply = -// uply { -// match thingToCall with -// | DFnVal(NamedFn fnName) -> -// let! fn = -// match fnName with -// | FQFnName.Builtin std -> -// Map.find std exeState.fns.builtIn |> Option.map builtInFnToFn |> Ply - -// | FQFnName.Package pkg -> -// uply { -// let! fn = exeState.fns.package pkg -// return Option.map packageFnToFn fn -// } - -// match fn with -// | Some fn -> -// // let expectedTypeParams = List.length fn.typeParams -// // let expectedArgs = NEList.length fn.parameters - -// // let actualTypeArgs = List.length typeArgs -// // let actualArgs = NEList.length args - -// // if expectedTypeParams <> actualTypeArgs || expectedArgs <> actualArgs then -// // ExecutionError.raise -// // state.tracing.callStack -// // (ExecutionError.WrongNumberOfFnArgs( -// // fnToCall, -// // expectedTypeParams, -// // expectedArgs, -// // actualTypeArgs, -// // actualArgs -// // )) - -// let vmState = -// let boundArgs = -// NEList.map2 -// (fun (p : Param) actual -> (p.name, actual)) -// fn.parameters -// args -// |> NEList.toList -// |> Map -// { vmState with -// symbolTable = Map.mergeFavoringRight vmState.symbolTable boundArgs } - -// let vmState = -// let newlyBoundTypeArgs = List.zip fn.typeParams typeArgs |> Map -// { vmState with -// typeSymbolTable = -// Map.mergeFavoringRight vmState.typeSymbolTable newlyBoundTypeArgs } - -// return! execFn exeState vmState fnName fn typeArgs args - -// | None -> -// // Functions which aren't available in the runtime (for whatever reason) -// // may have results available in traces. (use case: inspecting a cloud-run trace locally) -// let fnResult = -// exeState.tracing.loadFnResult -// (exeState.tracing.callStack.lastCalled, fnName) -// args - -// match fnResult with -// | Some(result, _ts) -> return result -// | None -> -// return -// raiseRTE -// exeState.tracing.callStack -// (RuntimeError.oldError -// $"Function {FQFnName.toString fnName} is not found") - -// | _ -> -// debuG "thingToCall" thingToCall -// return DUnit // TODO -// } - -// and execFn -// (exeState : ExecutionState) -// (vmState : VMState) -// (fnDesc : FQFnName.FQFnName) -// (fn : Fn) -// (typeArgs : List) -// (args : NEList) -// : DvalTask = -// uply { -// let typeArgsResolvedInFn = List.zip fn.typeParams typeArgs |> Map -// let typeSymbolTable = -// Map.mergeFavoringRight vmState.typeSymbolTable typeArgsResolvedInFn - -// match! TypeChecker.checkFunctionCall exeState.types typeSymbolTable fn args with -// | Error rte -> return raiseRTE exeState.tracing.callStack rte -// | Ok() -> -// let! result = -// match fn.fn with -// | BuiltInFunction f -> -// let executionPoint = ExecutionPoint.Function fn.name - -// exeState.tracing.traceExecutionPoint executionPoint - -// let exeState = -// { exeState with tracing.callStack.lastCalled = (executionPoint, None) } - -// uply { -// let! result = -// uply { -// try -// return! f (exeState, vmState, typeArgs, NEList.toList args) -// with e -> -// match e with -// | RuntimeErrorException(None, rte) -> -// // Sometimes it's awkward, in a Builtin fn impl, to pass around the callStack -// // So we catch the exception here and add the callStack to it so it's handy in error-reporting -// return raiseRTE exeState.tracing.callStack rte - -// | RuntimeErrorException _ -> return Exception.reraise e - -// | e -> -// let context : Metadata = -// [ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] -// exeState.reportException exeState context e -// // These are arbitrary errors, and could include sensitive -// // information, so best not to show it to the user. If we'd -// // like to show it to the user, we should catch it where it happens -// // and give them a known safe error via a RuntimeError -// return -// raiseRTE -// exeState.tracing.callStack -// (RuntimeError.oldError "Unknown error") -// } - -// if fn.previewable <> Pure then -// // TODO same thing here -- shouldn't require ourselves to pass in lastCalled - `tracing` should just get access to it underneath -// exeState.tracing.storeFnResult -// (exeState.tracing.callStack.lastCalled, fnDesc) -// args -// result - -// return result -// } - -// | PackageFunction(_id, _instructionsWithContext) -> -// //let _registersNeeded, instructions, resultReg = _instructionsWithContext -// // // maybe this should instead be something like `state.tracing.tracePackageFnCall tlid`? -// // // and the `caller` would be updated by that function? (maybe `caller` is a read-only thing.) -// // let executionPoint = ExecutionPoint.Function(FQFnName.Package id) - -// // state.tracing.traceExecutionPoint executionPoint - -// // // let state = -// // // { state with -// // // tracing.callStack.lastCalled = (executionPoint, Some(Expr.toID body)) } - -// // and how can we pass the args in? -// // maybe fns need some LoadVal instructions frontloaded or something? hmm. -// //eval state instructions resultReg -// Ply DUnit // TODO - -// match! -// TypeChecker.checkFunctionReturnType exeState.types typeSymbolTable fn result -// with -// | Error rte -> return raiseRTE exeState.tracing.callStack rte -// | Ok() -> return result -// } - - - and eval (exeState : ExecutionState) (vmState : VMState) : Ply = execute exeState vmState diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 606a130510..8d1c478201 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -283,22 +283,22 @@ type Expr = | EString of id * List - // -- Flow control -- - /// `if cond then thenExpr else elseExpr` - | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option + // // -- Flow control -- + // /// `if cond then thenExpr else elseExpr` + // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List - /// Supports `match` expressions - /// ```fsharp - /// match x + 2 with // arg - /// | pattern -> expr // cases[0] - /// | pattern -> expr - /// | ... - /// ``` - // cases is a list to represent when a user starts typing but doesn't complete it - | EMatch of id * arg : Expr * cases : List + // /// Supports `match` expressions + // /// ```fsharp + // /// match x + 2 with // arg + // /// | pattern -> expr // cases[0] + // /// | pattern -> expr + // /// | ... + // /// ``` + // // cases is a list to represent when a user starts typing but doesn't complete it + // | EMatch of id * arg : Expr * cases : List // // Composed of binding pattern, the expression to create bindings for, @@ -322,61 +322,61 @@ type Expr = | EDict of id * List | ETuple of id * Expr * Expr * List - // // -- "Applying" args to things, such as fns and lambdas -- - /// This is a function call, the first expression is the value of the function. - /// - `expr (args[0])` - /// - `expr (args[0]) (args[1])` - /// - `expr (args[0])` - | EApply of id * expr : Expr * typeArgs : List * args : NEList +// // // -- "Applying" args to things, such as fns and lambdas -- +// /// This is a function call, the first expression is the value of the function. +// /// - `expr (args[0])` +// /// - `expr (args[0]) (args[1])` +// /// - `expr (args[0])` +// | EApply of id * expr : Expr * typeArgs : List * args : NEList - /// Reference a function name, _usually_ so we can _apply_ it with args - | EFnName of id * NameResolution +// /// Reference a function name, _usually_ so we can _apply_ it with args +// | EFnName of id * NameResolution - // Composed of a parameters * the expression itself - // The id in the varname list is the analysis id, used to get a livevalue - // from the analysis engine - | ELambda of id * pats : NEList * body : Expr +// // Composed of a parameters * the expression itself +// // The id in the varname list is the analysis id, used to get a livevalue +// // from the analysis engine +// | ELambda of id * pats : NEList * body : Expr - // /// Calls upon an infix function - // | EInfix of id * Infix * lhs : Expr * rhs : Expr +// /// Calls upon an infix function +// | EInfix of id * Infix * lhs : Expr * rhs : Expr - // -- References to custom types and data -- +// -- References to custom types and data -- - /// Construct a record - /// `SomeRecord { field1: value; field2: value }` - | ERecord of - id * - // TODO: this reference should be by-hash - typeName : NameResolution * - typeArgs : List * - // User is allowed type `Name {}` even if that's an error - fields : List - - /// Access a field of some record (e.g. `someExpr.fieldName`) - | ERecordFieldAccess of id * record : Expr * fieldName : string - - // /// Clone a record, and update some of its values - // /// `{ r with key = value }` - // | ERecordUpdate of id * record : Expr * updates : NEList - - - // Enums include `Some`, `None`, `Error`, `Ok`, as well - // as user-defined enums. - // - /// Given an Enum type of: - /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` - /// , this is the expression - /// `C (1, "title")` - /// represented as - /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` - | EEnum of - id * - // TODO: this reference should be by-hash - typeName : NameResolution * - typeArgs : List * - caseName : string * - fields : List +// /// Construct a record +// /// `SomeRecord { field1: value; field2: value }` +// | ERecord of +// id * +// // TODO: this reference should be by-hash +// typeName : NameResolution * +// typeArgs : List * +// // User is allowed type `Name {}` even if that's an error +// fields : List + +// /// Access a field of some record (e.g. `someExpr.fieldName`) +// | ERecordFieldAccess of id * record : Expr * fieldName : string + +// /// Clone a record, and update some of its values +// /// `{ r with key = value }` +// | ERecordUpdate of id * record : Expr * updates : NEList + + +// // Enums include `Some`, `None`, `Error`, `Ok`, as well +// // as user-defined enums. +// // +// /// Given an Enum type of: +// /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` +// /// , this is the expression +// /// `C (1, "title")` +// /// represented as +// /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` +// | EEnum of +// id * +// // TODO: this reference should be by-hash +// typeName : NameResolution * +// typeArgs : List * +// caseName : string * +// fields : List // | EConstant of // id * @@ -426,21 +426,22 @@ module Expr = | EFloat(id, _, _, _) // | EConstant(id, _) | ELet(id, _, _, _) - | EIf(id, _, _, _) + // | EIf(id, _, _, _) //| EInfix(id, _, _, _) - | ELambda(id, _, _) - | EFnName(id, _) - | ERecordFieldAccess(id, _, _) + // | ELambda(id, _, _) + // | EFnName(id, _) + // | ERecordFieldAccess(id, _, _) | EVariable(id, _) - | EApply(id, _, _, _) + // | EApply(id, _, _, _) | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) // | EPipe(id, _, _) - | ERecord(id, _, _, _) + // | ERecord(id, _, _, _) // | ERecordUpdate(id, _, _) - | EEnum(id, _, _, _, _) - | EMatch(id, _, _) -> id + // | EEnum(id, _, _, _, _) + // | EMatch(id, _, _) + -> id // module PipeExpr = // let toID (expr : PipeExpr) : id = diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 2ff69614e7..32c05ac9be 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -50,36 +50,36 @@ let rec symbolsUsedIn (expr : Expr) : Set = | ELet(_, _, rhs, next) -> Set.union (r rhs) (r next) - // flow control - | EIf(_, condExpr, ifExpr, elseExprMaybe) -> - match elseExprMaybe with - | None -> Set.union (r condExpr) (r ifExpr) - | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] - - | EMatch(_, target, cases) -> - let targetVars = r target - let whenVars = - cases - |> List.map (fun c -> - match c.whenCondition with - | None -> Set.empty - | Some w -> r w) - |> Set.unionMany - let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany - Set.unionMany [ targetVars; whenVars; rhsVars ] - - - // custom data - | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany - - | ERecord(_, _, _, fields) -> - fields |> List.map (fun (_, e) -> r e) |> Set.unionMany - - | ERecordFieldAccess(_, expr, _) -> r expr - - // things that can be applied - | EFnName(_, _) -> Set.empty - | ELambda(_, _, body) -> r body - | EApply(_, thingToApply, _, args) -> - Set.unionMany - [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] +// // flow control +// | EIf(_, condExpr, ifExpr, elseExprMaybe) -> +// match elseExprMaybe with +// | None -> Set.union (r condExpr) (r ifExpr) +// | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] + +// | EMatch(_, target, cases) -> +// let targetVars = r target +// let whenVars = +// cases +// |> List.map (fun c -> +// match c.whenCondition with +// | None -> Set.empty +// | Some w -> r w) +// |> Set.unionMany +// let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany +// Set.unionMany [ targetVars; whenVars; rhsVars ] + + +// // custom data +// | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany + +// | ERecord(_, _, _, fields) -> +// fields |> List.map (fun (_, e) -> r e) |> Set.unionMany + +// | ERecordFieldAccess(_, expr, _) -> r expr + +// // things that can be applied +// | EFnName(_, _) -> Set.empty +// | ELambda(_, _, body) -> r body +// | EApply(_, thingToApply, _, args) -> +// Set.unionMany +// [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 27bf197265..d5e86d224e 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -140,60 +140,95 @@ module TypeReference = // | PT.ComparisonNotEquals -> ("notEquals", 0) + +// let tpl = (true, (false, "panda")) +// rc = 17 +// let (a, (b, c)) = tpl +(* + [ ..... + .... + 17: true + 18: false + 19: "panda" + ] +*) + + module LetPattern = - let rec toRT (p : PT.LetPattern) : RT.LetPattern = + let rec toRT + (rc : int) + (symbols : Map) + (p : PT.LetPattern) + : (RT.LetPattern * int * Map) = match p with - | PT.LPUnit _ -> RT.LPUnit + | PT.LPUnit _ -> RT.LPUnit, rc, Map.empty | PT.LPTuple(_, first, second, theRest) -> - RT.LPTuple(toRT first, toRT second, List.map toRT theRest) + let first, rc, symbols = toRT rc symbols first + let second, rc, symbols = toRT rc symbols second + let (rc, symbols, theRest) = + theRest + |> List.fold + (fun (rc, symbols, pats) pat -> + let pat, rc, symbols = toRT rc symbols pat + (rc, symbols, pats @ [ pat ])) + (rc, symbols, []) - | PT.LPVariable(_, name) -> RT.LPVariable name + RT.LPTuple(first, second, theRest), rc, symbols + | PT.LPVariable(_, name) -> + // "add a symbol" from name to rc + RT.LPVariable rc, rc + 1, (symbols |> Map.add name rc) - let toInstr (valueReg : RT.Register) (p : PT.LetPattern) : RT.Instruction = - RT.CheckLetPatternAndExtractVars(valueReg, toRT p) + let toInstr + (valueReg : RT.Register) + (rc) + (p : PT.LetPattern) + : (RT.Instruction * int * Map) = + let (pat, rcAfterPat, symbols) = toRT rc Map.empty p + RT.CheckLetPatternAndExtractVars(valueReg, pat), rcAfterPat, symbols -module MatchPattern = - let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = - match p with - | PT.MPUnit _ -> RT.MPUnit - | PT.MPBool(_, b) -> RT.MPBool b +// module MatchPattern = +// let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = +// match p with +// | PT.MPUnit _ -> RT.MPUnit - | PT.MPInt8(_, i) -> RT.MPInt8 i - | PT.MPUInt8(_, i) -> RT.MPUInt8 i - | PT.MPInt16(_, i) -> RT.MPInt16 i - | PT.MPUInt16(_, i) -> RT.MPUInt16 i - | PT.MPInt32(_, i) -> RT.MPInt32 i - | PT.MPUInt32(_, i) -> RT.MPUInt32 i - | PT.MPInt64(_, i) -> RT.MPInt64 i - | PT.MPUInt64(_, i) -> RT.MPUInt64 i - | PT.MPInt128(_, i) -> RT.MPInt128 i - | PT.MPUInt128(_, i) -> RT.MPUInt128 i +// | PT.MPBool(_, b) -> RT.MPBool b - | PT.MPFloat(_, sign, whole, frac) -> RT.MPFloat(makeFloat sign whole frac) +// | PT.MPInt8(_, i) -> RT.MPInt8 i +// | PT.MPUInt8(_, i) -> RT.MPUInt8 i +// | PT.MPInt16(_, i) -> RT.MPInt16 i +// | PT.MPUInt16(_, i) -> RT.MPUInt16 i +// | PT.MPInt32(_, i) -> RT.MPInt32 i +// | PT.MPUInt32(_, i) -> RT.MPUInt32 i +// | PT.MPInt64(_, i) -> RT.MPInt64 i +// | PT.MPUInt64(_, i) -> RT.MPUInt64 i +// | PT.MPInt128(_, i) -> RT.MPInt128 i +// | PT.MPUInt128(_, i) -> RT.MPUInt128 i - | PT.MPChar(_, c) -> RT.MPChar c - | PT.MPString(_, s) -> RT.MPString s +// | PT.MPFloat(_, sign, whole, frac) -> RT.MPFloat(makeFloat sign whole frac) - | PT.MPList(_, pats) -> RT.MPList(List.map toRT pats) - | PT.MPListCons(_, head, tail) -> RT.MPListCons(toRT head, toRT tail) +// | PT.MPChar(_, c) -> RT.MPChar c +// | PT.MPString(_, s) -> RT.MPString s - | PT.MPTuple(_, first, second, theRest) -> - RT.MPTuple(toRT first, toRT second, List.map toRT theRest) +// | PT.MPList(_, pats) -> RT.MPList(List.map toRT pats) +// | PT.MPListCons(_, head, tail) -> RT.MPListCons(toRT head, toRT tail) - | PT.MPVariable(_, name) -> RT.MPVariable name +// | PT.MPTuple(_, first, second, theRest) -> +// RT.MPTuple(toRT first, toRT second, List.map toRT theRest) +// | PT.MPVariable(_, name) -> RT.MPVariable name - let toMatchInstr - (valueReg : RT.Register) - (p : PT.MatchPattern) - (jumpByFail : int) - : RT.Instruction = - RT.CheckMatchPatternAndExtractVars(valueReg, toRT p, jumpByFail) + +// let toMatchInstr +// (valueReg : RT.Register) +// (p : PT.MatchPattern) +// (jumpByFail : int) +// : RT.Instruction = +// RT.CheckMatchPatternAndExtractVars(valueReg, toRT p, jumpByFail) module MatchCase = @@ -236,7 +271,11 @@ module MatchCase = module Expr = - let rec toRT (rc : int) (e : PT.Expr) : RT.Instructions = + let rec toRT + (symbols : Map) + (rc : int) + (e : PT.Expr) + : RT.Instructions = let justLoadDval dv : RT.Instructions = { registerCount = rc + 1 instructions = [ RT.LoadVal(rc, dv) ] @@ -281,7 +320,7 @@ module Expr = (rc, instrs, segments @ [ RT.StringSegment.Text text ]) | PT.StringInterpolation expr -> - let exprInstrs = toRT rc expr + let exprInstrs = toRT symbols rc expr (exprInstrs.registerCount, instrs @ exprInstrs.instructions, @@ -302,7 +341,7 @@ module Expr = items |> List.fold (fun (rc, instrs, itemResultRegs) item -> - let itemInstrs = toRT rc item + let itemInstrs = toRT symbols rc item (itemInstrs.registerCount, instrs @ itemInstrs.instructions, itemResultRegs @ [ itemInstrs.resultIn ])) @@ -321,7 +360,7 @@ module Expr = items |> List.fold (fun (rc, instrs, entryPairs) (key, value) -> - let itemInstrs = toRT rc value + let itemInstrs = toRT symbols rc value (itemInstrs.registerCount, instrs @ itemInstrs.instructions, entryPairs @ [ (key, itemInstrs.resultIn) ])) @@ -336,13 +375,13 @@ module Expr = // save the 'first' register for the result let tupleReg, rc = rc, rc + 1 - let first = toRT rc first - let second = toRT first.registerCount second + let first = toRT symbols rc first + let second = toRT symbols first.registerCount second let (rcAfterAll, _rcsAfterTheRest, theRestInstrs, theRestRegs) = theRest |> List.fold (fun (rc, rcs, instrs, resultRegs) item -> - let itemInstrs = toRT rc item + let itemInstrs = toRT symbols rc item (itemInstrs.registerCount, rcs @ [ itemInstrs.registerCount ], instrs @ itemInstrs.instructions, @@ -360,9 +399,11 @@ module Expr = // let x = 1 | PT.ELet(_id, pat, expr, body) -> - let exprInstrs = toRT rc expr - let patInstr = LetPattern.toInstr exprInstrs.resultIn pat - let bodyInstrs = toRT exprInstrs.registerCount body + let exprInstrs = toRT symbols rc expr + let patInstr, rcAfterPat, newSymbols = + LetPattern.toInstr exprInstrs.resultIn exprInstrs.registerCount pat + let symbols = Map.mergeFavoringRight symbols newSymbols + let bodyInstrs = toRT symbols rcAfterPat body { registerCount = bodyInstrs.registerCount instructions = exprInstrs.instructions @ [ patInstr ] @ bodyInstrs.instructions @@ -370,338 +411,344 @@ module Expr = | PT.EVariable(_id, varName) -> - { registerCount = rc + 1 - instructions = [ RT.GetVar(rc, varName) ] - resultIn = rc } - - - | PT.EIf(_id, cond, thenExpr, elseExpr) -> - // We need a consistent result register, - // so we'll create this, and copy to it at the end of each branch - let resultReg, rc = rc, rc + 1 - - let cond = toRT rc cond - let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, cond.resultIn) ] - - let thenInstrs = toRT cond.registerCount thenExpr - let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenInstrs.resultIn) ] - - match elseExpr with + // todo handle missing var + match Map.find varName symbols with + | Some reg -> { registerCount = rc; instructions = []; resultIn = reg } | None -> - let instrs = - [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit - @ cond.instructions - @ jumpIfCondFalse ( - // goto the first instruction past the `if` - // (the 1 is for the copy instruction) - List.length thenInstrs.instructions + 1 - ) - @ thenInstrs.instructions - @ copyThenToResultInstr - - { registerCount = thenInstrs.registerCount - instructions = instrs - resultIn = resultReg } - - | Some elseExpr -> - let elseInstrs = toRT thenInstrs.registerCount elseExpr - let copyToResultInstr = [ RT.CopyVal(resultReg, elseInstrs.resultIn) ] - - let instrs = - // cond -- if cond `false`, jump to start of 'else' block - cond.instructions - @ jumpIfCondFalse ( - // goto the first instruction past the `if` - // (first 1 is for the copy instruction) - // (second 1 is for the jump instruction) - List.length thenInstrs.instructions + 1 + 1 - ) - - // then - @ thenInstrs.instructions - @ copyThenToResultInstr - @ [ RT.JumpBy(List.length elseInstrs.instructions + 1) ] - - // else - @ elseInstrs.instructions - @ copyToResultInstr - - { registerCount = elseInstrs.registerCount - instructions = instrs - resultIn = resultReg } - - - | PT.EFnName(_, Ok name) -> - let namedFn : RT.ApplicableNamedFn = - { name = FQFnName.toRT name; argsSoFar = [] } - let applicable = RT.DApplicable(RT.NamedFn namedFn) - { registerCount = rc + 1 - instructions = [ RT.LoadVal(rc, applicable) ] - resultIn = rc } - - | PT.EFnName(_, Error nre) -> - // TODO improve - // hmm maybe we shouldn't fail yet here. - // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. - // maybe the 'value' here is (still) some unresolved name? - // (which should fail when we apply it) - { registerCount = rc - instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] - resultIn = rc } - - - | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> - let thingToApply = toRT rc thingToApplyExpr - // TODO: maybe one or both of these lists should be an `NEList`? - - // CLEANUP find a way to get rid of silly NEList stuff - let (regCounter, argInstrs, argRegs) = - let init = (thingToApply.registerCount, [], []) - - args - |> NEList.fold - (fun (rc, instrs, argResultRegs) arg -> - let newInstrs = toRT rc arg - (newInstrs.registerCount, - instrs @ newInstrs.instructions, - argResultRegs @ [ newInstrs.resultIn ])) - init - - let putResultIn = regCounter - let callInstr = - RT.Apply( - putResultIn, - thingToApply.resultIn, - List.map TypeReference.toRT typeArgs, - NEList.ofListUnsafe "" [] argRegs - ) - - { registerCount = regCounter + 1 - instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] - resultIn = putResultIn } - - - | PT.EMatch(_id, expr, cases) -> - // first, the easy part - compile the expression we're `match`ing against. - let expr = toRT rc expr - - // Shortly, we'll compile each of the cases. - // We'll use this `resultReg` to store the final result of the match - // , so we have a consistent place to look for it. - // (similar to how we handle `EIf` -- refer to that for a simpler example) - let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 - - // We compile each `case` in two phases, because some instrs require knowing - // how many instrs to jump over, which we can't know until we know the basics - // of all the cases. - // - // See `MatchCase.IntermediateValue` for more info. - let casesAfterFirstPhase : List = - cases - |> List.map (fun c -> - // compile the `when` condition, if it exists, as much as we can - let rcAfterWhenCond, whenCondInstrs, whenCondJump = - match c.whenCondition with - | None -> (rcAfterResult, [], None) - | Some whenCond -> - let whenCond = toRT rcAfterResult whenCond - (whenCond.registerCount, - whenCond.instructions, - Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) - - // compile the `rhs` of the case - let rhs = toRT rcAfterWhenCond c.rhs - - // return the intermediate results, as far along as they are - { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat - whenCondInstructions = whenCondInstrs - whenCondJump = whenCondJump - rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] - rc = rhs.registerCount }) - - let countInstrsForCase (c : MatchCase.IntermediateValue) : int = - 1 // for the `MatchValue` instruction - + List.length c.whenCondInstructions - + (match c.whenCondJump with - | Some _ -> 1 - | None -> 0) - + List.length c.rhsInstrs - + 1 // for the `JumpBy` instruction - - let (cases, _) : List * int = - casesAfterFirstPhase - |> List.map (fun c -> - let instrCount = countInstrsForCase c - (c, instrCount)) - |> List.foldRight - // CLEANUP this works, but hurts the brain a bit. - (fun (acc, runningTotal) (c, instrCount) -> - let newTotal = runningTotal + instrCount - (acc @ [ c, runningTotal ], newTotal)) - ([], 0) - let cases = List.rev cases - - let caseInstrs = - cases - |> List.fold - (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> - // note: `instrsAfterThisCaseUntilEndOfMatch` does not include - // the final MatchUnmatched instruction - - let caseInstrs = - [ c.matchValueInstrFn ( - countInstrsForCase c - // because we can skip over the MatchValue instr - - 1 - ) ] - @ c.whenCondInstructions - @ (match c.whenCondJump with - // jump to next case if the when condition is false - | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] - | None -> []) - @ c.rhsInstrs - @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] - - instrs @ caseInstrs) - [] - - let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] - - let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max - - { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } - - - // -- Records -- - | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> - let returnReg = 0 // TODO - not sure what to do here - { registerCount = rc - instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] - resultIn = returnReg } - - | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> - // fields : List - let recordReg, rc = rc, rc + 1 - - // CLEANUP: complain if there are no fields -- or maybe that should happen during interpretation? - // - actually- is there anything _wrong_ with a fieldless record? - let (rcAfterFields, instrs, fields) = - fields - |> List.fold - (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> - let field = toRT rc fieldExpr - (field.registerCount, - instrs @ field.instructions, - fieldRegs @ [ (fieldName, field.resultIn) ])) - (rc, [], []) - - - - // (rcAfterFields, - // instrs - // @ [ RT.CreateRecord( - // recordReg, - // FQTypeName.toRT typeName, - // List.map TypeReference.toRT typeArgs, - // fields - // ) ], - // recordReg) - - { registerCount = rcAfterFields - instructions = - instrs - @ [ RT.CreateRecord( - recordReg, - FQTypeName.toRT typeName, - List.map TypeReference.toRT typeArgs, - fields - ) ] - resultIn = recordReg } - - // | PT.ERecordUpdate(_id, expr, updates) -> - // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = - // toRT rc expr - - // let (rcAfterUpdates, updatesInstrs, updates) = - // updates - // |> NEList.fold - // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> - // let (newRc, newInstrs, newReg) = toRT rc fieldExpr - // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) - // (rcAfterOriginalRecord, [], []) - - // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 - // let instrs = - // originalRecordInstrs - // @ updatesInstrs - // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] - - // (rc, instrs, targetReg) - - | PT.ERecordFieldAccess(_id, expr, fieldName) -> - let expr = toRT rc expr - - { registerCount = expr.registerCount + 1 - instructions = - expr.instructions - @ [ RT.GetRecordField(expr.registerCount, expr.resultIn, fieldName) ] - resultIn = expr.registerCount } - - - // -- Enums -- - | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> - let returnReg = 0 // TODO - not sure what to do here - { registerCount = rc - instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] - resultIn = returnReg } - - | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> - // fields : List - let enumReg, rc = rc, rc + 1 - - let (rcAfterFields, instrs, fields) = - fields - |> List.fold - (fun (rc, instrs, fieldRegs) fieldExpr -> - let afterField = toRT rc fieldExpr - (afterField.registerCount, - instrs @ afterField.instructions, - fieldRegs @ [ afterField.resultIn ])) - (rc, [], []) - - { registerCount = rcAfterFields - instructions = - instrs - @ [ RT.CreateEnum( - enumReg, - FQTypeName.toRT typeName, - List.map TypeReference.toRT typeArgs, - caseName, - fields - ) ] - resultIn = enumReg } - - - | PT.ELambda(id, pats, body) -> - let symbolsToClose = - // exclude symbols that are defined/overridden in the lambda's parameters/pats - let usedInBody = ProgramTypesAst.symbolsUsedIn body - let usedInPats = - pats - |> NEList.toList - |> List.map PT.LetPattern.symbolsUsed - |> Set.unionMany - Set.difference usedInBody usedInPats - - let impl : RT.LambdaImpl = - { exprId = id - patterns = NEList.map LetPattern.toRT pats - symbolsToClose = symbolsToClose - instructions = toRT 0 body } - - { registerCount = rc + 1 - instructions = [ RT.CreateLambda(rc, impl) ] - resultIn = rc } + { registerCount = rc + instructions = [ RT.VarNotFound varName ] + resultIn = + // TODO: this is a hack + rc } + + +// | PT.EIf(_id, cond, thenExpr, elseExpr) -> +// // We need a consistent result register, +// // so we'll create this, and copy to it at the end of each branch +// let resultReg, rc = rc, rc + 1 + +// let cond = toRT rc cond +// let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, cond.resultIn) ] + +// let thenInstrs = toRT cond.registerCount thenExpr +// let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenInstrs.resultIn) ] + +// match elseExpr with +// | None -> +// let instrs = +// [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit +// @ cond.instructions +// @ jumpIfCondFalse ( +// // goto the first instruction past the `if` +// // (the 1 is for the copy instruction) +// List.length thenInstrs.instructions + 1 +// ) +// @ thenInstrs.instructions +// @ copyThenToResultInstr + +// { registerCount = thenInstrs.registerCount +// instructions = instrs +// resultIn = resultReg } + +// | Some elseExpr -> +// let elseInstrs = toRT thenInstrs.registerCount elseExpr +// let copyToResultInstr = [ RT.CopyVal(resultReg, elseInstrs.resultIn) ] + +// let instrs = +// // cond -- if cond `false`, jump to start of 'else' block +// cond.instructions +// @ jumpIfCondFalse ( +// // goto the first instruction past the `if` +// // (first 1 is for the copy instruction) +// // (second 1 is for the jump instruction) +// List.length thenInstrs.instructions + 1 + 1 +// ) + +// // then +// @ thenInstrs.instructions +// @ copyThenToResultInstr +// @ [ RT.JumpBy(List.length elseInstrs.instructions + 1) ] + +// // else +// @ elseInstrs.instructions +// @ copyToResultInstr + +// { registerCount = elseInstrs.registerCount +// instructions = instrs +// resultIn = resultReg } + + +// | PT.EFnName(_, Ok name) -> +// let namedFn : RT.ApplicableNamedFn = +// { name = FQFnName.toRT name; argsSoFar = [] } +// let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) +// { registerCount = rc + 1 +// instructions = [ RT.LoadVal(rc, applicable) ] +// resultIn = rc } + +// | PT.EFnName(_, Error nre) -> +// // TODO improve +// // hmm maybe we shouldn't fail yet here. +// // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. +// // maybe the 'value' here is (still) some unresolved name? +// // (which should fail when we apply it) +// { registerCount = rc +// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] +// resultIn = rc } + + +// | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> +// let thingToApply = toRT rc thingToApplyExpr +// // TODO: maybe one or both of these lists should be an `NEList`? + +// // CLEANUP find a way to get rid of silly NEList stuff +// let (regCounter, argInstrs, argRegs) = +// let init = (thingToApply.registerCount, [], []) + +// args +// |> NEList.fold +// (fun (rc, instrs, argResultRegs) arg -> +// let newInstrs = toRT rc arg +// (newInstrs.registerCount, +// instrs @ newInstrs.instructions, +// argResultRegs @ [ newInstrs.resultIn ])) +// init + +// let putResultIn = regCounter +// let callInstr = +// RT.Apply( +// putResultIn, +// thingToApply.resultIn, +// List.map TypeReference.toRT typeArgs, +// NEList.ofListUnsafe "" [] argRegs +// ) + +// { registerCount = regCounter + 1 +// instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] +// resultIn = putResultIn } + + +// | PT.EMatch(_id, expr, cases) -> +// // first, the easy part - compile the expression we're `match`ing against. +// let expr = toRT rc expr + +// // Shortly, we'll compile each of the cases. +// // We'll use this `resultReg` to store the final result of the match +// // , so we have a consistent place to look for it. +// // (similar to how we handle `EIf` -- refer to that for a simpler example) +// let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 + +// // We compile each `case` in two phases, because some instrs require knowing +// // how many instrs to jump over, which we can't know until we know the basics +// // of all the cases. +// // +// // See `MatchCase.IntermediateValue` for more info. +// let casesAfterFirstPhase : List = +// cases +// |> List.map (fun c -> +// // compile the `when` condition, if it exists, as much as we can +// let rcAfterWhenCond, whenCondInstrs, whenCondJump = +// match c.whenCondition with +// | None -> (rcAfterResult, [], None) +// | Some whenCond -> +// let whenCond = toRT rcAfterResult whenCond +// (whenCond.registerCount, +// whenCond.instructions, +// Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) + +// // compile the `rhs` of the case +// let rhs = toRT rcAfterWhenCond c.rhs + +// // return the intermediate results, as far along as they are +// { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat +// whenCondInstructions = whenCondInstrs +// whenCondJump = whenCondJump +// rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] +// rc = rhs.registerCount }) + +// let countInstrsForCase (c : MatchCase.IntermediateValue) : int = +// 1 // for the `MatchValue` instruction +// + List.length c.whenCondInstructions +// + (match c.whenCondJump with +// | Some _ -> 1 +// | None -> 0) +// + List.length c.rhsInstrs +// + 1 // for the `JumpBy` instruction + +// let (cases, _) : List * int = +// casesAfterFirstPhase +// |> List.map (fun c -> +// let instrCount = countInstrsForCase c +// (c, instrCount)) +// |> List.foldRight +// // CLEANUP this works, but hurts the brain a bit. +// (fun (acc, runningTotal) (c, instrCount) -> +// let newTotal = runningTotal + instrCount +// (acc @ [ c, runningTotal ], newTotal)) +// ([], 0) +// let cases = List.rev cases + +// let caseInstrs = +// cases +// |> List.fold +// (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> +// // note: `instrsAfterThisCaseUntilEndOfMatch` does not include +// // the final MatchUnmatched instruction + +// let caseInstrs = +// [ c.matchValueInstrFn ( +// countInstrsForCase c +// // because we can skip over the MatchValue instr +// - 1 +// ) ] +// @ c.whenCondInstructions +// @ (match c.whenCondJump with +// // jump to next case if the when condition is false +// | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] +// | None -> []) +// @ c.rhsInstrs +// @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] + +// instrs @ caseInstrs) +// [] + +// let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] + +// let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max + +// { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } + + +// // -- Records -- +// | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> +// let returnReg = 0 // TODO - not sure what to do here +// { registerCount = rc +// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] +// resultIn = returnReg } + +// | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> +// // fields : List +// let recordReg, rc = rc, rc + 1 + +// // CLEANUP: complain if there are no fields -- or maybe that should happen during interpretation? +// // - actually- is there anything _wrong_ with a fieldless record? +// let (rcAfterFields, instrs, fields) = +// fields +// |> List.fold +// (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> +// let field = toRT rc fieldExpr +// (field.registerCount, +// instrs @ field.instructions, +// fieldRegs @ [ (fieldName, field.resultIn) ])) +// (rc, [], []) + + + +// // (rcAfterFields, +// // instrs +// // @ [ RT.CreateRecord( +// // recordReg, +// // FQTypeName.toRT typeName, +// // List.map TypeReference.toRT typeArgs, +// // fields +// // ) ], +// // recordReg) + +// { registerCount = rcAfterFields +// instructions = +// instrs +// @ [ RT.CreateRecord( +// recordReg, +// FQTypeName.toRT typeName, +// List.map TypeReference.toRT typeArgs, +// fields +// ) ] +// resultIn = recordReg } + +// // | PT.ERecordUpdate(_id, expr, updates) -> +// // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = +// // toRT rc expr + +// // let (rcAfterUpdates, updatesInstrs, updates) = +// // updates +// // |> NEList.fold +// // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> +// // let (newRc, newInstrs, newReg) = toRT rc fieldExpr +// // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) +// // (rcAfterOriginalRecord, [], []) + +// // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 +// // let instrs = +// // originalRecordInstrs +// // @ updatesInstrs +// // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] + +// // (rc, instrs, targetReg) + +// | PT.ERecordFieldAccess(_id, expr, fieldName) -> +// let expr = toRT rc expr + +// { registerCount = expr.registerCount + 1 +// instructions = +// expr.instructions +// @ [ RT.GetRecordField(expr.registerCount, expr.resultIn, fieldName) ] +// resultIn = expr.registerCount } + + +// // -- Enums -- +// | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> +// let returnReg = 0 // TODO - not sure what to do here +// { registerCount = rc +// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] +// resultIn = returnReg } + +// | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> +// // fields : List +// let enumReg, rc = rc, rc + 1 + +// let (rcAfterFields, instrs, fields) = +// fields +// |> List.fold +// (fun (rc, instrs, fieldRegs) fieldExpr -> +// let afterField = toRT rc fieldExpr +// (afterField.registerCount, +// instrs @ afterField.instructions, +// fieldRegs @ [ afterField.resultIn ])) +// (rc, [], []) + +// { registerCount = rcAfterFields +// instructions = +// instrs +// @ [ RT.CreateEnum( +// enumReg, +// FQTypeName.toRT typeName, +// List.map TypeReference.toRT typeArgs, +// caseName, +// fields +// ) ] +// resultIn = enumReg } + + +// | PT.ELambda(id, pats, body) -> +// let symbolsToClose = +// // exclude symbols that are defined/overridden in the lambda's parameters/pats +// let usedInBody = ProgramTypesAst.symbolsUsedIn body +// let usedInPats = +// pats +// |> NEList.toList +// |> List.map PT.LetPattern.symbolsUsed +// |> Set.unionMany +// Set.difference usedInBody usedInPats + +// let impl : RT.LambdaImpl = +// { exprId = id +// patterns = NEList.map LetPattern.toRT pats +// symbolsToClose = symbolsToClose +// instructions = toRT 0 body } + +// { registerCount = rc + 1 +// instructions = [ RT.CreateLambda(rc, impl) ] +// resultIn = rc } @@ -792,10 +839,14 @@ module PackageFn = let toRT (f : PT.PackageFn.PackageFn) : RT.PackageFn.PackageFn = { id = f.id body = - let initialRegCounter = - // TODO: OK? depends if we try to 'inline' package fns or not... - 0 - Expr.toRT initialRegCounter f.body + let (rcAfterParams, symbols) : (int * Map) = + f.parameters + |> NEList.toList + |> List.fold + (fun (rc, symbols) p -> (rc + 1, Map.add p.name rc symbols)) + (0, Map.empty) + + Expr.toRT symbols rcAfterParams f.body typeParams = f.typeParams parameters = f.parameters |> NEList.map Parameter.toRT returnType = f.returnType |> TypeReference.toRT } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index fcda2c75c3..45b4e9d810 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -182,21 +182,6 @@ and [] ValueType = | Known of KnownType -/// The LHS pattern in -/// - a `let` binding (in `let x = 1`, the `x`) -/// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` -type LetPattern = - /// `let x = 1` - | LPVariable of name : string - - // /// `let _ = 1` - // | LPIgnored - - /// `let (x, y) = (1, 2)` - | LPTuple of first : LetPattern * second : LetPattern * theRest : List - - /// `let () = ()` - | LPUnit type TypeReference = @@ -277,6 +262,32 @@ type TypeReference = type TypeSymbolTable = Map + +// ------------ +// Instructions ("bytecode") +// ------------ +[] +type register + +type Register = int // // TODO: unit of measure + +/// The LHS pattern in +/// - a `let` binding (in `let x = 1`, the `x`) +/// - a lambda (in `fn (x, y) -> x + y`, the `(x, y)` +type LetPattern = + /// `let x = 1` + | LPVariable of extractTo : Register + + // /// `let _ = 1` + // | LPIgnored + + /// `let (x, y) = (1, 2)` + | LPTuple of first : LetPattern * second : LetPattern * theRest : List + + /// `let () = ()` + | LPUnit + + type MatchPattern = | MPUnit | MPBool of bool @@ -302,15 +313,6 @@ type MatchPattern = | MPVariable of string -// ------------ -// Instructions ("bytecode") -// ------------ - -[] -type register - -type Register = int // // TODO: unit of measure - type StringSegment = | Text of string | Interpolated of Register @@ -338,37 +340,37 @@ type Instruction = /// Errors if the pattern doesn't match the value. | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern - /// Stores the value of a variable to a register - | GetVar of loadTo : Register * varName : string + // /// Stores the value of a variable to a register + // | GetVar of loadTo : Register * varName : string // == Working with Basic Types == - | CreateString of targetReg : Register * segments : List + | CreateString of createTo : Register * segments : List - // == Flow Control == + // // == Flow Control == - // -- Jumps -- - /// Go `n` instructions forward, if the value in the register is `false` - | JumpByIfFalse of instrsToJump : int * conditionReg : Register + // // -- Jumps -- + // /// Go `n` instructions forward, if the value in the register is `false` + // | JumpByIfFalse of instrsToJump : int * conditionReg : Register - /// Go `n` instructions forward, unconditionally - | JumpBy of instrsToJump : int + // /// Go `n` instructions forward, unconditionally + // | JumpBy of instrsToJump : int - // -- Match -- - /// Check if the value in the noted register the noted pattern, - /// and extract vars per MPVariable as relevant. - | CheckMatchPatternAndExtractVars of - // what we're matching against - valueReg : Register * - pat : MatchPattern * - // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) - failJump : int + // // -- Match -- + // /// Check if the value in the noted register the noted pattern, + // /// and extract vars per MPVariable as relevant. + // | CheckMatchPatternAndExtractVars of + // // what we're matching against + // valueReg : Register * + // pat : MatchPattern * + // // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) + // failJump : int - /// Could not find matching case in a match expression - /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs - /// TODO maybe make this a special case of Fail - | MatchUnmatched + // /// Could not find matching case in a match expression + // /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs + // /// TODO maybe make this a special case of Fail + // | MatchUnmatched // == Working with Collections == @@ -379,56 +381,60 @@ type Instruction = theRest : List /// Create a list, and type-check to ensure the items are of a consistent type - | CreateList of listRegister : Register * itemsToAdd : List + | CreateList of createTo : Register * itemsToAdd : List /// Create a dict, and type-check to ensure the entries are of a consistent type - | CreateDict of dictRegister : Register * entries : List + | CreateDict of createTo : Register * entries : List - // == Working with Custom Data == - // -- Records -- - | CreateRecord of - recordReg : Register * - typeName : FQTypeName.FQTypeName * - typeArgs : List * - fields : List + // // == Working with Custom Data == + // // -- Records -- + // | CreateRecord of + // createTo : Register * + // typeName : FQTypeName.FQTypeName * + // typeArgs : List * + // fields : List - // | CloneRecordWithUpdates of + // // | CloneRecordWithUpdates of + // // createTo : Register * + // // originalRecordReg : Register * + // // updates : List + + // | GetRecordField of + // // todo: rename to "lhs"? Look into this. // targetReg : Register * - // originalRecordReg : Register * - // updates : List - - | GetRecordField of - targetReg : Register * - recordReg : Register * - fieldName : string - - // -- Enums -- - | CreateEnum of - enumReg : Register * - typeName : FQTypeName.FQTypeName * - typeArgs : List * - caseName : string * - fields : List + // recordReg : Register * + // fieldName : string + + // // -- Enums -- + // | CreateEnum of + // createTo : Register * + // typeName : FQTypeName.FQTypeName * + // typeArgs : List * + // caseName : string * + // fields : List - // == Working with things that Apply == + // // == Working with things that Apply == - | CreateLambda of createTo : Register * lambda : LambdaImpl + // | CreateLambda of createTo : Register * lambda : LambdaImpl - /// Apply some args (and maybe type args) to something - /// (a named function, or lambda, etc) - | Apply of - putResultIn : Register * - thingToApply : Register * - //symbolsToClose : List * // any symbols referenced in the thingToApply that should be closed - //typeSymbolsToClose : List * - typeArgs : List * - args : NEList + // /// Apply some args (and maybe type args) to something + // /// (a named function, or lambda, etc) + // | Apply of + // createTo : Register * + // thingToApply : Register * + // //symbolsToClose : List * // any symbols referenced in the thingToApply that should be closed + // //typeSymbolsToClose : List * + // typeArgs : List * + // args : NEList // == Errors == | RaiseNRE of NameResolutionError + | VarNotFound of name : string + + /// (rc, instructions, result register) and Instructions = { @@ -442,6 +448,26 @@ and Instructions = resultIn : Register } +// and InstructionsWithDebugSymbols = +// { +// /// How many registers are used in evaluating these instructions +// registerCount : int + +// /// The instructions themselves -- but with source expr ID +// instructions : List + +// /// The register that will hold the result of the instructions +// resultIn : Register +// } + +// static member withoutDebugSymbols +// (self : InstructionsWithDebugSymbols) +// : Instructions = +// { registerCount = self.registerCount +// instructions = self.instructions |> List.map fst +// resultIn = self.resultIn } +// and later, the expr sources are extracted out + and DvalMap = Map @@ -477,54 +503,68 @@ and LambdaImpl = /// in a way that doesn't require us to go deeper in some call stack? and ApplicableNamedFn = { name : FQFnName.FQFnName; argsSoFar : List } +// if we're just evaluating a "raw expr," I suppose that's InputClosure? +// eval probably handles whichever of these, +// with a fn above that to coordinate things? and ApplicableLambda = { /// The lambda's ID, corresponding to the PT.Expr /// (the actual implementation is stored in the VMState) exprId : id - // TODO maybe we need a returnRegister or something - // or maybe that's handled by the apply + // we need registers here, right? - /// The symtable at the time of creation - /// (only copy what's noted in `symbolsToClose`) - symtable : Symtable + + // /// The symtable at the time of creation (only copy what's noted in `symbolsToClose`) + // /// , along with anything created throughout processing so far + // symtable : Symtable // TODO: typeSymbolTable : TypeSymbolTable argsSoFar : List } -// member this.withAdditionalArgs (args : Dval) : ApplicableLambda = -// // ah but these should be type-checked as we add them. move this to TypeChecker instead. -// { this with argsSoFar = this.argsSoFar @ args } -/// Any thing that can be applied, -/// along with anything needed within their application closure -/// TODO: follow up with typeSymbols -/// TODO needs a better name, clearly. -and Applicable = - /// The details are in the LambdaImpl - /// , stored in the VMState after being loaded by a LoadLambda instruction - | Lambda of ApplicableLambda +// // Is this a _kind_ of closure? I think so! +// // So do we need +// // +// and CallFrameReference = +// | InputExpr +// | TopLevel of tlid +// | NamedFn of FQFnName.FQFnName +// | Lambda of id + +// /// TODO VMState holds a Map of these? and we fetch by ID? +// /// specifically `Map`? idk. +// /// +// /// Any of these things can be applied, and _somewhere_ have a set of instructions to evaluate +// and CallFrame = +// /// for raw exprs, e.g. tests, one-off scripts, etc +// /// +// /// Thinking... +// /// I think this one actually needs its Instructions -- and maybe registers and such? +// /// This might be where more of VMState gets moved to. +// | InputExpr of parent : Option * Instructions + +// /// TODO probably good to 'migrate' some usages from "raw" expr evaluation to these. +// | TopLevel of parent : Option * tlid - | NamedFn of ApplicableNamedFn +// | NamedFn of parent : Option * ApplicableNamedFn +// /// Note: the impl details are stored "centrally" in the VMState +// /// in a LambdaImpl object, after being loaded by a LoadLambda instruction +// | Lambda of parent : CallFrameReference * ApplicableLambda -(* -let someOtherData = true -let partiallyApplied = List.map (fun url -> (url, someOtherData, String.length url)) -let someOtherData = false -let urls = ["https://stachu.net"; "https://darklang.com"] -let urlsAndLengths = partiallyApplied urls -*) -(* -fn myAdd (x: Int) (y: Int): Int = - x + y +// /// Any thing that can be applied, +// /// along with anything needed within their application closure +// /// TODO: follow up with typeSymbols +// /// TODO needs a better name, clearly. +// and Applicable = +// | Lambda of ApplicableLambda + +// | NamedFn of ApplicableNamedFn + -let increment = myAdd (3 - 2) -let result = increment 5 -*) // We use NoComparison here to avoid accidentally using structural comparison @@ -587,7 +627,7 @@ and [] Dval = caseName : string * fields : List - | DApplicable of Applicable +//| DApplicable of Applicable // // References // | DDB of name : string @@ -596,13 +636,13 @@ and [] Dval = and DvalTask = Ply -/// Our record/tracking of any variable bindings in scope -/// -/// i.e. within the execution of `x+y` in -/// `let x = 1; let y = 2; x + y` -/// , we would have a Symtable of -/// `{ "x" => DInt64 1; "y" => DInt64 2 }` -and Symtable = Map +// /// Our record/tracking of any variable bindings in scope +// /// +// /// i.e. within the execution of `x+y` in +// /// `let x = 1; let y = 2; x + y` +// /// , we would have a Symtable of +// /// `{ "x" => DInt64 1; "y" => DInt64 2 }` +// and Symtable = Map and ExecutionPoint = @@ -627,24 +667,26 @@ and ExecutionPoint = /// TODO maybe rename to ExprLocation and Source = ExecutionPoint * Option -and CallStack = - { - /// The entrypoint of the execution - /// (whatever we're executing for a user) - entrypoint : ExecutionPoint - - // TODO: bring this back and do something with it, - // and improve it to be more useful - // (i.e. maintain order of calls, deal with recursions, etc.) - // See https://chatgpt.com/share/087935f9-44be-4686-8209-66e701e887b1 - // /// All of the fns that have been called in this execution - // calledFns : Set - - /// The last-called thing (roughly) - /// - /// If we've encountered an exception, this should be where things failed - lastCalled : Source - } +// and CallStack = +// { +// /// The entrypoint of the execution +// /// (whatever we're executing for a user) +// entrypoint : ExecutionPoint + +// // TODO: bring this back and do something with it, +// // and improve it to be more useful +// // (i.e. maintain order of calls, deal with recursions, etc.) +// // See https://chatgpt.com/share/087935f9-44be-4686-8209-66e701e887b1 +// // /// All of the fns that have been called in this execution +// // calledFns : Set + +// /// The last-called thing (roughly) +// /// +// /// If we've encountered an exception, this should be where things failed +// lastCalled : Source +// } + +and ThreadID = uuid and BuiltInParam = { name : string @@ -954,9 +996,9 @@ module RuntimeError = -module CallStack = - let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = - { entrypoint = entrypoint; lastCalled = (entrypoint, None) } +// module CallStack = +// let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = +// { entrypoint = entrypoint; lastCalled = (entrypoint, None) } module TypeReference = let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = @@ -976,11 +1018,11 @@ module TypeReference = /// The tricky part is that we do want the CallStack around, to report on, /// and to use for debugging, but the way the Interpreter+Execution is set up, /// there's no great single place to `try/with` to supply the call stack. -exception RuntimeErrorException of Option * rte : RuntimeError.Error +exception RuntimeErrorException of ThreadID * rte : RuntimeError.Error -let raiseRTE (callStack : CallStack) (rte : RuntimeError.Error) : 'a = - raise (RuntimeErrorException(Some callStack, rte)) +let raiseRTE (threadId : ThreadID) (rte : RuntimeError.Error) : 'a = + raise (RuntimeErrorException(threadId, rte)) // let raiseRTE (callStack : CallStack) (rte : RuntimeError) : 'a = // raise (RuntimeErrorException(Some callStack, rte)) @@ -994,7 +1036,8 @@ let raiseRTE (callStack : CallStack) (rte : RuntimeError.Error) : 'a = /// Internally in the runtime, we allow throwing RuntimeErrorExceptions. At the /// boundary, typically in Execution.fs, we will catch the exception, and return /// this type. -type ExecutionResult = Result * RuntimeError.Error> +/// TODO return a call stack or vmstate, or something, here +type ExecutionResult = Result /// IncorrectArgs should never happen, as all functions are type-checked before /// calling. If it does happen, it means that the type parameters in the Fn structure @@ -1071,18 +1114,18 @@ module Dval = | DEnum(typeName, _, typeArgs, _, _) -> KTCustomType(typeName, typeArgs) |> ValueType.Known - | DApplicable applicable -> - match applicable with - | Lambda _lambda -> - // KTFn( - // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, - // ValueType.Unknown - // ) - // |> ValueType.Known - ValueType.Unknown +// | DApplicable applicable -> +// match applicable with +// | Lambda _lambda -> +// // KTFn( +// // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, +// // ValueType.Unknown +// // ) +// // |> ValueType.Known +// ValueType.Unknown - // VTTODO look up type, etc - | NamedFn _named -> ValueType.Unknown +// // VTTODO look up type, etc +// | NamedFn _named -> ValueType.Unknown // // CLEANUP follow up when DDB has a typeReference // | DDB _ -> ValueType.Unknown @@ -1136,8 +1179,13 @@ module PackageFn = type PackageFn = { id : uuid typeParams : List + + // CLEANUP I have an odd suspicion we might not need this field + // Maybe we just need a paramCount, and the Instructinos in PT2RT ???? parameters : NEList returnType : TypeReference + + // CLEANUP consider renaming - just `instructions` maybe? body : Instructions } @@ -1405,35 +1453,77 @@ and ExecutionState = and Registers = Dval array -and VMState = +and CallFrameContext = + | Source + | PackageFn of FQFnName.Package + +and CallFrame = { - /// Program counter -- what instruction index are we pointing at? - mutable pc : int + id : uuid - instructions : Instruction array + parent : Option + + argCount : int // TODO uint8 + + // TODO the instructions and resultReg should be extracted + // elsewhere so we have only one copy of them per CallFrameContext, + // in the VMState -- so we don't have to copy them around so much + context : CallFrameContext + instructions : Instruction array // move this elsewhere? + /// The register that the result of the program will be in resultReg : Register - mutable callStack : CallStack + + /// Program counter (what instruction index we are currently 'at') + mutable pc : int registers : Registers // mutable because array? - mutable symbolTable : Symtable // should this be a ConcurrentDictionary rather than a Map that's `mutable`? - mutable typeSymbolTable : TypeSymbolTable // same here + } - mutable lambdas : Map + +and VMState = + { callFrames : Map + + currentFrame : uuid + + //mutable lambdas : Map + + mutable threadID : uuid + + // TODO: call stack separately + + // Maybe these all belong in call frames. + // maybe the set of these _is_ the call frame? + //registers : Registers // mutable because array? + //mutable symbolTable : Symtable // should this be a ConcurrentDictionary rather than a Map that's `mutable`? + //mutable typeSymbolTable : TypeSymbolTable // same here } - static member fromInstructions (entrypoint) (instrs : Instructions) : VMState = - { pc = 0 - callStack = CallStack.fromEntryPoint entrypoint + static member fromExpr(exprInstrs : Instructions) : VMState = + let callFrameId = System.Guid.NewGuid() + + let callFrame : CallFrame = + { id = callFrameId + context = Source + pc = 0 + argCount = 0 + instructions = List.toArray exprInstrs.instructions + registers = Array.zeroCreate exprInstrs.registerCount + resultReg = exprInstrs.resultIn + + parent = None } + + { threadID = System.Guid.NewGuid() + currentFrame = callFrameId + callFrames = Map [ callFrameId, callFrame ] } + - instructions = List.toArray instrs.instructions - registers = Array.zeroCreate instrs.registerCount - resultReg = instrs.resultIn - symbolTable = Map.empty - typeSymbolTable = Map.empty - lambdas = Map.empty } +// // symbolTable = Map.empty +// // typeSymbolTable = Map.empty +// // lambdas = Map.empty +// } and Types = { typeSymbolTable : TypeSymbolTable @@ -1536,29 +1626,29 @@ let consoleNotifier : Notifier = print $"A notification happened in the runtime:\n {msg}\n {tags}\n\n" -let builtInParamToParam (p : BuiltInParam) : Param = { name = p.name; typ = p.typ } - -let builtInFnToFn (fn : BuiltInFn) : Fn = - { name = FQFnName.Builtin fn.name - typeParams = fn.typeParams - parameters = - fn.parameters - |> List.map builtInParamToParam - // We'd like to remove this and use NELists, but it's much too annoying to put - // this in every builtin fn definition - |> NEList.ofListUnsafe "builtInFnToFn" [ "name", fn.name ] - returnType = fn.returnType - previewable = fn.previewable - sqlSpec = fn.sqlSpec - fn = BuiltInFunction fn.fn } - -let packageFnToFn (fn : PackageFn.PackageFn) : Fn = - let toParam (p : PackageFn.Parameter) : Param = { name = p.name; typ = p.typ } - - { name = FQFnName.Package fn.id - typeParams = fn.typeParams - parameters = fn.parameters |> NEList.map toParam - returnType = fn.returnType - previewable = Impure - sqlSpec = NotQueryable - fn = PackageFunction(fn.id, fn.body) } +// let builtInParamToParam (p : BuiltInParam) : Param = { name = p.name; typ = p.typ } + +// let builtInFnToFn (fn : BuiltInFn) : Fn = +// { name = FQFnName.Builtin fn.name +// typeParams = fn.typeParams +// parameters = +// fn.parameters +// |> List.map builtInParamToParam +// // We'd like to remove this and use NELists, but it's much too annoying to put +// // this in every builtin fn definition +// |> NEList.ofListUnsafe "builtInFnToFn" [ "name", fn.name ] +// returnType = fn.returnType +// previewable = fn.previewable +// sqlSpec = fn.sqlSpec +// fn = BuiltInFunction fn.fn } + +// let packageFnToFn (fn : PackageFn.PackageFn) : Fn = +// let toParam (p : PackageFn.Parameter) : Param = { name = p.name; typ = p.typ } + +// { name = FQFnName.Package fn.id +// typeParams = fn.typeParams +// parameters = fn.parameters |> NEList.map toParam +// returnType = fn.returnType +// previewable = Impure +// sqlSpec = NotQueryable +// fn = PackageFunction(fn.id, fn.body) } diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index dbb941936a..ce16208497 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -410,7 +410,7 @@ module RTE = RuntimeError /// (Ideally, upon error, we'd "fill in" the callstack in the Interpreter somewhere?) module DvalCreator = - let list (cs : CallStack) (typ : ValueType) (items : List) : Dval = + let list (threadID : ThreadID) (typ : ValueType) (items : List) : Dval = let (typ, items) = items |> List.fold @@ -422,14 +422,14 @@ module DvalCreator = | Error() -> RTE.Lists.Error.TriedToAddMismatchedData(typ, dvalType, dv) |> RTE.Error.List - |> raiseRTE cs) + |> raiseRTE threadID) (typ, []) DList(typ, List.rev items) let dict - (cs : CallStack) + (threadID : ThreadID) (typ : ValueType) (entries : List) : Dval = @@ -440,7 +440,7 @@ module DvalCreator = // should we warn here instead? CLEANUP RTE.Dicts.Error.TriedToAddKeyAfterAlreadyPresent k |> RTE.Error.Dict - |> raiseRTE cs + |> raiseRTE threadID let vt = Dval.toValueType v match VT.merge typ vt with @@ -448,7 +448,7 @@ module DvalCreator = | Error() -> RTE.Dicts.Error.TriedToAddMismatchedData(typ, vt, v) |> RTE.Error.Dict - |> raiseRTE cs) + |> raiseRTE threadID) (typ, Map.empty) entries @@ -462,7 +462,7 @@ module DvalCreator = DEnum(Dval.optionType, Dval.optionType, [ innerType ], "None", []) let optionSome - (callStack : CallStack) + (threadID : ThreadID) (expectedType : ValueType) (dv : Dval) : Dval = @@ -475,15 +475,15 @@ module DvalCreator = | Error() -> // TODO this should be a more general Enum RTE // (and make sure you include the Option wrapper type -- this loses that) - RuntimeError.CannotMergeValues(expectedType, vt) |> raiseRTE callStack + RuntimeError.CannotMergeValues(expectedType, vt) |> raiseRTE threadID let option - (callStack : CallStack) + (threadID : ThreadID) (expectedType : ValueType) (dv : Option) : Dval = match dv with - | Some dv -> optionSome callStack expectedType dv + | Some dv -> optionSome threadID expectedType dv | None -> optionNone expectedType @@ -491,7 +491,7 @@ module DvalCreator = // let typeName = Dval.resultType // let ok - // (callStack : CallStack) + // (threadID: ThreadID) // (okType : ValueType) // (errorType : ValueType) // (dvOk : Dval) @@ -506,7 +506,7 @@ module DvalCreator = // |> raiseRTE callStack // let error - // (callStack : CallStack) + // (threadID: ThreadID) // (okType : ValueType) // (errorType : ValueType) // (dvError : Dval) @@ -520,7 +520,7 @@ module DvalCreator = // |> raiseRTE callStack // let result - // (callStack : CallStack) + // (threadID: ThreadID) // (okType : ValueType) // (errorType : ValueType) // (dv : Result) @@ -537,7 +537,7 @@ module DvalCreator = /// TODO this probably needs to both _take in_ and _return_ the typeSymbolTable /// (just pass it in as a ref -- but if this is happening concurrently with something else, ...) let record - (callStack : CallStack) + (threadID : ThreadID) (_types : Types) // is this Types thing what we want, or should we split tst and types? (typeName : FQTypeName.FQTypeName) (_typeArgs : List) @@ -556,11 +556,11 @@ module DvalCreator = match fields, k, v with // skip empty rows | _, "", _ -> - RTE.Records.CreationEmptyKey |> RTE.Record |> raiseRTE callStack + RTE.Records.CreationEmptyKey |> RTE.Record |> raiseRTE threadID // error if the key appears twice | fields, k, _v when Map.containsKey k fields -> - RTE.Records.CreationDuplicateField k |> RTE.Record |> raiseRTE callStack + RTE.Records.CreationDuplicateField k |> RTE.Record |> raiseRTE threadID // otherwise add it | fields, k, v -> diff --git a/backend/src/Prelude/Prelude.fs b/backend/src/Prelude/Prelude.fs index 4606bc8202..808b1d5c25 100644 --- a/backend/src/Prelude/Prelude.fs +++ b/backend/src/Prelude/Prelude.fs @@ -391,6 +391,9 @@ let gid () : uint64 = with e -> Exception.raiseInternal $"gid failed" [ "message", e.Message; "inner", e ] +let guuid(): uuid = + System.Guid.NewGuid() + let randomString (length : int) : string = let result = Array.init length (fun _ -> char (RNG.GetInt32(int32 'A', int32 'Z'))) diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 30839477cb..91af03ab9f 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -50,21 +50,21 @@ let eLet (pat : LetPattern) (value : Expr) (body : Expr) : Expr = ELet(gid (), pat, value, body) let eVar (name : string) : Expr = EVariable(gid (), name) -let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = - EIf(gid (), cond, thenBranch, elseBranch) +// let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = +// EIf(gid (), cond, thenBranch, elseBranch) -let eMatch (expr : Expr) (cases : List) : Expr = - EMatch(gid (), expr, cases) +// let eMatch (expr : Expr) (cases : List) : Expr = +// EMatch(gid (), expr, cases) -let eRecord - (typeName : FQTypeName.FQTypeName) - (typeArgs : List) - (fields : List) - : Expr = - ERecord(gid (), Ok typeName, typeArgs, fields) +// let eRecord +// (typeName : FQTypeName.FQTypeName) +// (typeArgs : List) +// (fields : List) +// : Expr = +// ERecord(gid (), Ok typeName, typeArgs, fields) -let eFieldAccess (expr : Expr) (fieldName : string) : Expr = - ERecordFieldAccess(gid (), expr, fieldName) +// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = +// ERecordFieldAccess(gid (), expr, fieldName) // let eEnum // (typeName : FQTypeName.FQTypeName) @@ -79,9 +79,9 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // |> PT2RT.FQFnName.toRT // |> fun x -> EFnName(gid (), x) -let eLambda id (pats : List) (body : Expr) : Expr = - let pats = NEList.ofListUnsafe "eLambda" [] pats - ELambda(id, pats, body) +// let eLambda id (pats : List) (body : Expr) : Expr = +// let pats = NEList.ofListUnsafe "eLambda" [] pats +// ELambda(id, pats, body) // let eFn' @@ -102,13 +102,13 @@ let eLambda id (pats : List) (body : Expr) : Expr = // eFn' function_ version typeArgs args -let eApply - (target : Expr) - (typeArgs : List) - (args : List) - : Expr = - let args = NEList.ofListUnsafe "eApply" [] args - EApply(gid (), target, typeArgs, args) +// let eApply +// (target : Expr) +// (typeArgs : List) +// (args : List) +// : Expr = +// let args = NEList.ofListUnsafe "eApply" [] args +// EApply(gid (), target, typeArgs, args) diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 86fc706270..30238cceae 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -376,7 +376,7 @@ module Expect = | DDateTime _ | DUuid _ - | DApplicable _ + //| DApplicable _ // | DDB _ -> true @@ -881,7 +881,7 @@ module Expect = | DDict _, _ | DRecord _, _ | DEnum _, _ - | DApplicable _, _ + //| DApplicable _, _ // | DDB _, _ -> check path actual expected @@ -954,7 +954,7 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = | DString _ // TODO: should actually traverse in interpolations | DUuid _ | DDateTime _ - | DApplicable _ + //| DApplicable _ // | DDB _ -> f dv f dv diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index d93f840675..0c41ddca8b 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -20,10 +20,7 @@ let tCheckVM (extraVmStateAssertions : RT.VMState -> unit) = testTask name { - let vmState = - ptExpr - |> PT2RT.Expr.toRT 0 - |> RT.VMState.fromInstructions RT.ExecutionPoint.Script + let vmState = ptExpr |> PT2RT.Expr.toRT Map.empty 0 |> RT.VMState.fromExpr let! exeState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false @@ -41,17 +38,16 @@ let t name ptExpr expectedInsts = let tFail name ptExpr expectedRte = testTask name { - let instructionsWithContext = ptExpr |> PT2RT.Expr.toRT 0 + let instructions = ptExpr |> PT2RT.Expr.toRT Map.empty 0 let! exeState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false - let! actual = - LibExecution.Execution.executeExpr exeState Map.empty instructionsWithContext + let! actual = LibExecution.Execution.executeExpr exeState instructions match actual with | Ok _ -> return Expect.equal 1 2 "Expected an RTE, but got a successful result" - | Error(_cs, actualRte) -> return Expect.equal actualRte expectedRte "" + | Error(actualRte) -> return Expect.equal actualRte expectedRte "" } @@ -111,7 +107,7 @@ module Let = (RTE.Error.Let( RTE.Lets.Error.PatternDoesNotMatch( RT.DInt64 1, - RT.LPTuple(RT.LPVariable "a", RT.LPVariable "b", []) + RT.LPTuple(RT.LPVariable 1, RT.LPVariable 2, []) ) )) @@ -123,7 +119,7 @@ module Let = (RTE.Error.Let( RTE.Lets.Error.PatternDoesNotMatch( RT.DTuple(RT.DInt64 1, RT.DInt64 2, [ RT.DInt64 3 ]), - RT.LPTuple(RT.LPVariable "a", RT.LPVariable "b", []) + RT.LPTuple(RT.LPVariable 4, RT.LPVariable 5, []) ) )) @@ -142,13 +138,18 @@ module Let = module String = let simple = t "[\"hello\"]" E.String.simple (RT.DString "hello") - let withInterpolation = - t - "[let x = \"world\" in $\"hello {x}\"]" - E.String.withInterpolation - (RT.DString "hello, world") + // let withInterpolation = + // t + // "[let x = \"world\" in $\"hello {x}\"]" + // E.String.withInterpolation + // (RT.DString "hello, world") - let tests = testList "Strings" [ simple; withInterpolation ] + let tests = + testList + "Strings" + [ simple + //withInterpolation + ] module Dict = @@ -175,12 +176,12 @@ module Dict = let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] -module If = - let gotoThenBranch = t "if true then 1 else 2" E.If.gotoThenBranch (RT.DInt64 1L) - let gotoElseBranch = t "if false then 1 else 2" E.If.gotoElseBranch (RT.DInt64 2L) - let elseMissing = t "if false then 1" E.If.elseMissing RT.DUnit +// module If = +// let gotoThenBranch = t "if true then 1 else 2" E.If.gotoThenBranch (RT.DInt64 1L) +// let gotoElseBranch = t "if false then 1 else 2" E.If.gotoElseBranch (RT.DInt64 2L) +// let elseMissing = t "if false then 1" E.If.elseMissing RT.DUnit - let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] +// let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] module Tuples = @@ -206,128 +207,128 @@ module Tuples = let tests = testList "Tuples" [ two; three; nested ] -module Match = - let simple = - t - "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" - E.Match.simple - (RT.DString "second branch") - - let notMatched = - tFail - "match true with\n| false -> \"first branch\"" - E.Match.notMatched - RTE.MatchUnmatched - - let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) - - // let withVarAndWhenCondition = - // t - // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - // E.Match.withVarAndWhenCondition - // (RT.DString "second branch") - - let list = - t - "match [1, 2] with\n| [1, 2] -> \"first branch\"" - E.Match.list - (RT.DString "first branch") - - let listCons = - t - "match [1, 2] with\n| 1 :: tail -> tail" - E.Match.listCons - (RT.DList(VT.int64, [ RT.DInt64 2L ])) - - let tuple = - t - "match (1, 2) with\n| (1, 2) -> \"first branch\"" - E.Match.tuple - (RT.DString "first branch") - - let tests = - testList - "Match" - [ simple - notMatched - withVar - //withVarAndWhenCondition - list - listCons - tuple ] - - -module Records = - let simple = - let typeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField - t - "Test.Test { key = true }" - E.Records.simple - (RT.DRecord(typeName, typeName, [], Map [ "key", RT.DBool true ])) - - let nested = - let outerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.nested - let innerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField - t - "Test.Test2 { outer = (Test.Test { key = true }) }" - E.Records.nested - (RT.DRecord( - outerTypeName, - outerTypeName, - [], - Map - [ "outer", - RT.DRecord( - innerTypeName, - innerTypeName, - [], - Map [ "key", RT.DBool true ] - ) ] - )) - - - let tests = testList "Records" [ simple; nested ] - - -module RecordFieldAccess = - let simple = - t "(Test.Test { key = true }).key" E.RecordFieldAccess.simple (RT.DBool true) - let notRecord = - tFail - "1.key" - E.RecordFieldAccess.notRecord - (RTE.Record(RTE.Records.FieldAccessNotRecord VT.int64)) - - let missingField = - tFail - "(Test.Test { key = true }).missing" - E.RecordFieldAccess.missingField - (RTE.Record(RTE.Records.FieldAccessFieldNotFound "missing")) - - let nested = - t - "(Test.Test2 { outer = (Test.Test { key = true }) }).outer.key" - E.RecordFieldAccess.nested - (RT.DBool true) - - let tests = - testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] - - -module Lambdas = - let identityUnapplied = - tCheckVM - "fn x -> x" - E.Lambdas.identityUnapplied - (RT.DApplicable( - RT.Lambda - { exprId = E.Lambdas.identityID; symtable = Map.empty; argsSoFar = [] } - )) - (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") - - let identityApplied = t "(fn x -> x) 1" E.Lambdas.identityApplied (RT.DInt64 1L) - - let tests = testList "Lambdas" [ identityUnapplied; identityApplied ] +// module Match = +// let simple = +// t +// "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" +// E.Match.simple +// (RT.DString "second branch") + +// let notMatched = +// tFail +// "match true with\n| false -> \"first branch\"" +// E.Match.notMatched +// RTE.MatchUnmatched + +// let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) + +// // let withVarAndWhenCondition = +// // t +// // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" +// // E.Match.withVarAndWhenCondition +// // (RT.DString "second branch") + +// let list = +// t +// "match [1, 2] with\n| [1, 2] -> \"first branch\"" +// E.Match.list +// (RT.DString "first branch") + +// let listCons = +// t +// "match [1, 2] with\n| 1 :: tail -> tail" +// E.Match.listCons +// (RT.DList(VT.int64, [ RT.DInt64 2L ])) + +// let tuple = +// t +// "match (1, 2) with\n| (1, 2) -> \"first branch\"" +// E.Match.tuple +// (RT.DString "first branch") + +// let tests = +// testList +// "Match" +// [ simple +// notMatched +// withVar +// //withVarAndWhenCondition +// list +// listCons +// tuple ] + + +// module Records = +// let simple = +// let typeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField +// t +// "Test.Test { key = true }" +// E.Records.simple +// (RT.DRecord(typeName, typeName, [], Map [ "key", RT.DBool true ])) + +// let nested = +// let outerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.nested +// let innerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField +// t +// "Test.Test2 { outer = (Test.Test { key = true }) }" +// E.Records.nested +// (RT.DRecord( +// outerTypeName, +// outerTypeName, +// [], +// Map +// [ "outer", +// RT.DRecord( +// innerTypeName, +// innerTypeName, +// [], +// Map [ "key", RT.DBool true ] +// ) ] +// )) + + +// let tests = testList "Records" [ simple; nested ] + + +// module RecordFieldAccess = +// let simple = +// t "(Test.Test { key = true }).key" E.RecordFieldAccess.simple (RT.DBool true) +// let notRecord = +// tFail +// "1.key" +// E.RecordFieldAccess.notRecord +// (RTE.Record(RTE.Records.FieldAccessNotRecord VT.int64)) + +// let missingField = +// tFail +// "(Test.Test { key = true }).missing" +// E.RecordFieldAccess.missingField +// (RTE.Record(RTE.Records.FieldAccessFieldNotFound "missing")) + +// let nested = +// t +// "(Test.Test2 { outer = (Test.Test { key = true }) }).outer.key" +// E.RecordFieldAccess.nested +// (RT.DBool true) + +// let tests = +// testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + + +// module Lambdas = +// let identityUnapplied = +// tCheckVM +// "fn x -> x" +// E.Lambdas.identityUnapplied +// (RT.DApplicable( +// RT.Applicable.Lambda +// { exprId = E.Lambdas.identityID; symtable = Map.empty; argsSoFar = [] } +// )) +// (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + +// let identityApplied = t "(fn x -> x) 1" E.Lambdas.identityApplied (RT.DInt64 1L) + +// let tests = testList "Lambdas" [ identityUnapplied; identityApplied ] let tests = @@ -338,9 +339,10 @@ let tests = Let.tests String.tests Dict.tests - If.tests + // If.tests Tuples.tests - Match.tests - Records.tests - RecordFieldAccess.tests - Lambdas.tests ] + // Match.tests + // Records.tests + // RecordFieldAccess.tests + // Lambdas.tests + ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 609d14ee7d..174ed6f0c2 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -13,644 +13,698 @@ module PackageIDs = LibExecution.PackageIDs module E = TestValues.Expressions module PM = TestValues.PM +open TestUtils.PTShortcuts + // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists -let t name expr expected = - testTask name { - let actual = PT2RT.Expr.toRT 0 expr - let actual = (actual.registerCount, actual.instructions, actual.resultIn) - return Expect.equal actual expected "" - } - -module Basic = - let one = t "1" E.Basic.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) - - // let onePlusTwo = - // t - // "1+2" - // E.Basic.onePlusTwo - // (4, - // [ RT.LoadVal( - // 0, - // RT.DFnVal( - // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) +// TODO we need tests of PT2RT-ing *functions* as well. + +module Expr = + let t name expr expected = + testTask name { + let actual = PT2RT.Expr.toRT Map.empty 0 expr + let actual = (actual.registerCount, actual.instructions, actual.resultIn) + return Expect.equal actual expected "" + } + + module Basic = + let one = t "1" E.Basic.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) + + // let onePlusTwo = + // t + // "1+2" + // E.Basic.onePlusTwo + // (4, + // [ RT.LoadVal( + // 0, + // RT.DFnVal( + // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + // ) + // ) + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], + // 3) + + let tests = + testList + "Basic" + [ one + //onePlusTwo + ] + + + module Let = + let simple = + t + "let x = true\n x" + E.Let.simple + (2, + [ RT.LoadVal(0, RT.DBool true) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) ], + 1) + + let tuple = + t + "let (x, y) = (1, 2)\nx" + E.Let.tuple + (5, + [ // register 0 isn't exposed, but used to temporarily store the tuple + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple(RT.LPVariable 3, RT.LPVariable 4, []) + ) ], + 3) + + let tupleNested = + t + "let (a, (b, c)) = (1, (2, 3)) in b" + E.Let.tupleNested + (8, + [ // reserve 0 for outer tuple + RT.LoadVal(1, RT.DInt64 1L) + // reserve 2 for inner tuple + RT.LoadVal(3, RT.DInt64 2L) + RT.LoadVal(4, RT.DInt64 3L) + RT.CreateTuple(2, 3, 4, []) // create inner tuple + RT.CreateTuple(0, 1, 2, []) // create outer tuple + RT.CheckLetPatternAndExtractVars( + 0, + RT.LPTuple( + RT.LPVariable 5, + RT.LPTuple(RT.LPVariable 6, RT.LPVariable 7, []), + [] + ) + ) ], + 6) + + let undefinedVar = t "a" E.Let.undefinedVar (0, [ RT.VarNotFound "a" ], 0) + + let tests = testList "Let" [ simple; tuple; tupleNested; undefinedVar ] + + + module List = + let simple = + t + "[true, false, true]" + E.List.simple + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateList(0, [ 1; 2; 3 ]) ], + 0) + + let nested = + t + "[[true; false]; [false; true]]" + E.List.nested + (7, + [ // first inner list + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateList(1, [ 2; 3 ]) + + // second inner list + RT.LoadVal(5, RT.DBool false) + RT.LoadVal(6, RT.DBool true) + RT.CreateList(4, [ 5; 6 ]) + + // outer list + RT.CreateList(0, [ 1; 4 ]) ], + 0) + + let mixed = + t + "[1, true]" + E.List.mixed + (3, + [ RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DBool true) + RT.CreateList(0, [ 1; 2 ]) ], + 0) + + let tests = testList "Lists" [ simple; nested; mixed ] + + + module String = + let simple = + t "[\"hello\"]" E.String.simple (1, [ RT.LoadVal(0, RT.DString "hello") ], 0) + + // let withInterpolation = + // t + // "[let x = \"world\"\n$\"hello {x}\"]" + // E.String.withInterpolation + // (3, + // [ RT.LoadVal(0, RT.DString ", world") + // RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") + + // RT.GetVar(1, "x") + // RT.CreateString(2, [ RT.Text "hello"; RT.Interpolated 1 ]) ], + // 2) + + let tests = + testList + "String" + [ simple + //withInterpolation + ] + + + module Dict = + let empty = t "Dict {}" E.Dict.empty (1, [ RT.CreateDict(0, []) ], 0) + + let simple = + t + "Dict { t: true}" + E.Dict.simple + (2, [ RT.LoadVal(1, RT.DBool true); RT.CreateDict(0, [ ("key", 1) ]) ], 0) + + let multEntries = + t + "Dict {t: true; f: false}" + E.Dict.multEntries + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.CreateDict(0, [ ("t", 1); ("f", 2) ]) ], + 0) + + let dupeKey = + t + "Dict {t: true; f: false; t: true}" + E.Dict.dupeKey + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool false) + RT.CreateDict(0, [ ("t", 1); ("f", 2); ("t", 3) ]) ], + 0) + + let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] + + + // module If = + // let gotoThenBranch = + // t + // "if true then 1 else 2" + // E.If.gotoThenBranch + // (4, + // [ // reserve register 0 for the result + + // // cond + // RT.LoadVal(1, RT.DBool true) + // RT.JumpByIfFalse(3, 1) + + // // then + // RT.LoadVal(2, RT.DInt64 1L) + // RT.CopyVal(0, 2) + // RT.JumpBy 2 + + // // else + // RT.LoadVal(3, RT.DInt64 2L) + // RT.CopyVal(0, 3) ], + // 0) + + + // let gotoElseBranch = + // t + // "if false then 1 else 2" + // E.If.gotoElseBranch + // (4, + // [ // cond + // RT.LoadVal(1, RT.DBool false) + // RT.JumpByIfFalse(3, 1) + + // // then + // RT.LoadVal(2, RT.DInt64 1L) + // RT.CopyVal(0, 2) + // RT.JumpBy 2 + + // // else + // RT.LoadVal(3, RT.DInt64 2L) + // RT.CopyVal(0, 3) ], + // 0) + + // let elseMissing = + // t + // "if false then 1" + // E.If.elseMissing + // (3, + // [ RT.LoadVal(0, RT.DUnit) + // RT.LoadVal(1, RT.DBool false) + // RT.JumpByIfFalse(2, 1) + // RT.LoadVal(2, RT.DInt64 1L) + // RT.CopyVal(0, 2) ], + // 0) + + // let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] + + + module Tuples = + let two = + t + "(false, true)" + E.Tuples.two + (3, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.CreateTuple(0, 1, 2, []) ], + 0) + + let three = + t + "(false, true, false)" + E.Tuples.three + (4, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateTuple(0, 1, 2, [ 3 ]) ], + 0) + + let nested = + t + "((false, true), true, (true, false))" + E.Tuples.nested + (8, + [ // 0 "reserved" for outer tuple + + // first inner tuple (1 "reserved") + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateTuple(1, 2, 3, []) + + // middle value + RT.LoadVal(4, RT.DBool true) + + // second inner tuple (5 "reserved") + RT.LoadVal(6, RT.DBool true) + RT.LoadVal(7, RT.DBool false) + RT.CreateTuple(5, 6, 7, []) + + // wrap all in outer tuple + RT.CreateTuple(0, 1, 4, [ 5 ]) ], + 0) + + let tests = testList "Tuples" [ two; three; nested ] + + + // module Match = + // let simple = + // t + // "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + // E.Match.simple + // (3, + // [ // handle the value we're matching on + // RT.LoadVal(0, RT.DBool true) + + // // FIRST BRANCH + // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) + // // rhs + // RT.LoadVal(2, RT.DString "first branch") + // RT.CopyVal(1, 2) + // RT.JumpBy 5 + + // // SECOND BRANCH + // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 3) + // // rhs + // RT.LoadVal(2, RT.DString "second branch") + // RT.CopyVal(1, 2) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 1) + + // let notMatched = + // t + // "match true with\n| false -> \"first branch\"" + // E.Match.notMatched + // (3, + // [ // handle the value we're matching on + // RT.LoadVal(0, RT.DBool true) + + // // FIRST BRANCH + // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) + // // rhs + // RT.LoadVal(2, RT.DString "first branch") + // RT.CopyVal(1, 2) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 1) + + // let withVar = + // t + // "match true with\n| x -> x" + // E.Match.withVar + // (3, + // [ RT.LoadVal(0, RT.DBool true) + + // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) + // RT.GetVar(2, "x") + // RT.CopyVal(1, 2) + // RT.JumpBy 1 + + // RT.MatchUnmatched ], + // 1) + + // // let withVarAndWhenCondition = + // // t + // // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + // // E.Match.withVarAndWhenCondition + // // (10, + // // [ RT.LoadVal(0, RT.DInt64 4L) + + // // // first branch + // // RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) + // // RT.LoadVal(2, RT.DString "") + // // RT.LoadVal(3, RT.DString "first branch") + // // RT.AppendString(2, 3) + // // RT.CopyVal(1, 2) + // // RT.JumpBy 14 + + // // // second branch + // // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) + // // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + // // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + // // RT.GetVar(4, "x") + // // RT.Apply(5, 3, [], NEList.ofList 4 []) + // // RT.LoadVal(6, RT.DInt64 2L) + // // RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + // // RT.JumpByIfFalse(5, 7) + // // RT.LoadVal(8, RT.DString "") + // // RT.LoadVal(9, RT.DString "second branch") + // // RT.AppendString(8, 9) + // // RT.CopyVal(1, 8) + // // RT.JumpBy 1 + + // // // handle the case where no branches match + // // RT.MatchUnmatched ], + // // 1) + + // let list = + // t + // "match [1, 2] with\n| [1, 2] -> \"first branch\"" + // E.Match.list + // (5, + // [ // expr, whose result we store in 0 + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.CreateList(0, [ 1; 2 ]) + + // // first branch + // RT.CheckMatchPatternAndExtractVars( + // 0, + // RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], + // 3 + // ) + // RT.LoadVal(4, RT.DString "first branch") + // RT.CopyVal(3, 4) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 3) + + // let listCons = + // t + // "match [1, 2] with\n| 1 :: tail -> tail" + // E.Match.listCons + // (5, + // [ // expr, whose result we store in 0 + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.CreateList(0, [ 1; 2 ]) + + // // first branch + // RT.CheckMatchPatternAndExtractVars( + // 0, + // RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), + // 3 + // ) + // RT.GetVar(4, "tail") + // RT.CopyVal(3, 4) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 3) + + // let tuple = + // t + // "match (1, 2) with\n| (1, 2) -> \"first branch\"" + // E.Match.tuple + // (5, + // [ // expr, whose result we store in 0 + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.CreateTuple(0, 1, 2, []) + + // // first branch + // RT.CheckMatchPatternAndExtractVars( + // 0, + // RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), + // 3 + // ) + // RT.LoadVal(4, RT.DString "first branch") + // RT.CopyVal(3, 4) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 3) + + // let tests = + // testList + // "Match" + // [ simple + // notMatched + // withVar + // //withVarAndWhenCondition // -- disabled because of fn-calling issues + // list + // listCons + // tuple ] + + + // module Records = + // let simple = + // t + // "Test.Test { key = true }" + // E.Records.simple + // (2, + // [ RT.LoadVal(1, RT.DBool true) + // RT.CreateRecord( + // 0, + // RT.FQTypeName.fqPackage PM.Types.Records.singleField, + // [], + // [ ("key", 1) ] + // ) ], + // 0) + + // let nested = + // t + // "Test.Test2 { outer = (Test.Test { key = true }) }" + // E.Records.nested + // (3, + // [ RT.LoadVal(2, RT.DBool true) + + // // inner record + // RT.CreateRecord( + // 1, + // RT.FQTypeName.fqPackage PM.Types.Records.singleField, + // [], + // [ ("key", 2) ] // ) - // ) - // RT.LoadVal(1, RT.DInt64 1L) - // RT.LoadVal(2, RT.DInt64 2L) - // RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], - // 3) + + // // outer record + // RT.CreateRecord( + // 0, + // RT.FQTypeName.fqPackage PM.Types.Records.nested, + // [], + // [ ("outer", 1) ] + // ) ], + // 0) + + // let tests = testList "Records" [ simple; nested ] + + + // module RecordFieldAccess = + // let simple = + // t + // "let r = Test.Test { key = true }\nr.key" + // E.RecordFieldAccess.simple + // (3, + // [ RT.LoadVal(1, RT.DBool true) + // RT.CreateRecord( + // 0, + // RT.FQTypeName.fqPackage PM.Types.Records.singleField, + // [], + // [ ("key", 1) ] + // ) + // RT.GetRecordField(2, 0, "key") ], + // 2) + + // let notRecord = + // t + // "1.key" + // E.RecordFieldAccess.notRecord + // (2, [ RT.LoadVal(0, RT.DInt64 1L); RT.GetRecordField(1, 0, "key") ], 1) + + // let missingField = + // t + // "(Test.Test { key = true }).missing" + // E.RecordFieldAccess.missingField + // (3, + // [ RT.LoadVal(1, RT.DBool true) + // RT.CreateRecord( + // 0, + // RT.FQTypeName.fqPackage PM.Types.Records.singleField, + // [], + // [ ("key", 1) ] + // ) + // RT.GetRecordField(2, 0, "missing") ], + // 2) + + // let nested = + // t + // "(Test.Test2 { outer = Test.Test { key = true } }).outer.key" + // E.RecordFieldAccess.nested + // (5, + // [ RT.LoadVal(2, RT.DBool true) + // RT.CreateRecord( + // 1, + // RT.FQTypeName.fqPackage PM.Types.Records.singleField, + // [], + // [ ("key", 2) ] + // ) + + // RT.CreateRecord( + // 0, + // RT.FQTypeName.fqPackage PM.Types.Records.nested, + // [], + // [ ("outer", 1) ] + // ) + // RT.GetRecordField(3, 0, "outer") + // RT.GetRecordField(4, 3, "key") ], + // 4) + + + // let tests = + // testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + + + // module RecordUpdate = + // // TODO + + // let tests = testList "RecordUpdate" [] + + + // module Lambda = + // let identityUnapplied = + // t + // "fn x -> x" + // E.Lambdas.identityUnapplied + // (1, + // [ RT.CreateLambda( + // 0, + // { exprId = E.Lambdas.identityID + // patterns = NEList.ofList (RT.LPVariable "x") [] + // symbolsToClose = [] |> Set.ofList + // instructions = + // { registerCount = 1 + // instructions = [ RT.GetVar(0, "x") ] + // resultIn = 0 } } + // ) ], + // 0) + + // let identityApplied = + // t + // "(fn x -> x) 1" + // E.Lambdas.identityApplied + // (3, + // [ RT.CreateLambda( + // 0, + // { exprId = E.Lambdas.identityID + // patterns = NEList.ofList (RT.LPVariable "x") [] + // symbolsToClose = [] |> Set.ofList + // instructions = + // { registerCount = 1 + // instructions = [ RT.GetVar(0, "x") ] + // resultIn = 0 } } + // ) + // RT.LoadVal(1, RT.DInt64 1L) + // RT.Apply(2, 0, [], NEList.ofList 1 []) ], + // 2) + + // let tests = testList "Lambda" [ identityUnapplied; identityApplied ] + let tests = testList - "Basic" - [ one - //onePlusTwo + "Expr" + [ Basic.tests + Let.tests + List.tests + String.tests + Dict.tests + // If.tests + Tuples.tests + // Match.tests + // Records.tests + // RecordFieldAccess.tests + // RecordUpdate.tests + // Lambda.tests ] +module PackageFn = + let t name fnName typeParams params' returnType expr expected = + testTask name { + let fn : PT.PackageFn.PackageFn = + { id = guuid () + name = { owner = "Test"; modules = []; name = fnName } + body = expr + typeParams = typeParams + parameters = params' |> NEList.ofListUnsafe "" [] + returnType = returnType + description = "TODO" + deprecated = PT.NotDeprecated } + + let actual = PT2RT.PackageFn.toRT fn + return Expect.equal actual.body expected "" + } + + // module Basic = + // let add = + // t + // "add" + // "add" + // [] + // [ { name = "a"; typ = PT.TInt64; description = "TODO" } + // { name = "b"; typ = PT.TInt64; description = "TODO" } ] + // PT.TInt64 + // (eVar "b") + // (4, + // [ RT.LoadVal( + // 0, + // RT.DFnVal( + // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + // ) + // ) + // RT.LoadVal(1, RT.DInt64 1L) + // RT.LoadVal(2, RT.DInt64 2L) + // RT.Apply(3, 0, [], NEList.ofListUnsafe "" [ 1; 2 ]) ], + // 3) -module Let = - let simple = - t - "let x = true\n x" - E.Let.simple - (2, - [ RT.LoadVal(0, RT.DBool true) - RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - RT.GetVar(1, "x") ], - 1) - - let tuple = - t - "let (x, y) = (1, 2)\nx" - E.Let.tuple - (4, - [ // register 0 isn't exposed, but used to temporarily store the tuple - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - - RT.CheckLetPatternAndExtractVars( - 0, - RT.LPTuple(RT.LPVariable "x", RT.LPVariable "y", []) - ) - - RT.GetVar(3, "x") ], - 3) - - let tupleNested = - t - "let (a, (b, c)) = (1, (2, 3)) in b" - E.Let.tupleNested - (6, - [ // reserve 0 for outer tuple - RT.LoadVal(1, RT.DInt64 1L) - // reserve 2 for inner tuple - RT.LoadVal(3, RT.DInt64 2L) - RT.LoadVal(4, RT.DInt64 3L) - RT.CreateTuple(2, 3, 4, []) // create inner tuple - RT.CreateTuple(0, 1, 2, []) // create outer tuple - RT.CheckLetPatternAndExtractVars( - 0, - RT.LPTuple( - RT.LPVariable "a", - RT.LPTuple(RT.LPVariable "b", RT.LPVariable "c", []), - [] - ) - ) - RT.GetVar(5, "b") ], - 5) - - let tests = testList "Let" [ simple; tuple; tupleNested ] - - -module List = - let simple = - t - "[true, false, true]" - E.List.simple - (4, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateList(0, [ 1; 2; 3 ]) ], - 0) - - let nested = - t - "[[true; false]; [false; true]]" - E.List.nested - (7, - [ // first inner list - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateList(1, [ 2; 3 ]) - - // second inner list - RT.LoadVal(5, RT.DBool false) - RT.LoadVal(6, RT.DBool true) - RT.CreateList(4, [ 5; 6 ]) - - // outer list - RT.CreateList(0, [ 1; 4 ]) ], - 0) - - let mixed = - t - "[1, true]" - E.List.mixed - (3, - [ RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DBool true) - RT.CreateList(0, [ 1; 2 ]) ], - 0) - - let tests = testList "Lists" [ simple; nested; mixed ] - - -module String = - let simple = - t "[\"hello\"]" E.String.simple (1, [ RT.LoadVal(0, RT.DString "hello") ], 0) - - let withInterpolation = - t - "[let x = \"world\"\n$\"hello {x}\"]" - E.String.withInterpolation - (3, - [ RT.LoadVal(0, RT.DString ", world") - RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - - RT.GetVar(1, "x") - RT.CreateString(2, [ RT.Text "hello"; RT.Interpolated 1 ]) ], - 2) - - let tests = testList "String" [ simple; withInterpolation ] - - -module Dict = - let empty = t "Dict {}" E.Dict.empty (1, [ RT.CreateDict(0, []) ], 0) - - let simple = - t - "Dict { t: true}" - E.Dict.simple - (2, [ RT.LoadVal(1, RT.DBool true); RT.CreateDict(0, [ ("key", 1) ]) ], 0) - - let multEntries = - t - "Dict {t: true; f: false}" - E.Dict.multEntries - (3, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.CreateDict(0, [ ("t", 1); ("f", 2) ]) ], - 0) - - let dupeKey = - t - "Dict {t: true; f: false; t: true}" - E.Dict.dupeKey - (4, - [ RT.LoadVal(1, RT.DBool true) - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool false) - RT.CreateDict(0, [ ("t", 1); ("f", 2); ("t", 3) ]) ], - 0) - - let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] - - -module If = - let gotoThenBranch = - t - "if true then 1 else 2" - E.If.gotoThenBranch - (4, - [ // reserve register 0 for the result - - // cond - RT.LoadVal(1, RT.DBool true) - RT.JumpByIfFalse(3, 1) - - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 - - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) - - - let gotoElseBranch = - t - "if false then 1 else 2" - E.If.gotoElseBranch - (4, - [ // cond - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(3, 1) - - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 - - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) - - let elseMissing = - t - "if false then 1" - E.If.elseMissing - (3, - [ RT.LoadVal(0, RT.DUnit) - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(2, 1) - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) ], - 0) - - let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] - - -module Tuples = - let two = - t - "(false, true)" - E.Tuples.two - (3, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.CreateTuple(0, 1, 2, []) ], - 0) - - let three = - t - "(false, true, false)" - E.Tuples.three - (4, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateTuple(0, 1, 2, [ 3 ]) ], - 0) - - let nested = - t - "((false, true), true, (true, false))" - E.Tuples.nested - (8, - [ // 0 "reserved" for outer tuple - - // first inner tuple (1 "reserved") - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateTuple(1, 2, 3, []) - - // middle value - RT.LoadVal(4, RT.DBool true) - - // second inner tuple (5 "reserved") - RT.LoadVal(6, RT.DBool true) - RT.LoadVal(7, RT.DBool false) - RT.CreateTuple(5, 6, 7, []) - - // wrap all in outer tuple - RT.CreateTuple(0, 1, 4, [ 5 ]) ], - 0) - - let tests = testList "Tuples" [ two; three; nested ] - - -module Match = - let simple = - t - "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" - E.Match.simple - (3, - [ // handle the value we're matching on - RT.LoadVal(0, RT.DBool true) - - // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) - // rhs - RT.LoadVal(2, RT.DString "first branch") - RT.CopyVal(1, 2) - RT.JumpBy 5 - - // SECOND BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 3) - // rhs - RT.LoadVal(2, RT.DString "second branch") - RT.CopyVal(1, 2) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) - - let notMatched = - t - "match true with\n| false -> \"first branch\"" - E.Match.notMatched - (3, - [ // handle the value we're matching on - RT.LoadVal(0, RT.DBool true) - - // FIRST BRANCH - RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) - // rhs - RT.LoadVal(2, RT.DString "first branch") - RT.CopyVal(1, 2) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 1) - - let withVar = - t - "match true with\n| x -> x" - E.Match.withVar - (3, - [ RT.LoadVal(0, RT.DBool true) - - RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) - RT.GetVar(2, "x") - RT.CopyVal(1, 2) - RT.JumpBy 1 - - RT.MatchUnmatched ], - 1) - - // let withVarAndWhenCondition = - // t - // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - // E.Match.withVarAndWhenCondition - // (10, - // [ RT.LoadVal(0, RT.DInt64 4L) - - // // first branch - // RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) - // RT.LoadVal(2, RT.DString "") - // RT.LoadVal(3, RT.DString "first branch") - // RT.AppendString(2, 3) - // RT.CopyVal(1, 2) - // RT.JumpBy 14 - - // // second branch - // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) - // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) - // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) - // RT.GetVar(4, "x") - // RT.Apply(5, 3, [], NEList.ofList 4 []) - // RT.LoadVal(6, RT.DInt64 2L) - // RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) - // RT.JumpByIfFalse(5, 7) - // RT.LoadVal(8, RT.DString "") - // RT.LoadVal(9, RT.DString "second branch") - // RT.AppendString(8, 9) - // RT.CopyVal(1, 8) - // RT.JumpBy 1 - - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 1) - - let list = - t - "match [1, 2] with\n| [1, 2] -> \"first branch\"" - E.Match.list - (5, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateList(0, [ 1; 2 ]) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], - 3 - ) - RT.LoadVal(4, RT.DString "first branch") - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) - - let listCons = - t - "match [1, 2] with\n| 1 :: tail -> tail" - E.Match.listCons - (5, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateList(0, [ 1; 2 ]) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), - 3 - ) - RT.GetVar(4, "tail") - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) - - let tuple = - t - "match (1, 2) with\n| (1, 2) -> \"first branch\"" - E.Match.tuple - (5, - [ // expr, whose result we store in 0 - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - - // first branch - RT.CheckMatchPatternAndExtractVars( - 0, - RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), - 3 - ) - RT.LoadVal(4, RT.DString "first branch") - RT.CopyVal(3, 4) - RT.JumpBy 1 - - // handle the case where no branches match - RT.MatchUnmatched ], - 3) - let tests = - testList - "Match" - [ simple - notMatched - withVar - //withVarAndWhenCondition // -- disabled because of fn-calling issues - list - listCons - tuple ] - - -module Records = - let simple = - t - "Test.Test { key = true }" - E.Records.simple - (2, - [ RT.LoadVal(1, RT.DBool true) - RT.CreateRecord( - 0, - RT.FQTypeName.fqPackage PM.Types.Records.singleField, - [], - [ ("key", 1) ] - ) ], - 0) - - let nested = - t - "Test.Test2 { outer = (Test.Test { key = true }) }" - E.Records.nested - (3, - [ RT.LoadVal(2, RT.DBool true) - - // inner record - RT.CreateRecord( - 1, - RT.FQTypeName.fqPackage PM.Types.Records.singleField, - [], - [ ("key", 2) ] - ) - - // outer record - RT.CreateRecord( - 0, - RT.FQTypeName.fqPackage PM.Types.Records.nested, - [], - [ ("outer", 1) ] - ) ], - 0) - - let tests = testList "Records" [ simple; nested ] - - -module RecordFieldAccess = - let simple = - t - "let r = Test.Test { key = true }\nr.key" - E.RecordFieldAccess.simple - (3, - [ RT.LoadVal(1, RT.DBool true) - RT.CreateRecord( - 0, - RT.FQTypeName.fqPackage PM.Types.Records.singleField, - [], - [ ("key", 1) ] - ) - RT.GetRecordField(2, 0, "key") ], - 2) - - let notRecord = - t - "1.key" - E.RecordFieldAccess.notRecord - (2, [ RT.LoadVal(0, RT.DInt64 1L); RT.GetRecordField(1, 0, "key") ], 1) - - let missingField = - t - "(Test.Test { key = true }).missing" - E.RecordFieldAccess.missingField - (3, - [ RT.LoadVal(1, RT.DBool true) - RT.CreateRecord( - 0, - RT.FQTypeName.fqPackage PM.Types.Records.singleField, - [], - [ ("key", 1) ] - ) - RT.GetRecordField(2, 0, "missing") ], - 2) - - let nested = - t - "(Test.Test2 { outer = Test.Test { key = true } }).outer.key" - E.RecordFieldAccess.nested - (5, - [ RT.LoadVal(2, RT.DBool true) - RT.CreateRecord( - 1, - RT.FQTypeName.fqPackage PM.Types.Records.singleField, - [], - [ ("key", 2) ] - ) - - RT.CreateRecord( - 0, - RT.FQTypeName.fqPackage PM.Types.Records.nested, - [], - [ ("outer", 1) ] - ) - RT.GetRecordField(3, 0, "outer") - RT.GetRecordField(4, 3, "key") ], - 4) + let tests = testList "PackageFn" [] - let tests = - testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] - - -module RecordUpdate = - // TODO - - let tests = testList "RecordUpdate" [] - - -module Lambda = - let identityUnapplied = - t - "fn x -> x" - E.Lambdas.identityUnapplied - (1, - [ RT.CreateLambda( - 0, - { exprId = E.Lambdas.identityID - patterns = NEList.ofList (RT.LPVariable "x") [] - symbolsToClose = [] |> Set.ofList - instructions = - { registerCount = 1 - instructions = [ RT.GetVar(0, "x") ] - resultIn = 0 } } - ) ], - 0) - - let identityApplied = - t - "(fn x -> x) 1" - E.Lambdas.identityApplied - (3, - [ RT.CreateLambda( - 0, - { exprId = E.Lambdas.identityID - patterns = NEList.ofList (RT.LPVariable "x") [] - symbolsToClose = [] |> Set.ofList - instructions = - { registerCount = 1 - instructions = [ RT.GetVar(0, "x") ] - resultIn = 0 } } - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.Apply(2, 0, [], NEList.ofList 1 []) ], - 2) - - let tests = testList "Lambda" [ identityUnapplied; identityApplied ] - - -let tests = - testList - "PT2RT" - [ Basic.tests - Let.tests - List.tests - String.tests - Dict.tests - If.tests - Tuples.tests - Match.tests - Records.tests - RecordFieldAccess.tests - RecordUpdate.tests - Lambda.tests ] +let tests = testList "ProgramTypesToRuntimeTypes" [ Expr.tests; PackageFn.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 975860f243..7dd4dcf15f 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -116,11 +116,11 @@ module Expressions = module String = let simple = eStr [ strText "hello" ] - let withInterpolation = - eLet - (lpVar "x") - (eStr [ strText ", world" ]) - (eStr [ strText "hello"; strInterp (eVar "x") ]) + // let withInterpolation = + // eLet + // (lpVar "x") + // (eStr [ strText ", world" ]) + // (eStr [ strText "hello"; strInterp (eVar "x") ]) module Dict = @@ -129,10 +129,10 @@ module Expressions = let multEntries = eDict [ "t", eBool true; "f", eBool false ] let dupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] - module If = - let gotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) - let gotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) - let elseMissing = eIf (eBool false) (eInt64 1) None + // module If = + // let gotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) + // let gotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) + // let elseMissing = eIf (eBool false) (eInt64 1) None module Tuples = @@ -150,106 +150,108 @@ module Expressions = [ eTuple (eBool true) (eBool false) [] ] - module Match = - /// match true with - /// | false -> "first branch" - /// | true -> "second branch" - let simple = - eMatch - (eBool true) - [ { pat = PT.MPBool(gid (), false) - whenCondition = None - rhs = eStr [ strText "first branch" ] } - { pat = PT.MPBool(gid (), true) - whenCondition = None - rhs = eStr [ strText "second branch" ] } ] - - /// match true with - /// | false -> "first branch" - let notMatched = - eMatch - (eBool true) - [ { pat = PT.MPBool(gid (), false) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - - /// match true with - /// | x -> x - let withVar = - eMatch - (eBool true) - [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] - - // /// match 4 with - // /// | 1 -> "first branch" - // /// | x when x % 2 == 0 -> "second branch" - // let withVarAndWhenCondition = - // eMatch - // (eInt64 4) - // [ { pat = PT.MPInt64(gid (), 1) - // whenCondition = None - // rhs = eStr [ strText "first branch" ] } - // { pat = PT.MPVariable(gid (), "x") - // // "is even" - // whenCondition = - // Some( - // eApply - // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) - // [] - // [ eApply - // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) - // [] - // [ eVar "x" ] - // eInt64 2 ] - // ) - // rhs = eStr [ strText "second branch" ] } ] - - let list = - eMatch - (eList [ eInt64 1; eInt64 2 ]) - [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - - let listCons = - eMatch - (eList [ eInt64 1; eInt64 2 ]) - [ { pat = - PT.MPListCons( - gid (), - PT.MPInt64(gid (), 1), - PT.MPVariable(gid (), "tail") - ) - whenCondition = None - rhs = eVar "tail" } ] - - let tuple = - eMatch - (eTuple (eInt64 1) (eInt64 2) []) - [ { pat = - PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) - whenCondition = None - rhs = eStr [ strText "first branch" ] } ] - - - module Records = - let simple = - eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] - - let nested = eRecord (typeNamePkg PM.Types.Records.nested) [] [ "outer", simple ] - - module RecordFieldAccess = - let simple = eFieldAccess Records.simple "key" - let notRecord = eFieldAccess (eInt64 1) "key" - let missingField = eFieldAccess Records.simple "missing" - let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" - - - //module RecordUpdate = - - module Lambdas = - let identityID = gid () - - let identityUnapplied = eLambda identityID [ lpVar "x" ] (eVar "x") - - let identityApplied = eApply identityUnapplied [] [ eInt64 1 ] + // module Match = + // /// match true with + // /// | false -> "first branch" + // /// | true -> "second branch" + // let simple = + // eMatch + // (eBool true) + // [ { pat = PT.MPBool(gid (), false) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } + // { pat = PT.MPBool(gid (), true) + // whenCondition = None + // rhs = eStr [ strText "second branch" ] } ] + + // /// match true with + // /// | false -> "first branch" + // let notMatched = + // eMatch + // (eBool true) + // [ { pat = PT.MPBool(gid (), false) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } ] + + // /// match true with + // /// | x -> x + // let withVar = + // eMatch + // (eBool true) + // [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] + + // // /// match 4 with + // // /// | 1 -> "first branch" + // // /// | x when x % 2 == 0 -> "second branch" + // // let withVarAndWhenCondition = + // // eMatch + // // (eInt64 4) + // // [ { pat = PT.MPInt64(gid (), 1) + // // whenCondition = None + // // rhs = eStr [ strText "first branch" ] } + // // { pat = PT.MPVariable(gid (), "x") + // // // "is even" + // // whenCondition = + // // Some( + // // eApply + // // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + // // [] + // // [ eApply + // // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + // // [] + // // [ eVar "x" ] + // // eInt64 2 ] + // // ) + // // rhs = eStr [ strText "second branch" ] } ] + + // let list = + // eMatch + // (eList [ eInt64 1; eInt64 2 ]) + // [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } ] + + // let listCons = + // eMatch + // (eList [ eInt64 1; eInt64 2 ]) + // [ { pat = + // PT.MPListCons( + // gid (), + // PT.MPInt64(gid (), 1), + // PT.MPVariable(gid (), "tail") + // ) + // whenCondition = None + // rhs = eVar "tail" } ] + + // let tuple = + // eMatch + // (eTuple (eInt64 1) (eInt64 2) []) + // [ { pat = + // PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } ] + + + // module Records = + // let simple = + // eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] + + // let nested = eRecord (typeNamePkg PM.Types.Records.nested) [] [ "outer", simple ] + + // module RecordFieldAccess = + // let simple = eFieldAccess Records.simple "key" + // let notRecord = eFieldAccess (eInt64 1) "key" + // let missingField = eFieldAccess Records.simple "missing" + // let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" + + + // //module RecordUpdate = + + // module Lambdas = + // let identityID = gid () + + // let identityUnapplied = eLambda identityID [ lpVar "x" ] (eVar "x") + + // let identityApplied = eApply identityUnapplied [] [ eInt64 1 ] + + let stayIndented = true diff --git a/packages/darklang/languageTools/runtimeTypes.dark b/packages/darklang/languageTools/runtimeTypes.dark index f4da64bccf..74fa978f74 100644 --- a/packages/darklang/languageTools/runtimeTypes.dark +++ b/packages/darklang/languageTools/runtimeTypes.dark @@ -57,44 +57,6 @@ module Darklang = typeArgs: List | TDict of TypeReference - type Expr = - | EInt64 of ID * Int64 - | EUInt64 of ID * UInt64 - | EInt8 of ID * Int8 - | EUInt8 of ID * UInt8 - | EInt16 of ID * Int16 - | EUInt16 of ID * UInt16 - | EInt32 of ID * Int32 - | EUInt32 of ID * UInt32 - | EInt128 of ID * Int128 - | EUInt128 of ID * UInt128 - | EBool of ID * Bool - | EString of ID * List - | EChar of ID * String - | EFloat of ID * Float - | EUnit of ID - | EConstant of ID * FQConstantName.FQConstantName - | ELet of ID * LetPattern * Expr * Expr - | EIf of - ID * - cond: Expr * - thenExpr: Expr * - elseExpr: Stdlib.Option.Option - | ELambda of ID * List * Expr - | ERecordFieldAccess of ID * Expr * String - | EVariable of ID * String - | EApply of ID * Expr * typeArgs: List * args: List - | EFnName of ID * FQFnName.FQFnName - | EList of ID * List - | ETuple of ID * Expr * Expr * List - | ERecord of ID * FQTypeName.FQTypeName * List - | ERecordUpdate of ID * record: Expr * updates: List - | EDict of ID * List - | EEnum of ID * FQTypeName.FQTypeName * caseName: String * fields: List - | EMatch of ID * Expr * List - | EAnd of ID * Expr * Expr - | EOr of ID * Expr * Expr - | EError of ID * RuntimeError * List type MatchCase = { pat: MatchPattern From b5d1ca433bde1d001f99fd1c261a85dc9ae8e795 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 12 Sep 2024 14:30:38 -0400 Subject: [PATCH 21/60] uncomment more, since symtable removal --- backend/src/LibExecution/Interpreter.fs | 126 ++-- backend/src/LibExecution/ProgramTypes.fs | 115 ++-- backend/src/LibExecution/ProgramTypesAst.fs | 52 +- .../ProgramTypesToRuntimeTypes.fs | 624 +++++++++--------- backend/src/LibExecution/RuntimeTypes.fs | 65 +- backend/tests/TestUtils/PTShortcuts.fs | 20 +- backend/tests/Tests/Interpreter.Tests.fs | 127 ++-- backend/tests/Tests/PT2RT.Tests.fs | 383 +++++------ backend/tests/Tests/TestValues.fs | 36 +- 9 files changed, 765 insertions(+), 783 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index cf72fea933..972256873f 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -113,18 +113,18 @@ let rec checkAndExtractMatchPattern /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec private execute (_exeState : ExecutionState) (vm : VMState) : Ply = +let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = uply { - let callFrame = Map.findUnsafe vm.currentFrame vm.callFrames + let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames - let mutable counter = callFrame.pc // what instruction (by index) we're on - let registers = callFrame.registers + let mutable counter = currentFrame.pc // what instruction (by index) we're on + let registers = currentFrame.registers let raiseRTE rte = raiseRTE vm.threadID rte - while counter < callFrame.instructions.Length do + while counter < currentFrame.instructions.Length do - match callFrame.instructions[counter] with + match currentFrame.instructions[counter] with // == Simple register operations == | LoadVal(reg, value) -> @@ -177,17 +177,17 @@ let rec private execute (_exeState : ExecutionState) (vm : VMState) : Ply counter <- counter + 1 - // // == Flow Control == - // // -- Jumps -- - // | JumpBy jumpBy -> counter <- counter + jumpBy + 1 + // == Flow Control == + // -- Jumps -- + | JumpBy jumpBy -> counter <- counter + jumpBy + 1 - // | JumpByIfFalse(jumpBy, condReg) -> - // match vm.registers[condReg] with - // | DBool false -> counter <- counter + jumpBy + 1 - // | DBool true -> counter <- counter + 1 - // | dv -> - // let vt = Dval.toValueType dv - // raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) + | JumpByIfFalse(jumpBy, condReg) -> + match registers[condReg] with + | DBool false -> counter <- counter + jumpBy + 1 + | DBool true -> counter <- counter + 1 + | dv -> + let vt = Dval.toValueType dv + raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) // // -- Match -- // | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> @@ -232,59 +232,59 @@ let rec private execute (_exeState : ExecutionState) (vm : VMState) : Ply counter <- counter + 1 - // // == Working with Custom Data == - // // -- Records -- - // | CreateRecord(recordReg, typeName, typeArgs, fields) -> - // let fields = - // fields |> List.map (fun (name, valueReg) -> (name, vm.registers[valueReg])) + // == Working with Custom Data == + // -- Records -- + | CreateRecord(recordReg, typeName, typeArgs, fields) -> + let fields = + fields |> List.map (fun (name, valueReg) -> (name, registers[valueReg])) - // let! record = + let! record = + TypeChecker.DvalCreator.record + vm.threadID + exeState.types + typeName + typeArgs + fields + + registers[recordReg] <- record + counter <- counter + 1 + + // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> + // let originalRecord = vm.registers[originalRecordReg] + // let updates = + // updates + // |> List.map (fun (fieldName, valueReg) -> + // (fieldName, vm.registers[valueReg])) + // let updatedRecord = // TypeChecker.DvalCreator.record - // vm.callStack - // exeState.types + // exeState.tracing.callStack // typeName // typeArgs - // fields + // updates - // vm.registers[recordReg] <- record + // vm.registers[targetReg] <- updatedRecord // counter <- counter + 1 - // // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> - // // let originalRecord = vm.registers[originalRecordReg] - // // let updates = - // // updates - // // |> List.map (fun (fieldName, valueReg) -> - // // (fieldName, vm.registers[valueReg])) - // // let updatedRecord = - // // TypeChecker.DvalCreator.record - // // exeState.tracing.callStack - // // typeName - // // typeArgs - // // updates - - // // vm.registers[targetReg] <- updatedRecord - // // counter <- counter + 1 - - // | GetRecordField(targetReg, recordReg, fieldName) -> - // match vm.registers[recordReg] with - // | DRecord(_, _, _, fields) -> - // match Map.find fieldName fields with - // | Some value -> - // vm.registers[targetReg] <- value - // counter <- counter + 1 - // | None -> - // RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE - // | dv -> - // RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) - // |> RTE.Record - // |> raiseRTE - - // // -- Enums -- - // | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> - // // TODO: safe dval creation - // let fields = fields |> List.map (fun (valueReg) -> vm.registers[valueReg]) - // vm.registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) - // counter <- counter + 1 + | GetRecordField(targetReg, recordReg, fieldName) -> + match registers[recordReg] with + | DRecord(_, _, _, fields) -> + match Map.find fieldName fields with + | Some value -> + registers[targetReg] <- value + counter <- counter + 1 + | None -> + RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE + | dv -> + RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) + |> RTE.Record + |> raiseRTE + + // -- Enums -- + | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> + // TODO: safe dval creation + let fields = fields |> List.map (fun (valueReg) -> registers[valueReg]) + registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) + counter <- counter + 1 // | CreateLambda(lambdaReg, impl) -> // vm.lambdas <- Map.add impl.exprId impl vm.lambdas @@ -334,7 +334,7 @@ let rec private execute (_exeState : ExecutionState) (vm : VMState) : Ply // If we've reached the end of the instructions, return the result - return callFrame.registers[callFrame.resultReg] + return registers[currentFrame.resultReg] } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 8d1c478201..6dcd7c2675 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -129,7 +129,7 @@ type LetPattern = // /// `let _ignored = 1` // | LPIgnored - /// let (x) = 1 + // /// let (x) = 1 //| LPParens of inner : LetPattern /// `let (x, _) = (1, 2)` @@ -255,6 +255,7 @@ type TypeReference = //| TDB of TypeReference // A named variable, eg `a` in `List`, matches anything + /// Expressions - the main part of the language. type Expr = // -- Simple exprs -- @@ -283,9 +284,9 @@ type Expr = | EString of id * List - // // -- Flow control -- - // /// `if cond then thenExpr else elseExpr` - // | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option + // -- Flow control -- + /// `if cond then thenExpr else elseExpr` + | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List @@ -322,61 +323,61 @@ type Expr = | EDict of id * List | ETuple of id * Expr * Expr * List -// // // -- "Applying" args to things, such as fns and lambdas -- -// /// This is a function call, the first expression is the value of the function. -// /// - `expr (args[0])` -// /// - `expr (args[0]) (args[1])` -// /// - `expr (args[0])` -// | EApply of id * expr : Expr * typeArgs : List * args : NEList + // // // -- "Applying" args to things, such as fns and lambdas -- + // /// This is a function call, the first expression is the value of the function. + // /// - `expr (args[0])` + // /// - `expr (args[0]) (args[1])` + // /// - `expr (args[0])` + // | EApply of id * expr : Expr * typeArgs : List * args : NEList -// /// Reference a function name, _usually_ so we can _apply_ it with args -// | EFnName of id * NameResolution + // /// Reference a function name, _usually_ so we can _apply_ it with args + // | EFnName of id * NameResolution -// // Composed of a parameters * the expression itself -// // The id in the varname list is the analysis id, used to get a livevalue -// // from the analysis engine -// | ELambda of id * pats : NEList * body : Expr + // // Composed of a parameters * the expression itself + // // The id in the varname list is the analysis id, used to get a livevalue + // // from the analysis engine + // | ELambda of id * pats : NEList * body : Expr -// /// Calls upon an infix function -// | EInfix of id * Infix * lhs : Expr * rhs : Expr + // /// Calls upon an infix function + // | EInfix of id * Infix * lhs : Expr * rhs : Expr -// -- References to custom types and data -- + // -- References to custom types and data -- -// /// Construct a record -// /// `SomeRecord { field1: value; field2: value }` -// | ERecord of -// id * -// // TODO: this reference should be by-hash -// typeName : NameResolution * -// typeArgs : List * -// // User is allowed type `Name {}` even if that's an error -// fields : List - -// /// Access a field of some record (e.g. `someExpr.fieldName`) -// | ERecordFieldAccess of id * record : Expr * fieldName : string - -// /// Clone a record, and update some of its values -// /// `{ r with key = value }` -// | ERecordUpdate of id * record : Expr * updates : NEList - - -// // Enums include `Some`, `None`, `Error`, `Ok`, as well -// // as user-defined enums. -// // -// /// Given an Enum type of: -// /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` -// /// , this is the expression -// /// `C (1, "title")` -// /// represented as -// /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` -// | EEnum of -// id * -// // TODO: this reference should be by-hash -// typeName : NameResolution * -// typeArgs : List * -// caseName : string * -// fields : List + /// Construct a record + /// `SomeRecord { field1: value; field2: value }` + | ERecord of + id * + // TODO: this reference should be by-hash + typeName : NameResolution * + typeArgs : List * + // User is allowed type `Name {}` even if that's an error + fields : List + + /// Access a field of some record (e.g. `someExpr.fieldName`) + | ERecordFieldAccess of id * record : Expr * fieldName : string + + // /// Clone a record, and update some of its values + // /// `{ r with key = value }` + // | ERecordUpdate of id * record : Expr * updates : NEList + + + // Enums include `Some`, `None`, `Error`, `Ok`, as well + // as user-defined enums. + // + /// Given an Enum type of: + /// `type MyEnum = A | B of int | C of int * (label: string) | D of MyEnum` + /// , this is the expression + /// `C (1, "title")` + /// represented as + /// `EEnum(Some UserType.MyEnum, "C", [EInt64(1), EString("title")]` + | EEnum of + id * + // TODO: this reference should be by-hash + typeName : NameResolution * + typeArgs : List * + caseName : string * + fields : List // | EConstant of // id * @@ -426,20 +427,20 @@ module Expr = | EFloat(id, _, _, _) // | EConstant(id, _) | ELet(id, _, _, _) - // | EIf(id, _, _, _) + | EIf(id, _, _, _) //| EInfix(id, _, _, _) // | ELambda(id, _, _) // | EFnName(id, _) - // | ERecordFieldAccess(id, _, _) | EVariable(id, _) // | EApply(id, _, _, _) | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) // | EPipe(id, _, _) - // | ERecord(id, _, _, _) + | ERecord(id, _, _, _) // | ERecordUpdate(id, _, _) - // | EEnum(id, _, _, _, _) + | ERecordFieldAccess(id, _, _) + | EEnum(id, _, _, _, _) // | EMatch(id, _, _) -> id diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 32c05ac9be..8394d47d5c 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -50,32 +50,32 @@ let rec symbolsUsedIn (expr : Expr) : Set = | ELet(_, _, rhs, next) -> Set.union (r rhs) (r next) -// // flow control -// | EIf(_, condExpr, ifExpr, elseExprMaybe) -> -// match elseExprMaybe with -// | None -> Set.union (r condExpr) (r ifExpr) -// | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] - -// | EMatch(_, target, cases) -> -// let targetVars = r target -// let whenVars = -// cases -// |> List.map (fun c -> -// match c.whenCondition with -// | None -> Set.empty -// | Some w -> r w) -// |> Set.unionMany -// let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany -// Set.unionMany [ targetVars; whenVars; rhsVars ] - - -// // custom data -// | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany - -// | ERecord(_, _, _, fields) -> -// fields |> List.map (fun (_, e) -> r e) |> Set.unionMany - -// | ERecordFieldAccess(_, expr, _) -> r expr + // flow control + | EIf(_, condExpr, ifExpr, elseExprMaybe) -> + match elseExprMaybe with + | None -> Set.union (r condExpr) (r ifExpr) + | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] + + // | EMatch(_, target, cases) -> + // let targetVars = r target + // let whenVars = + // cases + // |> List.map (fun c -> + // match c.whenCondition with + // | None -> Set.empty + // | Some w -> r w) + // |> Set.unionMany + // let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany + // Set.unionMany [ targetVars; whenVars; rhsVars ] + + + // custom data + | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany + + | ERecord(_, _, _, fields) -> + fields |> List.map (fun (_, e) -> r e) |> Set.unionMany + + | ERecordFieldAccess(_, expr, _) -> r expr // // things that can be applied // | EFnName(_, _) -> Set.empty diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index d5e86d224e..ab9233d4e2 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -156,37 +156,37 @@ module TypeReference = module LetPattern = let rec toRT - (rc : int) (symbols : Map) + (rc : int) (p : PT.LetPattern) - : (RT.LetPattern * int * Map) = + : (RT.LetPattern * Map * int) = match p with - | PT.LPUnit _ -> RT.LPUnit, rc, Map.empty + | PT.LPUnit _ -> RT.LPUnit, Map.empty, rc | PT.LPTuple(_, first, second, theRest) -> - let first, rc, symbols = toRT rc symbols first - let second, rc, symbols = toRT rc symbols second - let (rc, symbols, theRest) = + let first, symbols, rc = toRT symbols rc first + let second, symbols, rc = toRT symbols rc second + let (symbols, rc, theRest) = theRest |> List.fold - (fun (rc, symbols, pats) pat -> - let pat, rc, symbols = toRT rc symbols pat - (rc, symbols, pats @ [ pat ])) - (rc, symbols, []) + (fun (symbols, rc, pats) pat -> + let pat, symbols, rc = toRT symbols rc pat + (symbols, rc, pats @ [ pat ])) + (symbols, rc, []) - RT.LPTuple(first, second, theRest), rc, symbols + RT.LPTuple(first, second, theRest), symbols, rc | PT.LPVariable(_, name) -> // "add a symbol" from name to rc - RT.LPVariable rc, rc + 1, (symbols |> Map.add name rc) + RT.LPVariable rc, (symbols |> Map.add name rc), rc + 1 let toInstr (valueReg : RT.Register) - (rc) + (rc : int) (p : PT.LetPattern) - : (RT.Instruction * int * Map) = - let (pat, rcAfterPat, symbols) = toRT rc Map.empty p + : (RT.Instruction * Map * int) = + let (pat, rcAfterPat, symbols) = toRT Map.empty rc p RT.CheckLetPatternAndExtractVars(valueReg, pat), rcAfterPat, symbols @@ -400,7 +400,7 @@ module Expr = // let x = 1 | PT.ELet(_id, pat, expr, body) -> let exprInstrs = toRT symbols rc expr - let patInstr, rcAfterPat, newSymbols = + let patInstr, newSymbols, rcAfterPat = LetPattern.toInstr exprInstrs.resultIn exprInstrs.registerCount pat let symbols = Map.mergeFavoringRight symbols newSymbols let bodyInstrs = toRT symbols rcAfterPat body @@ -422,311 +422,299 @@ module Expr = rc } -// | PT.EIf(_id, cond, thenExpr, elseExpr) -> -// // We need a consistent result register, -// // so we'll create this, and copy to it at the end of each branch -// let resultReg, rc = rc, rc + 1 - -// let cond = toRT rc cond -// let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, cond.resultIn) ] - -// let thenInstrs = toRT cond.registerCount thenExpr -// let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenInstrs.resultIn) ] - -// match elseExpr with -// | None -> -// let instrs = -// [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit -// @ cond.instructions -// @ jumpIfCondFalse ( -// // goto the first instruction past the `if` -// // (the 1 is for the copy instruction) -// List.length thenInstrs.instructions + 1 -// ) -// @ thenInstrs.instructions -// @ copyThenToResultInstr - -// { registerCount = thenInstrs.registerCount -// instructions = instrs -// resultIn = resultReg } - -// | Some elseExpr -> -// let elseInstrs = toRT thenInstrs.registerCount elseExpr -// let copyToResultInstr = [ RT.CopyVal(resultReg, elseInstrs.resultIn) ] - -// let instrs = -// // cond -- if cond `false`, jump to start of 'else' block -// cond.instructions -// @ jumpIfCondFalse ( -// // goto the first instruction past the `if` -// // (first 1 is for the copy instruction) -// // (second 1 is for the jump instruction) -// List.length thenInstrs.instructions + 1 + 1 -// ) - -// // then -// @ thenInstrs.instructions -// @ copyThenToResultInstr -// @ [ RT.JumpBy(List.length elseInstrs.instructions + 1) ] - -// // else -// @ elseInstrs.instructions -// @ copyToResultInstr - -// { registerCount = elseInstrs.registerCount -// instructions = instrs -// resultIn = resultReg } - - -// | PT.EFnName(_, Ok name) -> -// let namedFn : RT.ApplicableNamedFn = -// { name = FQFnName.toRT name; argsSoFar = [] } -// let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) -// { registerCount = rc + 1 -// instructions = [ RT.LoadVal(rc, applicable) ] -// resultIn = rc } + | PT.EIf(_id, cond, thenExpr, elseExpr) -> + // We need a consistent result register, + // so we'll create this, and copy to it at the end of each branch + let resultReg, rc = rc, rc + 1 -// | PT.EFnName(_, Error nre) -> -// // TODO improve -// // hmm maybe we shouldn't fail yet here. -// // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. -// // maybe the 'value' here is (still) some unresolved name? -// // (which should fail when we apply it) -// { registerCount = rc -// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] -// resultIn = rc } + let cond = toRT symbols rc cond + let jumpIfCondFalse jumpBy = [ RT.JumpByIfFalse(jumpBy, cond.resultIn) ] + + let thenInstrs = toRT symbols cond.registerCount thenExpr + let copyThenToResultInstr = [ RT.CopyVal(resultReg, thenInstrs.resultIn) ] + + match elseExpr with + | None -> + let instrs = + [ RT.LoadVal(resultReg, RT.DUnit) ] // if `cond` is `false`, the (default) result should probably be Unit + @ cond.instructions + @ jumpIfCondFalse ( + // goto the first instruction past the `if` + // (the 1 is for the copy instruction) + List.length thenInstrs.instructions + 1 + ) + @ thenInstrs.instructions + @ copyThenToResultInstr + + { registerCount = thenInstrs.registerCount + instructions = instrs + resultIn = resultReg } + + | Some elseExpr -> + let elseInstrs = toRT symbols thenInstrs.registerCount elseExpr + let copyToResultInstr = [ RT.CopyVal(resultReg, elseInstrs.resultIn) ] + + let instrs = + // cond -- if cond `false`, jump to start of 'else' block + cond.instructions + @ jumpIfCondFalse ( + // goto the first instruction past the `if` + // (first 1 is for the copy instruction) + // (second 1 is for the jump instruction) + List.length thenInstrs.instructions + 1 + 1 + ) + + // then + @ thenInstrs.instructions + @ copyThenToResultInstr + @ [ RT.JumpBy(List.length elseInstrs.instructions + 1) ] + + // else + @ elseInstrs.instructions + @ copyToResultInstr + + { registerCount = elseInstrs.registerCount + instructions = instrs + resultIn = resultReg } + + + // | PT.EFnName(_, Ok name) -> + // let namedFn : RT.ApplicableNamedFn = + // { name = FQFnName.toRT name; argsSoFar = [] } + // let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) + // { registerCount = rc + 1 + // instructions = [ RT.LoadVal(rc, applicable) ] + // resultIn = rc } + + // | PT.EFnName(_, Error nre) -> + // // TODO improve + // // hmm maybe we shouldn't fail yet here. + // // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. + // // maybe the 'value' here is (still) some unresolved name? + // // (which should fail when we apply it) + // { registerCount = rc + // instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + // resultIn = rc } + + + // | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> + // let thingToApply = toRT rc thingToApplyExpr + // // TODO: maybe one or both of these lists should be an `NEList`? + + // // CLEANUP find a way to get rid of silly NEList stuff + // let (regCounter, argInstrs, argRegs) = + // let init = (thingToApply.registerCount, [], []) + + // args + // |> NEList.fold + // (fun (rc, instrs, argResultRegs) arg -> + // let newInstrs = toRT rc arg + // (newInstrs.registerCount, + // instrs @ newInstrs.instructions, + // argResultRegs @ [ newInstrs.resultIn ])) + // init + + // let putResultIn = regCounter + // let callInstr = + // RT.Apply( + // putResultIn, + // thingToApply.resultIn, + // List.map TypeReference.toRT typeArgs, + // NEList.ofListUnsafe "" [] argRegs + // ) + + // { registerCount = regCounter + 1 + // instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] + // resultIn = putResultIn } + + + // | PT.EMatch(_id, expr, cases) -> + // // first, the easy part - compile the expression we're `match`ing against. + // let expr = toRT rc expr + + // // Shortly, we'll compile each of the cases. + // // We'll use this `resultReg` to store the final result of the match + // // , so we have a consistent place to look for it. + // // (similar to how we handle `EIf` -- refer to that for a simpler example) + // let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 + + // // We compile each `case` in two phases, because some instrs require knowing + // // how many instrs to jump over, which we can't know until we know the basics + // // of all the cases. + // // + // // See `MatchCase.IntermediateValue` for more info. + // let casesAfterFirstPhase : List = + // cases + // |> List.map (fun c -> + // // compile the `when` condition, if it exists, as much as we can + // let rcAfterWhenCond, whenCondInstrs, whenCondJump = + // match c.whenCondition with + // | None -> (rcAfterResult, [], None) + // | Some whenCond -> + // let whenCond = toRT rcAfterResult whenCond + // (whenCond.registerCount, + // whenCond.instructions, + // Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) + + // // compile the `rhs` of the case + // let rhs = toRT rcAfterWhenCond c.rhs + + // // return the intermediate results, as far along as they are + // { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat + // whenCondInstructions = whenCondInstrs + // whenCondJump = whenCondJump + // rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] + // rc = rhs.registerCount }) + + // let countInstrsForCase (c : MatchCase.IntermediateValue) : int = + // 1 // for the `MatchValue` instruction + // + List.length c.whenCondInstructions + // + (match c.whenCondJump with + // | Some _ -> 1 + // | None -> 0) + // + List.length c.rhsInstrs + // + 1 // for the `JumpBy` instruction + + // let (cases, _) : List * int = + // casesAfterFirstPhase + // |> List.map (fun c -> + // let instrCount = countInstrsForCase c + // (c, instrCount)) + // |> List.foldRight + // // CLEANUP this works, but hurts the brain a bit. + // (fun (acc, runningTotal) (c, instrCount) -> + // let newTotal = runningTotal + instrCount + // (acc @ [ c, runningTotal ], newTotal)) + // ([], 0) + // let cases = List.rev cases + + // let caseInstrs = + // cases + // |> List.fold + // (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> + // // note: `instrsAfterThisCaseUntilEndOfMatch` does not include + // // the final MatchUnmatched instruction + + // let caseInstrs = + // [ c.matchValueInstrFn ( + // countInstrsForCase c + // // because we can skip over the MatchValue instr + // - 1 + // ) ] + // @ c.whenCondInstructions + // @ (match c.whenCondJump with + // // jump to next case if the when condition is false + // | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] + // | None -> []) + // @ c.rhsInstrs + // @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] + + // instrs @ caseInstrs) + // [] + + // let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] + + // let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max + + // { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } + + + // -- Records -- + | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> + let returnReg = 0 // TODO - not sure what to do here + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = returnReg } + + | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> + // fields : List + let recordReg, rc = rc, rc + 1 + + // CLEANUP: complain if there are no fields -- or maybe that should happen during interpretation? + // - actually- is there anything _wrong_ with a fieldless record? + let (rcAfterFields, instrs, fields) = + fields + |> List.fold + (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> + let field = toRT symbols rc fieldExpr + (field.registerCount, + instrs @ field.instructions, + fieldRegs @ [ (fieldName, field.resultIn) ])) + (rc, [], []) + + { registerCount = rcAfterFields + instructions = + instrs + @ [ RT.CreateRecord( + recordReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + fields + ) ] + resultIn = recordReg } + + // | PT.ERecordUpdate(_id, expr, updates) -> + // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = + // toRT rc expr + + // let (rcAfterUpdates, updatesInstrs, updates) = + // updates + // |> NEList.fold + // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> + // let (newRc, newInstrs, newReg) = toRT rc fieldExpr + // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) + // (rcAfterOriginalRecord, [], []) + + // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 + // let instrs = + // originalRecordInstrs + // @ updatesInstrs + // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] + + // (rc, instrs, targetReg) + + | PT.ERecordFieldAccess(_id, expr, fieldName) -> + let expr = toRT symbols rc expr + + { registerCount = expr.registerCount + 1 + instructions = + expr.instructions + @ [ RT.GetRecordField(expr.registerCount, expr.resultIn, fieldName) ] + resultIn = expr.registerCount } -// | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> -// let thingToApply = toRT rc thingToApplyExpr -// // TODO: maybe one or both of these lists should be an `NEList`? - -// // CLEANUP find a way to get rid of silly NEList stuff -// let (regCounter, argInstrs, argRegs) = -// let init = (thingToApply.registerCount, [], []) - -// args -// |> NEList.fold -// (fun (rc, instrs, argResultRegs) arg -> -// let newInstrs = toRT rc arg -// (newInstrs.registerCount, -// instrs @ newInstrs.instructions, -// argResultRegs @ [ newInstrs.resultIn ])) -// init - -// let putResultIn = regCounter -// let callInstr = -// RT.Apply( -// putResultIn, -// thingToApply.resultIn, -// List.map TypeReference.toRT typeArgs, -// NEList.ofListUnsafe "" [] argRegs -// ) - -// { registerCount = regCounter + 1 -// instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] -// resultIn = putResultIn } - - -// | PT.EMatch(_id, expr, cases) -> -// // first, the easy part - compile the expression we're `match`ing against. -// let expr = toRT rc expr - -// // Shortly, we'll compile each of the cases. -// // We'll use this `resultReg` to store the final result of the match -// // , so we have a consistent place to look for it. -// // (similar to how we handle `EIf` -- refer to that for a simpler example) -// let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 - -// // We compile each `case` in two phases, because some instrs require knowing -// // how many instrs to jump over, which we can't know until we know the basics -// // of all the cases. -// // -// // See `MatchCase.IntermediateValue` for more info. -// let casesAfterFirstPhase : List = -// cases -// |> List.map (fun c -> -// // compile the `when` condition, if it exists, as much as we can -// let rcAfterWhenCond, whenCondInstrs, whenCondJump = -// match c.whenCondition with -// | None -> (rcAfterResult, [], None) -// | Some whenCond -> -// let whenCond = toRT rcAfterResult whenCond -// (whenCond.registerCount, -// whenCond.instructions, -// Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) - -// // compile the `rhs` of the case -// let rhs = toRT rcAfterWhenCond c.rhs - -// // return the intermediate results, as far along as they are -// { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat -// whenCondInstructions = whenCondInstrs -// whenCondJump = whenCondJump -// rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] -// rc = rhs.registerCount }) - -// let countInstrsForCase (c : MatchCase.IntermediateValue) : int = -// 1 // for the `MatchValue` instruction -// + List.length c.whenCondInstructions -// + (match c.whenCondJump with -// | Some _ -> 1 -// | None -> 0) -// + List.length c.rhsInstrs -// + 1 // for the `JumpBy` instruction - -// let (cases, _) : List * int = -// casesAfterFirstPhase -// |> List.map (fun c -> -// let instrCount = countInstrsForCase c -// (c, instrCount)) -// |> List.foldRight -// // CLEANUP this works, but hurts the brain a bit. -// (fun (acc, runningTotal) (c, instrCount) -> -// let newTotal = runningTotal + instrCount -// (acc @ [ c, runningTotal ], newTotal)) -// ([], 0) -// let cases = List.rev cases - -// let caseInstrs = -// cases -// |> List.fold -// (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> -// // note: `instrsAfterThisCaseUntilEndOfMatch` does not include -// // the final MatchUnmatched instruction - -// let caseInstrs = -// [ c.matchValueInstrFn ( -// countInstrsForCase c -// // because we can skip over the MatchValue instr -// - 1 -// ) ] -// @ c.whenCondInstructions -// @ (match c.whenCondJump with -// // jump to next case if the when condition is false -// | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] -// | None -> []) -// @ c.rhsInstrs -// @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] - -// instrs @ caseInstrs) -// [] - -// let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] - -// let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max - -// { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } - - -// // -- Records -- -// | PT.ERecord(_id, Error nre, _typeArgs, _fields) -> -// let returnReg = 0 // TODO - not sure what to do here -// { registerCount = rc -// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] -// resultIn = returnReg } - -// | PT.ERecord(_id, Ok typeName, typeArgs, fields) -> -// // fields : List -// let recordReg, rc = rc, rc + 1 - -// // CLEANUP: complain if there are no fields -- or maybe that should happen during interpretation? -// // - actually- is there anything _wrong_ with a fieldless record? -// let (rcAfterFields, instrs, fields) = -// fields -// |> List.fold -// (fun (rc, instrs, fieldRegs) (fieldName, fieldExpr) -> -// let field = toRT rc fieldExpr -// (field.registerCount, -// instrs @ field.instructions, -// fieldRegs @ [ (fieldName, field.resultIn) ])) -// (rc, [], []) - - - -// // (rcAfterFields, -// // instrs -// // @ [ RT.CreateRecord( -// // recordReg, -// // FQTypeName.toRT typeName, -// // List.map TypeReference.toRT typeArgs, -// // fields -// // ) ], -// // recordReg) - -// { registerCount = rcAfterFields -// instructions = -// instrs -// @ [ RT.CreateRecord( -// recordReg, -// FQTypeName.toRT typeName, -// List.map TypeReference.toRT typeArgs, -// fields -// ) ] -// resultIn = recordReg } - -// // | PT.ERecordUpdate(_id, expr, updates) -> -// // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = -// // toRT rc expr - -// // let (rcAfterUpdates, updatesInstrs, updates) = -// // updates -// // |> NEList.fold -// // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> -// // let (newRc, newInstrs, newReg) = toRT rc fieldExpr -// // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) -// // (rcAfterOriginalRecord, [], []) - -// // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 -// // let instrs = -// // originalRecordInstrs -// // @ updatesInstrs -// // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] - -// // (rc, instrs, targetReg) - -// | PT.ERecordFieldAccess(_id, expr, fieldName) -> -// let expr = toRT rc expr - -// { registerCount = expr.registerCount + 1 -// instructions = -// expr.instructions -// @ [ RT.GetRecordField(expr.registerCount, expr.resultIn, fieldName) ] -// resultIn = expr.registerCount } - - -// // -- Enums -- -// | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> -// let returnReg = 0 // TODO - not sure what to do here -// { registerCount = rc -// instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] -// resultIn = returnReg } - -// | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> -// // fields : List -// let enumReg, rc = rc, rc + 1 - -// let (rcAfterFields, instrs, fields) = -// fields -// |> List.fold -// (fun (rc, instrs, fieldRegs) fieldExpr -> -// let afterField = toRT rc fieldExpr -// (afterField.registerCount, -// instrs @ afterField.instructions, -// fieldRegs @ [ afterField.resultIn ])) -// (rc, [], []) - -// { registerCount = rcAfterFields -// instructions = -// instrs -// @ [ RT.CreateEnum( -// enumReg, -// FQTypeName.toRT typeName, -// List.map TypeReference.toRT typeArgs, -// caseName, -// fields -// ) ] -// resultIn = enumReg } + // -- Enums -- + | PT.EEnum(_id, Error nre, _caseName, _typeArgs, _fields) -> + let returnReg = 0 // TODO - not sure what to do here + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = returnReg } + + | PT.EEnum(_id, Ok typeName, typeArgs, caseName, fields) -> + // fields : List + let enumReg, rc = rc, rc + 1 + + let (rcAfterFields, instrs, fields) = + fields + |> List.fold + (fun (rc, instrs, fieldRegs) fieldExpr -> + let afterField = toRT symbols rc fieldExpr + (afterField.registerCount, + instrs @ afterField.instructions, + fieldRegs @ [ afterField.resultIn ])) + (rc, [], []) + + { registerCount = rcAfterFields + instructions = + instrs + @ [ RT.CreateEnum( + enumReg, + FQTypeName.toRT typeName, + List.map TypeReference.toRT typeArgs, + caseName, + fields + ) ] + resultIn = enumReg } // | PT.ELambda(id, pats, body) -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 45b4e9d810..5718bf6944 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -340,22 +340,19 @@ type Instruction = /// Errors if the pattern doesn't match the value. | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern - // /// Stores the value of a variable to a register - // | GetVar of loadTo : Register * varName : string - // == Working with Basic Types == | CreateString of createTo : Register * segments : List - // // == Flow Control == + // == Flow Control == - // // -- Jumps -- - // /// Go `n` instructions forward, if the value in the register is `false` - // | JumpByIfFalse of instrsToJump : int * conditionReg : Register + // -- Jumps -- + /// Go `n` instructions forward, if the value in the register is `false` + | JumpByIfFalse of instrsToJump : int * conditionReg : Register - // /// Go `n` instructions forward, unconditionally - // | JumpBy of instrsToJump : int + /// Go `n` instructions forward, unconditionally + | JumpBy of instrsToJump : int // // -- Match -- // /// Check if the value in the noted register the noted pattern, @@ -387,32 +384,32 @@ type Instruction = | CreateDict of createTo : Register * entries : List - // // == Working with Custom Data == - // // -- Records -- - // | CreateRecord of - // createTo : Register * - // typeName : FQTypeName.FQTypeName * - // typeArgs : List * - // fields : List + // == Working with Custom Data == + // -- Records -- + | CreateRecord of + createTo : Register * + typeName : FQTypeName.FQTypeName * + typeArgs : List * + fields : List - // // | CloneRecordWithUpdates of - // // createTo : Register * - // // originalRecordReg : Register * - // // updates : List + // | CloneRecordWithUpdates of + // createTo : Register * + // originalRecordReg : Register * + // updates : List - // | GetRecordField of - // // todo: rename to "lhs"? Look into this. - // targetReg : Register * - // recordReg : Register * - // fieldName : string + | GetRecordField of + // todo: rename to "lhs"? Look into this. + targetReg : Register * + recordReg : Register * + fieldName : string - // // -- Enums -- - // | CreateEnum of - // createTo : Register * - // typeName : FQTypeName.FQTypeName * - // typeArgs : List * - // caseName : string * - // fields : List + // -- Enums -- + | CreateEnum of + createTo : Register * + typeName : FQTypeName.FQTypeName * + typeArgs : List * + caseName : string * + fields : List // // == Working with things that Apply == @@ -1485,7 +1482,7 @@ and CallFrame = and VMState = { callFrames : Map - currentFrame : uuid + currentFrameID : uuid //mutable lambdas : Map @@ -1515,7 +1512,7 @@ and VMState = parent = None } { threadID = System.Guid.NewGuid() - currentFrame = callFrameId + currentFrameID = callFrameId callFrames = Map [ callFrameId, callFrame ] } diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 91af03ab9f..bef90eff44 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -50,21 +50,21 @@ let eLet (pat : LetPattern) (value : Expr) (body : Expr) : Expr = ELet(gid (), pat, value, body) let eVar (name : string) : Expr = EVariable(gid (), name) -// let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = -// EIf(gid (), cond, thenBranch, elseBranch) +let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = + EIf(gid (), cond, thenBranch, elseBranch) // let eMatch (expr : Expr) (cases : List) : Expr = // EMatch(gid (), expr, cases) -// let eRecord -// (typeName : FQTypeName.FQTypeName) -// (typeArgs : List) -// (fields : List) -// : Expr = -// ERecord(gid (), Ok typeName, typeArgs, fields) +let eRecord + (typeName : FQTypeName.FQTypeName) + (typeArgs : List) + (fields : List) + : Expr = + ERecord(gid (), Ok typeName, typeArgs, fields) -// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = -// ERecordFieldAccess(gid (), expr, fieldName) +let eFieldAccess (expr : Expr) (fieldName : string) : Expr = + ERecordFieldAccess(gid (), expr, fieldName) // let eEnum // (typeName : FQTypeName.FQTypeName) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 0c41ddca8b..e87d0e1c18 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -138,18 +138,13 @@ module Let = module String = let simple = t "[\"hello\"]" E.String.simple (RT.DString "hello") - // let withInterpolation = - // t - // "[let x = \"world\" in $\"hello {x}\"]" - // E.String.withInterpolation - // (RT.DString "hello, world") + let withInterpolation = + t + "[let x = \"world\" in $\"hello {x}\"]" + E.String.withInterpolation + (RT.DString "hello, world") - let tests = - testList - "Strings" - [ simple - //withInterpolation - ] + let tests = testList "Strings" [ simple; withInterpolation ] module Dict = @@ -176,12 +171,12 @@ module Dict = let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] -// module If = -// let gotoThenBranch = t "if true then 1 else 2" E.If.gotoThenBranch (RT.DInt64 1L) -// let gotoElseBranch = t "if false then 1 else 2" E.If.gotoElseBranch (RT.DInt64 2L) -// let elseMissing = t "if false then 1" E.If.elseMissing RT.DUnit +module If = + let gotoThenBranch = t "if true then 1 else 2" E.If.gotoThenBranch (RT.DInt64 1L) + let gotoElseBranch = t "if false then 1 else 2" E.If.gotoElseBranch (RT.DInt64 2L) + let elseMissing = t "if false then 1" E.If.elseMissing RT.DUnit -// let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] + let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] module Tuples = @@ -258,61 +253,61 @@ module Tuples = // tuple ] -// module Records = -// let simple = -// let typeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField -// t -// "Test.Test { key = true }" -// E.Records.simple -// (RT.DRecord(typeName, typeName, [], Map [ "key", RT.DBool true ])) +module Records = + let simple = + let typeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField + t + "Test.Test { key = true }" + E.Records.simple + (RT.DRecord(typeName, typeName, [], Map [ "key", RT.DBool true ])) -// let nested = -// let outerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.nested -// let innerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField -// t -// "Test.Test2 { outer = (Test.Test { key = true }) }" -// E.Records.nested -// (RT.DRecord( -// outerTypeName, -// outerTypeName, -// [], -// Map -// [ "outer", -// RT.DRecord( -// innerTypeName, -// innerTypeName, -// [], -// Map [ "key", RT.DBool true ] -// ) ] -// )) + let nested = + let outerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.nested + let innerTypeName = RT.FQTypeName.fqPackage PM.Types.Records.singleField + t + "Test.Test2 { outer = (Test.Test { key = true }) }" + E.Records.nested + (RT.DRecord( + outerTypeName, + outerTypeName, + [], + Map + [ "outer", + RT.DRecord( + innerTypeName, + innerTypeName, + [], + Map [ "key", RT.DBool true ] + ) ] + )) -// let tests = testList "Records" [ simple; nested ] + let tests = testList "Records" [ simple; nested ] -// module RecordFieldAccess = -// let simple = -// t "(Test.Test { key = true }).key" E.RecordFieldAccess.simple (RT.DBool true) -// let notRecord = -// tFail -// "1.key" -// E.RecordFieldAccess.notRecord -// (RTE.Record(RTE.Records.FieldAccessNotRecord VT.int64)) +module RecordFieldAccess = + let simple = + t "(Test.Test { key = true }).key" E.RecordFieldAccess.simple (RT.DBool true) + let notRecord = + tFail + "1.key" + E.RecordFieldAccess.notRecord + (RTE.Record(RTE.Records.FieldAccessNotRecord VT.int64)) -// let missingField = -// tFail -// "(Test.Test { key = true }).missing" -// E.RecordFieldAccess.missingField -// (RTE.Record(RTE.Records.FieldAccessFieldNotFound "missing")) + let missingField = + tFail + "(Test.Test { key = true }).missing" + E.RecordFieldAccess.missingField + (RTE.Record(RTE.Records.FieldAccessFieldNotFound "missing")) -// let nested = -// t -// "(Test.Test2 { outer = (Test.Test { key = true }) }).outer.key" -// E.RecordFieldAccess.nested -// (RT.DBool true) + let nested = + t + "(Test.Test2 { outer = (Test.Test { key = true }) }).outer.key" + E.RecordFieldAccess.nested + (RT.DBool true) -// let tests = -// testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + let tests = + testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] // module Lambdas = @@ -339,10 +334,10 @@ let tests = Let.tests String.tests Dict.tests - // If.tests + If.tests Tuples.tests // Match.tests - // Records.tests - // RecordFieldAccess.tests + Records.tests + RecordFieldAccess.tests // Lambdas.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 174ed6f0c2..a15c068500 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -156,24 +156,18 @@ module Expr = let simple = t "[\"hello\"]" E.String.simple (1, [ RT.LoadVal(0, RT.DString "hello") ], 0) - // let withInterpolation = - // t - // "[let x = \"world\"\n$\"hello {x}\"]" - // E.String.withInterpolation - // (3, - // [ RT.LoadVal(0, RT.DString ", world") - // RT.CheckLetPatternAndExtractVars(0, RT.LPVariable "x") - - // RT.GetVar(1, "x") - // RT.CreateString(2, [ RT.Text "hello"; RT.Interpolated 1 ]) ], - // 2) + let withInterpolation = + t + "[let x = \"world\"\n$\"hello {x}\"]" + E.String.withInterpolation + (3, + [ RT.LoadVal(0, RT.DString ", world") + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) - let tests = - testList - "String" - [ simple - //withInterpolation - ] + RT.CreateString(2, [ RT.Text "hello"; RT.Interpolated 1 ]) ], + 2) + + let tests = testList "String" [ simple; withInterpolation ] module Dict = @@ -209,61 +203,61 @@ module Expr = let tests = testList "Dict" [ empty; simple; multEntries; dupeKey ] - // module If = - // let gotoThenBranch = - // t - // "if true then 1 else 2" - // E.If.gotoThenBranch - // (4, - // [ // reserve register 0 for the result - - // // cond - // RT.LoadVal(1, RT.DBool true) - // RT.JumpByIfFalse(3, 1) - - // // then - // RT.LoadVal(2, RT.DInt64 1L) - // RT.CopyVal(0, 2) - // RT.JumpBy 2 - - // // else - // RT.LoadVal(3, RT.DInt64 2L) - // RT.CopyVal(0, 3) ], - // 0) + module If = + let gotoThenBranch = + t + "if true then 1 else 2" + E.If.gotoThenBranch + (4, + [ // reserve register 0 for the result + // cond + RT.LoadVal(1, RT.DBool true) + RT.JumpByIfFalse(3, 1) - // let gotoElseBranch = - // t - // "if false then 1 else 2" - // E.If.gotoElseBranch - // (4, - // [ // cond - // RT.LoadVal(1, RT.DBool false) - // RT.JumpByIfFalse(3, 1) - - // // then - // RT.LoadVal(2, RT.DInt64 1L) - // RT.CopyVal(0, 2) - // RT.JumpBy 2 - - // // else - // RT.LoadVal(3, RT.DInt64 2L) - // RT.CopyVal(0, 3) ], - // 0) + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 - // let elseMissing = - // t - // "if false then 1" - // E.If.elseMissing - // (3, - // [ RT.LoadVal(0, RT.DUnit) - // RT.LoadVal(1, RT.DBool false) - // RT.JumpByIfFalse(2, 1) - // RT.LoadVal(2, RT.DInt64 1L) - // RT.CopyVal(0, 2) ], - // 0) + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) - // let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] + + let gotoElseBranch = + t + "if false then 1 else 2" + E.If.gotoElseBranch + (4, + [ // cond + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(3, 1) + + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 + + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) + + let elseMissing = + t + "if false then 1" + E.If.elseMissing + (3, + [ RT.LoadVal(0, RT.DUnit) + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(2, 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) ], + 0) + + let tests = testList "If" [ gotoThenBranch; gotoElseBranch; elseMissing ] module Tuples = @@ -494,111 +488,113 @@ module Expr = // tuple ] - // module Records = - // let simple = - // t - // "Test.Test { key = true }" - // E.Records.simple - // (2, - // [ RT.LoadVal(1, RT.DBool true) - // RT.CreateRecord( - // 0, - // RT.FQTypeName.fqPackage PM.Types.Records.singleField, - // [], - // [ ("key", 1) ] - // ) ], - // 0) - - // let nested = - // t - // "Test.Test2 { outer = (Test.Test { key = true }) }" - // E.Records.nested - // (3, - // [ RT.LoadVal(2, RT.DBool true) - - // // inner record - // RT.CreateRecord( - // 1, - // RT.FQTypeName.fqPackage PM.Types.Records.singleField, - // [], - // [ ("key", 2) ] - // ) + // TODO: add tests for Enums - // // outer record - // RT.CreateRecord( - // 0, - // RT.FQTypeName.fqPackage PM.Types.Records.nested, - // [], - // [ ("outer", 1) ] - // ) ], - // 0) - - // let tests = testList "Records" [ simple; nested ] + module Records = + let simple = + t + "Test.Test { key = true }" + E.Records.simple + (2, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) ], + 0) + let nested = + t + "Test.Test2 { outer = (Test.Test { key = true }) }" + E.Records.nested + (3, + [ RT.LoadVal(2, RT.DBool true) + + // inner record + RT.CreateRecord( + 1, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 2) ] + ) + + // outer record + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.nested, + [], + [ ("outer", 1) ] + ) ], + 0) - // module RecordFieldAccess = - // let simple = - // t - // "let r = Test.Test { key = true }\nr.key" - // E.RecordFieldAccess.simple - // (3, - // [ RT.LoadVal(1, RT.DBool true) - // RT.CreateRecord( - // 0, - // RT.FQTypeName.fqPackage PM.Types.Records.singleField, - // [], - // [ ("key", 1) ] - // ) - // RT.GetRecordField(2, 0, "key") ], - // 2) + let tests = testList "Records" [ simple; nested ] - // let notRecord = - // t - // "1.key" - // E.RecordFieldAccess.notRecord - // (2, [ RT.LoadVal(0, RT.DInt64 1L); RT.GetRecordField(1, 0, "key") ], 1) - // let missingField = - // t - // "(Test.Test { key = true }).missing" - // E.RecordFieldAccess.missingField - // (3, - // [ RT.LoadVal(1, RT.DBool true) - // RT.CreateRecord( - // 0, - // RT.FQTypeName.fqPackage PM.Types.Records.singleField, - // [], - // [ ("key", 1) ] - // ) - // RT.GetRecordField(2, 0, "missing") ], - // 2) + module RecordFieldAccess = + let simple = + t + "let r = Test.Test { key = true }\nr.key" + E.RecordFieldAccess.simple + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.GetRecordField(2, 0, "key") ], + 2) + + let notRecord = + t + "1.key" + E.RecordFieldAccess.notRecord + (2, [ RT.LoadVal(0, RT.DInt64 1L); RT.GetRecordField(1, 0, "key") ], 1) - // let nested = - // t - // "(Test.Test2 { outer = Test.Test { key = true } }).outer.key" - // E.RecordFieldAccess.nested - // (5, - // [ RT.LoadVal(2, RT.DBool true) - // RT.CreateRecord( - // 1, - // RT.FQTypeName.fqPackage PM.Types.Records.singleField, - // [], - // [ ("key", 2) ] - // ) + let missingField = + t + "(Test.Test { key = true }).missing" + E.RecordFieldAccess.missingField + (3, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.GetRecordField(2, 0, "missing") ], + 2) - // RT.CreateRecord( - // 0, - // RT.FQTypeName.fqPackage PM.Types.Records.nested, - // [], - // [ ("outer", 1) ] - // ) - // RT.GetRecordField(3, 0, "outer") - // RT.GetRecordField(4, 3, "key") ], - // 4) + let nested = + t + "(Test.Test2 { outer = Test.Test { key = true } }).outer.key" + E.RecordFieldAccess.nested + (5, + [ RT.LoadVal(2, RT.DBool true) + RT.CreateRecord( + 1, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 2) ] + ) + + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.nested, + [], + [ ("outer", 1) ] + ) + RT.GetRecordField(3, 0, "outer") + RT.GetRecordField(4, 3, "key") ], + 4) - // let tests = - // testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] + let tests = + testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] // module RecordUpdate = @@ -655,11 +651,11 @@ module Expr = List.tests String.tests Dict.tests - // If.tests + If.tests Tuples.tests // Match.tests - // Records.tests - // RecordFieldAccess.tests + Records.tests + RecordFieldAccess.tests // RecordUpdate.tests // Lambda.tests ] @@ -677,34 +673,39 @@ module PackageFn = description = "TODO" deprecated = PT.NotDeprecated } - let actual = PT2RT.PackageFn.toRT fn - return Expect.equal actual.body expected "" + let actual = PT2RT.PackageFn.toRT fn |> _.body + let actual = (actual.registerCount, actual.instructions, actual.resultIn) + return Expect.equal actual expected "" } - // module Basic = - // let add = - // t - // "add" - // "add" - // [] - // [ { name = "a"; typ = PT.TInt64; description = "TODO" } - // { name = "b"; typ = PT.TInt64; description = "TODO" } ] - // PT.TInt64 - // (eVar "b") - // (4, - // [ RT.LoadVal( - // 0, - // RT.DFnVal( - // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) - // ) - // ) - // RT.LoadVal(1, RT.DInt64 1L) - // RT.LoadVal(2, RT.DInt64 2L) - // RT.Apply(3, 0, [], NEList.ofListUnsafe "" [ 1; 2 ]) ], - // 3) + module Basic = + let returnSecondParam = + t + "returnSecondParam" + "returnSecondParam" + [] + [ { name = "a"; typ = PT.TInt64; description = "TODO" } + { name = "b"; typ = PT.TInt64; description = "TODO" } ] + PT.TInt64 + (eVar "b") + (2, [], 1) + + let ignoresParamsAndReturnsStr = + t + "ignoresParamsAndReturnsStr" + "ignoresParamsAndReturnsStr" + [] + [ { name = "a"; typ = PT.TInt64; description = "TODO" } + { name = "b"; typ = PT.TInt64; description = "TODO" } ] + PT.TInt64 + (eStr [ strText "hello" ]) + (3, [ RT.LoadVal(2, RT.DString "hello") ], 2) + + let tests = + testList "PackageFn" [ returnSecondParam; ignoresParamsAndReturnsStr ] - let tests = testList "PackageFn" [] + let tests = testList "PackageFn" [ Basic.tests ] let tests = testList "ProgramTypesToRuntimeTypes" [ Expr.tests; PackageFn.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 7dd4dcf15f..0cce618ace 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -116,11 +116,11 @@ module Expressions = module String = let simple = eStr [ strText "hello" ] - // let withInterpolation = - // eLet - // (lpVar "x") - // (eStr [ strText ", world" ]) - // (eStr [ strText "hello"; strInterp (eVar "x") ]) + let withInterpolation = + eLet + (lpVar "x") + (eStr [ strText ", world" ]) + (eStr [ strText "hello"; strInterp (eVar "x") ]) module Dict = @@ -129,10 +129,10 @@ module Expressions = let multEntries = eDict [ "t", eBool true; "f", eBool false ] let dupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] - // module If = - // let gotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) - // let gotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) - // let elseMissing = eIf (eBool false) (eInt64 1) None + module If = + let gotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) + let gotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) + let elseMissing = eIf (eBool false) (eInt64 1) None module Tuples = @@ -232,17 +232,17 @@ module Expressions = // rhs = eStr [ strText "first branch" ] } ] - // module Records = - // let simple = - // eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] + module Records = + let simple = + eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] - // let nested = eRecord (typeNamePkg PM.Types.Records.nested) [] [ "outer", simple ] + let nested = eRecord (typeNamePkg PM.Types.Records.nested) [] [ "outer", simple ] - // module RecordFieldAccess = - // let simple = eFieldAccess Records.simple "key" - // let notRecord = eFieldAccess (eInt64 1) "key" - // let missingField = eFieldAccess Records.simple "missing" - // let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" + module RecordFieldAccess = + let simple = eFieldAccess Records.simple "key" + let notRecord = eFieldAccess (eInt64 1) "key" + let missingField = eFieldAccess Records.simple "missing" + let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" // //module RecordUpdate = From 7c92a8bb657f9fadc82da4bce40dd870d2cedaea Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 12 Sep 2024 15:01:53 -0400 Subject: [PATCH 22/60] match works again --- backend/src/LibExecution/Interpreter.fs | 39 +- backend/src/LibExecution/ProgramTypes.fs | 21 +- backend/src/LibExecution/ProgramTypesAst.fs | 23 +- .../ProgramTypesToRuntimeTypes.fs | 297 +++++++++------- backend/src/LibExecution/RuntimeTypes.fs | 30 +- backend/src/Prelude/Prelude.fs | 3 +- backend/tests/TestUtils/PTShortcuts.fs | 4 +- backend/tests/Tests/Interpreter.Tests.fs | 100 +++--- backend/tests/Tests/PT2RT.Tests.fs | 334 +++++++++--------- backend/tests/Tests/TestValues.fs | 160 ++++----- 10 files changed, 515 insertions(+), 496 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 972256873f..5e185560c1 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -46,7 +46,7 @@ let rec checkAndExtractLetPattern let rec checkAndExtractMatchPattern (pat : MatchPattern) (dv : Dval) - : bool * List = + : bool * List = let r = checkAndExtractMatchPattern let rec rList pats items = @@ -63,7 +63,7 @@ let rec checkAndExtractMatchPattern false, [] match pat, dv with - | MPVariable name, dv -> true, [ (name, dv) ] + | MPVariable reg, dv -> true, [ (reg, dv) ] | MPUnit, DUnit -> true, [] | MPBool l, DBool r -> l = r, [] @@ -137,13 +137,6 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = // // == Working with Variables == - // | GetVar(loadTo, varName) -> - // match Map.find varName vm.symbolTable with - // | Some value -> - // vm.registers[loadTo] <- value - // counter <- counter + 1 - // | None -> raiseRTE (RTE.Error.VariableNotFound varName) - | CheckLetPatternAndExtractVars(valueReg, pat) -> let dv = registers[valueReg] let doesMatch, registersToAssign = checkAndExtractLetPattern pat dv @@ -189,21 +182,19 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = let vt = Dval.toValueType dv raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) - // // -- Match -- - // | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> - // let matches, vars = checkAndExtractMatchPattern pat vm.registers[valueReg] - - // if matches then - // vm.symbolTable <- - // List.fold - // (fun symbolTable (varName, value) -> Map.add varName value symbolTable) - // vm.symbolTable - // vars - // counter <- counter + 1 - // else - // counter <- counter + failJump + 1 - - // | MatchUnmatched -> raiseRTE RTE.MatchUnmatched + // -- Match -- + | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> + let doesMatch, registersToAssign = + checkAndExtractMatchPattern pat registers[valueReg] + + if doesMatch then + registersToAssign + |> List.iter (fun (reg, value) -> registers[reg] <- value) + counter <- counter + 1 + else + counter <- counter + failJump + 1 + + | MatchUnmatched -> raiseRTE RTE.MatchUnmatched // == Working with Collections == diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 6dcd7c2675..e54722d26c 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -291,15 +291,15 @@ type Expr = // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List - // /// Supports `match` expressions - // /// ```fsharp - // /// match x + 2 with // arg - // /// | pattern -> expr // cases[0] - // /// | pattern -> expr - // /// | ... - // /// ``` - // // cases is a list to represent when a user starts typing but doesn't complete it - // | EMatch of id * arg : Expr * cases : List + /// Supports `match` expressions + /// ```fsharp + /// match x + 2 with // arg + /// | pattern -> expr // cases[0] + /// | pattern -> expr + /// | ... + /// ``` + // cases is a list to represent when a user starts typing but doesn't complete it + | EMatch of id * arg : Expr * cases : List // // Composed of binding pattern, the expression to create bindings for, @@ -441,8 +441,7 @@ module Expr = // | ERecordUpdate(id, _, _) | ERecordFieldAccess(id, _, _) | EEnum(id, _, _, _, _) - // | EMatch(id, _, _) - -> id + | EMatch(id, _, _) -> id // module PipeExpr = // let toID (expr : PipeExpr) : id = diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 8394d47d5c..d39cd6986b 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -4,6 +4,7 @@ open Prelude open ProgramTypes /// TODO type symbols, too +/// TODO I'm not sure if this is useful any more - wrote this when doing some Lambda work but idk let rec symbolsUsedIn (expr : Expr) : Set = let r = symbolsUsedIn @@ -56,17 +57,17 @@ let rec symbolsUsedIn (expr : Expr) : Set = | None -> Set.union (r condExpr) (r ifExpr) | Some elseExpr -> Set.unionMany [ r condExpr; r ifExpr; r elseExpr ] - // | EMatch(_, target, cases) -> - // let targetVars = r target - // let whenVars = - // cases - // |> List.map (fun c -> - // match c.whenCondition with - // | None -> Set.empty - // | Some w -> r w) - // |> Set.unionMany - // let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany - // Set.unionMany [ targetVars; whenVars; rhsVars ] + | EMatch(_, target, cases) -> + let targetVars = r target + let whenVars = + cases + |> List.map (fun c -> + match c.whenCondition with + | None -> Set.empty + | Some w -> r w) + |> Set.unionMany + let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany + Set.unionMany [ targetVars; whenVars; rhsVars ] // custom data diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index ab9233d4e2..2aba510f29 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -140,20 +140,6 @@ module TypeReference = // | PT.ComparisonNotEquals -> ("notEquals", 0) - -// let tpl = (true, (false, "panda")) -// rc = 17 -// let (a, (b, c)) = tpl -(* - [ ..... - .... - 17: true - 18: false - 19: "panda" - ] -*) - - module LetPattern = let rec toRT (symbols : Map) @@ -177,7 +163,6 @@ module LetPattern = RT.LPTuple(first, second, theRest), symbols, rc | PT.LPVariable(_, name) -> - // "add a symbol" from name to rc RT.LPVariable rc, (symbols |> Map.add name rc), rc + 1 @@ -191,44 +176,84 @@ module LetPattern = -// module MatchPattern = -// let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = -// match p with -// | PT.MPUnit _ -> RT.MPUnit +module MatchPattern = + let rec toRT + (symbols : Map) + (rc : int) + (p : PT.MatchPattern) + : (RT.MatchPattern * Map * int) = + match p with + | PT.MPUnit _ -> RT.MPUnit, symbols, rc + + | PT.MPBool(_, b) -> RT.MPBool b, symbols, rc + + | PT.MPInt8(_, i) -> RT.MPInt8 i, symbols, rc + | PT.MPUInt8(_, i) -> RT.MPUInt8 i, symbols, rc + | PT.MPInt16(_, i) -> RT.MPInt16 i, symbols, rc + | PT.MPUInt16(_, i) -> RT.MPUInt16 i, symbols, rc + | PT.MPInt32(_, i) -> RT.MPInt32 i, symbols, rc + | PT.MPUInt32(_, i) -> RT.MPUInt32 i, symbols, rc + | PT.MPInt64(_, i) -> RT.MPInt64 i, symbols, rc + | PT.MPUInt64(_, i) -> RT.MPUInt64 i, symbols, rc + | PT.MPInt128(_, i) -> RT.MPInt128 i, symbols, rc + | PT.MPUInt128(_, i) -> RT.MPUInt128 i, symbols, rc + + | PT.MPFloat(_, sign, whole, frac) -> + RT.MPFloat(makeFloat sign whole frac), symbols, rc + + | PT.MPChar(_, c) -> RT.MPChar c, symbols, rc + | PT.MPString(_, s) -> RT.MPString s, symbols, rc + + + (* + match [1;2;3] with + | [1; a; b] when a > 3 -> ... + *) + | PT.MPList(_, pats) -> + let pats, symbols, rc = + pats + |> List.fold + (fun (pats, symbols, rc) pat -> + let pat, symbols, rc = toRT symbols rc pat + (pats @ [ pat ], symbols, rc)) + ([], symbols, rc) -// | PT.MPBool(_, b) -> RT.MPBool b + RT.MPList pats, symbols, rc -// | PT.MPInt8(_, i) -> RT.MPInt8 i -// | PT.MPUInt8(_, i) -> RT.MPUInt8 i -// | PT.MPInt16(_, i) -> RT.MPInt16 i -// | PT.MPUInt16(_, i) -> RT.MPUInt16 i -// | PT.MPInt32(_, i) -> RT.MPInt32 i -// | PT.MPUInt32(_, i) -> RT.MPUInt32 i -// | PT.MPInt64(_, i) -> RT.MPInt64 i -// | PT.MPUInt64(_, i) -> RT.MPUInt64 i -// | PT.MPInt128(_, i) -> RT.MPInt128 i -// | PT.MPUInt128(_, i) -> RT.MPUInt128 i -// | PT.MPFloat(_, sign, whole, frac) -> RT.MPFloat(makeFloat sign whole frac) -// | PT.MPChar(_, c) -> RT.MPChar c -// | PT.MPString(_, s) -> RT.MPString s + | PT.MPListCons(_, head, tail) -> + let head, symbols, rc = toRT symbols rc head + let tail, symbols, rc = toRT symbols rc tail + RT.MPListCons(head, tail), symbols, rc -// | PT.MPList(_, pats) -> RT.MPList(List.map toRT pats) -// | PT.MPListCons(_, head, tail) -> RT.MPListCons(toRT head, toRT tail) + | PT.MPTuple(_, first, second, theRest) -> + let first, symbols, rc = toRT symbols rc first + let second, symbols, rc = toRT symbols rc second + let (symbols, rc, theRest) = + theRest + |> List.fold + (fun (symbols, rc, pats) pat -> + let pat, symbols, rc = toRT symbols rc pat + (symbols, rc, pats @ [ pat ])) + (symbols, rc, []) -// | PT.MPTuple(_, first, second, theRest) -> -// RT.MPTuple(toRT first, toRT second, List.map toRT theRest) + RT.MPTuple(first, second, theRest), symbols, rc -// | PT.MPVariable(_, name) -> RT.MPVariable name + | PT.MPVariable(_, name) -> + RT.MPVariable rc, (symbols |> Map.add name rc), rc + 1 -// let toMatchInstr -// (valueReg : RT.Register) -// (p : PT.MatchPattern) -// (jumpByFail : int) -// : RT.Instruction = -// RT.CheckMatchPatternAndExtractVars(valueReg, toRT p, jumpByFail) +// let toMatchInstr +// (valueReg : RT.Register) +// (rc : int) +// (p : PT.MatchPattern) +// (jumpByFail : int) +// : (RT.Instruction * Map * int) = +// let (pat, symbols, rcAfterPat) = toRT Map.empty rc p +// (RT.CheckMatchPatternAndExtractVars(valueReg, pat, jumpByFail), +// symbols, +// rcAfterPat) module MatchCase = @@ -528,95 +553,101 @@ module Expr = // resultIn = putResultIn } - // | PT.EMatch(_id, expr, cases) -> - // // first, the easy part - compile the expression we're `match`ing against. - // let expr = toRT rc expr - - // // Shortly, we'll compile each of the cases. - // // We'll use this `resultReg` to store the final result of the match - // // , so we have a consistent place to look for it. - // // (similar to how we handle `EIf` -- refer to that for a simpler example) - // let resultReg, rcAfterResult = expr.registerCount, expr.registerCount + 1 - - // // We compile each `case` in two phases, because some instrs require knowing - // // how many instrs to jump over, which we can't know until we know the basics - // // of all the cases. - // // - // // See `MatchCase.IntermediateValue` for more info. - // let casesAfterFirstPhase : List = - // cases - // |> List.map (fun c -> - // // compile the `when` condition, if it exists, as much as we can - // let rcAfterWhenCond, whenCondInstrs, whenCondJump = - // match c.whenCondition with - // | None -> (rcAfterResult, [], None) - // | Some whenCond -> - // let whenCond = toRT rcAfterResult whenCond - // (whenCond.registerCount, - // whenCond.instructions, - // Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) - - // // compile the `rhs` of the case - // let rhs = toRT rcAfterWhenCond c.rhs - - // // return the intermediate results, as far along as they are - // { matchValueInstrFn = MatchPattern.toMatchInstr expr.resultIn c.pat - // whenCondInstructions = whenCondInstrs - // whenCondJump = whenCondJump - // rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] - // rc = rhs.registerCount }) - - // let countInstrsForCase (c : MatchCase.IntermediateValue) : int = - // 1 // for the `MatchValue` instruction - // + List.length c.whenCondInstructions - // + (match c.whenCondJump with - // | Some _ -> 1 - // | None -> 0) - // + List.length c.rhsInstrs - // + 1 // for the `JumpBy` instruction - - // let (cases, _) : List * int = - // casesAfterFirstPhase - // |> List.map (fun c -> - // let instrCount = countInstrsForCase c - // (c, instrCount)) - // |> List.foldRight - // // CLEANUP this works, but hurts the brain a bit. - // (fun (acc, runningTotal) (c, instrCount) -> - // let newTotal = runningTotal + instrCount - // (acc @ [ c, runningTotal ], newTotal)) - // ([], 0) - // let cases = List.rev cases - - // let caseInstrs = - // cases - // |> List.fold - // (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> - // // note: `instrsAfterThisCaseUntilEndOfMatch` does not include - // // the final MatchUnmatched instruction - - // let caseInstrs = - // [ c.matchValueInstrFn ( - // countInstrsForCase c - // // because we can skip over the MatchValue instr - // - 1 - // ) ] - // @ c.whenCondInstructions - // @ (match c.whenCondJump with - // // jump to next case if the when condition is false - // | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] - // | None -> []) - // @ c.rhsInstrs - // @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] - - // instrs @ caseInstrs) - // [] - - // let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] - - // let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max - - // { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } + | PT.EMatch(_id, expr, cases) -> + // first, the easy part - compile the expression we're `match`ing against. + let expr = toRT symbols rc expr + + // Shortly, we'll compile each of the cases. + // We'll use this `resultReg` to store the final result of the match + // , so we have a consistent place to look for it. + // (similar to how we handle `EIf` -- refer to that for a simpler example) + let resultReg, rcAfterResultIsReserved = + expr.registerCount, expr.registerCount + 1 + + // We compile each `case` in two phases, because some instrs require knowing + // how many instrs to jump over, which we can't know until we know the basics + // of all the cases. + // + // See `MatchCase.IntermediateValue` for more info. + let casesAfterFirstPhase : List = + cases + |> List.map (fun c -> + let (pat, symbols, rcAfterPat) = + MatchPattern.toRT Map.empty rcAfterResultIsReserved c.pat + + // compile the `when` condition, if it exists, as much as we can + let rcAfterWhenCond, whenCondInstrs, whenCondJump = + match c.whenCondition with + | None -> (rcAfterPat, [], None) + | Some whenCond -> + let whenCond = toRT symbols rcAfterPat whenCond + (whenCond.registerCount, + whenCond.instructions, + Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) + + // compile the `rhs` of the case + let rhs = toRT symbols rcAfterWhenCond c.rhs + + // return the intermediate results, as far along as they are + { matchValueInstrFn = + fun jumpByFail -> + RT.CheckMatchPatternAndExtractVars(expr.resultIn, pat, jumpByFail) + whenCondInstructions = whenCondInstrs + whenCondJump = whenCondJump + rhsInstrs = rhs.instructions @ [ RT.CopyVal(resultReg, rhs.resultIn) ] + rc = rhs.registerCount }) + + let countInstrsForCase (c : MatchCase.IntermediateValue) : int = + 1 // for the `MatchValue` instruction + + List.length c.whenCondInstructions + + (match c.whenCondJump with + | Some _ -> 1 + | None -> 0) + + List.length c.rhsInstrs + + 1 // for the `JumpBy` instruction + + let (cases, _) : List * int = + casesAfterFirstPhase + |> List.map (fun c -> + let instrCount = countInstrsForCase c + (c, instrCount)) + |> List.foldRight + // CLEANUP this works, but hurts the brain a bit. + (fun (acc, runningTotal) (c, instrCount) -> + let newTotal = runningTotal + instrCount + (acc @ [ c, runningTotal ], newTotal)) + ([], 0) + let cases = List.rev cases + + let caseInstrs = + cases + |> List.fold + (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> + // note: `instrsAfterThisCaseUntilEndOfMatch` does not include + // the final MatchUnmatched instruction + + let caseInstrs = + [ c.matchValueInstrFn ( + countInstrsForCase c + // because we can skip over the MatchValue instr + - 1 + ) ] + @ c.whenCondInstructions + @ (match c.whenCondJump with + // jump to next case if the when condition is false + | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] + | None -> []) + @ c.rhsInstrs + @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] + + instrs @ caseInstrs) + [] + + let instrs = expr.instructions @ caseInstrs @ [ RT.MatchUnmatched ] + + let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max + + { registerCount = rcAtEnd; instructions = instrs; resultIn = resultReg } // -- Records -- diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 5718bf6944..7dddc0e6d7 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -310,7 +310,7 @@ type MatchPattern = first : MatchPattern * second : MatchPattern * theRest : List - | MPVariable of string + | MPVariable of Register type StringSegment = @@ -354,20 +354,20 @@ type Instruction = /// Go `n` instructions forward, unconditionally | JumpBy of instrsToJump : int - // // -- Match -- - // /// Check if the value in the noted register the noted pattern, - // /// and extract vars per MPVariable as relevant. - // | CheckMatchPatternAndExtractVars of - // // what we're matching against - // valueReg : Register * - // pat : MatchPattern * - // // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) - // failJump : int - - // /// Could not find matching case in a match expression - // /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs - // /// TODO maybe make this a special case of Fail - // | MatchUnmatched + // -- Match -- + /// Check if the value in the noted register the noted pattern, + /// and extract vars per MPVariable as relevant. + | CheckMatchPatternAndExtractVars of + // what we're matching against + valueReg : Register * + pat : MatchPattern * + // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) + failJump : int + + /// Could not find matching case in a match expression + /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs + /// TODO maybe make this a special case of Fail + | MatchUnmatched // == Working with Collections == diff --git a/backend/src/Prelude/Prelude.fs b/backend/src/Prelude/Prelude.fs index 808b1d5c25..d79c9c04f9 100644 --- a/backend/src/Prelude/Prelude.fs +++ b/backend/src/Prelude/Prelude.fs @@ -391,8 +391,7 @@ let gid () : uint64 = with e -> Exception.raiseInternal $"gid failed" [ "message", e.Message; "inner", e ] -let guuid(): uuid = - System.Guid.NewGuid() +let guuid () : uuid = System.Guid.NewGuid() let randomString (length : int) : string = let result = diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index bef90eff44..2cb37f3f7e 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -53,8 +53,8 @@ let eVar (name : string) : Expr = EVariable(gid (), name) let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = EIf(gid (), cond, thenBranch, elseBranch) -// let eMatch (expr : Expr) (cases : List) : Expr = -// EMatch(gid (), expr, cases) +let eMatch (expr : Expr) (cases : List) : Expr = + EMatch(gid (), expr, cases) let eRecord (typeName : FQTypeName.FQTypeName) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index e87d0e1c18..1df51d1ea2 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -202,55 +202,55 @@ module Tuples = let tests = testList "Tuples" [ two; three; nested ] -// module Match = -// let simple = -// t -// "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" -// E.Match.simple -// (RT.DString "second branch") - -// let notMatched = -// tFail -// "match true with\n| false -> \"first branch\"" -// E.Match.notMatched -// RTE.MatchUnmatched - -// let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) - -// // let withVarAndWhenCondition = -// // t -// // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" -// // E.Match.withVarAndWhenCondition -// // (RT.DString "second branch") - -// let list = -// t -// "match [1, 2] with\n| [1, 2] -> \"first branch\"" -// E.Match.list -// (RT.DString "first branch") - -// let listCons = -// t -// "match [1, 2] with\n| 1 :: tail -> tail" -// E.Match.listCons -// (RT.DList(VT.int64, [ RT.DInt64 2L ])) - -// let tuple = -// t -// "match (1, 2) with\n| (1, 2) -> \"first branch\"" -// E.Match.tuple -// (RT.DString "first branch") - -// let tests = -// testList -// "Match" -// [ simple -// notMatched -// withVar -// //withVarAndWhenCondition -// list -// listCons -// tuple ] +module Match = + let simple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.Match.simple + (RT.DString "second branch") + + let notMatched = + tFail + "match true with\n| false -> \"first branch\"" + E.Match.notMatched + RTE.MatchUnmatched + + let withVar = t "match true with\n| x -> x" E.Match.withVar (RT.DBool true) + + // let withVarAndWhenCondition = + // t + // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + // E.Match.withVarAndWhenCondition + // (RT.DString "second branch") + + let list = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.Match.list + (RT.DString "first branch") + + let listCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.Match.listCons + (RT.DList(VT.int64, [ RT.DInt64 2L ])) + + let tuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.Match.tuple + (RT.DString "first branch") + + let tests = + testList + "Match" + [ simple + notMatched + withVar + //withVarAndWhenCondition + list + listCons + tuple ] module Records = @@ -336,7 +336,7 @@ let tests = Dict.tests If.tests Tuples.tests - // Match.tests + Match.tests Records.tests RecordFieldAccess.tests // Lambdas.tests diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index a15c068500..975185cdec 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -309,183 +309,181 @@ module Expr = let tests = testList "Tuples" [ two; three; nested ] - // module Match = - // let simple = - // t - // "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" - // E.Match.simple - // (3, - // [ // handle the value we're matching on - // RT.LoadVal(0, RT.DBool true) - - // // FIRST BRANCH - // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) - // // rhs - // RT.LoadVal(2, RT.DString "first branch") - // RT.CopyVal(1, 2) - // RT.JumpBy 5 - - // // SECOND BRANCH - // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 3) - // // rhs - // RT.LoadVal(2, RT.DString "second branch") - // RT.CopyVal(1, 2) - // RT.JumpBy 1 - - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 1) - - // let notMatched = - // t - // "match true with\n| false -> \"first branch\"" - // E.Match.notMatched - // (3, - // [ // handle the value we're matching on - // RT.LoadVal(0, RT.DBool true) + module Match = + let simple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.Match.simple + (3, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) + // rhs + RT.LoadVal(2, RT.DString "first branch") + RT.CopyVal(1, 2) + RT.JumpBy 5 + + // SECOND BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool true, 3) + // rhs + RT.LoadVal(2, RT.DString "second branch") + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) - // // FIRST BRANCH - // RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) - // // rhs - // RT.LoadVal(2, RT.DString "first branch") - // RT.CopyVal(1, 2) - // RT.JumpBy 1 + let notMatched = + t + "match true with\n| false -> \"first branch\"" + E.Match.notMatched + (3, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.CheckMatchPatternAndExtractVars(0, RT.MPBool false, 3) + // rhs + RT.LoadVal(2, RT.DString "first branch") + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 1) + let withVar = + t + "match true with\n| x -> x" + E.Match.withVar + (3, + [ RT.LoadVal(0, RT.DBool true) - // let withVar = - // t - // "match true with\n| x -> x" - // E.Match.withVar - // (3, - // [ RT.LoadVal(0, RT.DBool true) - - // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 3) - // RT.GetVar(2, "x") - // RT.CopyVal(1, 2) - // RT.JumpBy 1 - - // RT.MatchUnmatched ], - // 1) - - // // let withVarAndWhenCondition = - // // t - // // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" - // // E.Match.withVarAndWhenCondition - // // (10, - // // [ RT.LoadVal(0, RT.DInt64 4L) - - // // // first branch - // // RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) - // // RT.LoadVal(2, RT.DString "") - // // RT.LoadVal(3, RT.DString "first branch") - // // RT.AppendString(2, 3) - // // RT.CopyVal(1, 2) - // // RT.JumpBy 14 - - // // // second branch - // // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) - // // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) - // // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) - // // RT.GetVar(4, "x") - // // RT.Apply(5, 3, [], NEList.ofList 4 []) - // // RT.LoadVal(6, RT.DInt64 2L) - // // RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) - // // RT.JumpByIfFalse(5, 7) - // // RT.LoadVal(8, RT.DString "") - // // RT.LoadVal(9, RT.DString "second branch") - // // RT.AppendString(8, 9) - // // RT.CopyVal(1, 8) - // // RT.JumpBy 1 - - // // // handle the case where no branches match - // // RT.MatchUnmatched ], - // // 1) - - // let list = - // t - // "match [1, 2] with\n| [1, 2] -> \"first branch\"" - // E.Match.list - // (5, - // [ // expr, whose result we store in 0 - // RT.LoadVal(1, RT.DInt64 1L) - // RT.LoadVal(2, RT.DInt64 2L) - // RT.CreateList(0, [ 1; 2 ]) + RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable 2, 2) + RT.CopyVal(1, 2) + RT.JumpBy 1 - // // first branch - // RT.CheckMatchPatternAndExtractVars( - // 0, - // RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], - // 3 - // ) - // RT.LoadVal(4, RT.DString "first branch") - // RT.CopyVal(3, 4) - // RT.JumpBy 1 + RT.MatchUnmatched ], + 1) - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 3) + // let withVarAndWhenCondition = + // t + // "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + // E.Match.withVarAndWhenCondition + // (10, + // [ RT.LoadVal(0, RT.DInt64 4L) + + // // first branch + // RT.CheckMatchPatternAndExtractVars(0, RT.MPInt64 1L, 5) + // RT.LoadVal(2, RT.DString "") + // RT.LoadVal(3, RT.DString "first branch") + // RT.AppendString(2, 3) + // RT.CopyVal(1, 2) + // RT.JumpBy 14 + + // // second branch + // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) + // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + // RT.GetVar(4, "x") + // RT.Apply(5, 3, [], NEList.ofList 4 []) + // RT.LoadVal(6, RT.DInt64 2L) + // RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + // RT.JumpByIfFalse(5, 7) + // RT.LoadVal(8, RT.DString "") + // RT.LoadVal(9, RT.DString "second branch") + // RT.AppendString(8, 9) + // RT.CopyVal(1, 8) + // RT.JumpBy 1 + + // // handle the case where no branches match + // RT.MatchUnmatched ], + // 1) + + let list = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.Match.list + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateList(0, [ 1; 2 ]) - // let listCons = - // t - // "match [1, 2] with\n| 1 :: tail -> tail" - // E.Match.listCons - // (5, - // [ // expr, whose result we store in 0 - // RT.LoadVal(1, RT.DInt64 1L) - // RT.LoadVal(2, RT.DInt64 2L) - // RT.CreateList(0, [ 1; 2 ]) + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], + 3 + ) + RT.LoadVal(4, RT.DString "first branch") + RT.CopyVal(3, 4) + RT.JumpBy 1 - // // first branch - // RT.CheckMatchPatternAndExtractVars( - // 0, - // RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), - // 3 - // ) - // RT.GetVar(4, "tail") - // RT.CopyVal(3, 4) - // RT.JumpBy 1 + // handle the case where no branches match + RT.MatchUnmatched ], + 3) - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 3) + let listCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.Match.listCons + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateList(0, [ 1; 2 ]) - // let tuple = - // t - // "match (1, 2) with\n| (1, 2) -> \"first branch\"" - // E.Match.tuple - // (5, - // [ // expr, whose result we store in 0 - // RT.LoadVal(1, RT.DInt64 1L) - // RT.LoadVal(2, RT.DInt64 2L) - // RT.CreateTuple(0, 1, 2, []) + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPListCons(RT.MPInt64 1L, RT.MPVariable 4), + 2 + ) + RT.CopyVal(3, 4) + RT.JumpBy 1 - // // first branch - // RT.CheckMatchPatternAndExtractVars( - // 0, - // RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), - // 3 - // ) - // RT.LoadVal(4, RT.DString "first branch") - // RT.CopyVal(3, 4) - // RT.JumpBy 1 - - // // handle the case where no branches match - // RT.MatchUnmatched ], - // 3) - - // let tests = - // testList - // "Match" - // [ simple - // notMatched - // withVar - // //withVarAndWhenCondition // -- disabled because of fn-calling issues - // list - // listCons - // tuple ] + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + + let tuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.Match.tuple + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + // first branch + RT.CheckMatchPatternAndExtractVars( + 0, + RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), + 3 + ) + RT.LoadVal(4, RT.DString "first branch") + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + + let tests = + testList + "Match" + [ simple + notMatched + withVar + //withVarAndWhenCondition // -- disabled because of fn-calling issues + list + listCons + tuple ] // TODO: add tests for Enums @@ -653,7 +651,7 @@ module Expr = Dict.tests If.tests Tuples.tests - // Match.tests + Match.tests Records.tests RecordFieldAccess.tests // RecordUpdate.tests diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 0cce618ace..dc24cce2b5 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -150,86 +150,86 @@ module Expressions = [ eTuple (eBool true) (eBool false) [] ] - // module Match = - // /// match true with - // /// | false -> "first branch" - // /// | true -> "second branch" - // let simple = - // eMatch - // (eBool true) - // [ { pat = PT.MPBool(gid (), false) - // whenCondition = None - // rhs = eStr [ strText "first branch" ] } - // { pat = PT.MPBool(gid (), true) - // whenCondition = None - // rhs = eStr [ strText "second branch" ] } ] - - // /// match true with - // /// | false -> "first branch" - // let notMatched = - // eMatch - // (eBool true) - // [ { pat = PT.MPBool(gid (), false) - // whenCondition = None - // rhs = eStr [ strText "first branch" ] } ] - - // /// match true with - // /// | x -> x - // let withVar = - // eMatch - // (eBool true) - // [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] - - // // /// match 4 with - // // /// | 1 -> "first branch" - // // /// | x when x % 2 == 0 -> "second branch" - // // let withVarAndWhenCondition = - // // eMatch - // // (eInt64 4) - // // [ { pat = PT.MPInt64(gid (), 1) - // // whenCondition = None - // // rhs = eStr [ strText "first branch" ] } - // // { pat = PT.MPVariable(gid (), "x") - // // // "is even" - // // whenCondition = - // // Some( - // // eApply - // // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) - // // [] - // // [ eApply - // // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) - // // [] - // // [ eVar "x" ] - // // eInt64 2 ] - // // ) - // // rhs = eStr [ strText "second branch" ] } ] - - // let list = - // eMatch - // (eList [ eInt64 1; eInt64 2 ]) - // [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) - // whenCondition = None - // rhs = eStr [ strText "first branch" ] } ] - - // let listCons = - // eMatch - // (eList [ eInt64 1; eInt64 2 ]) - // [ { pat = - // PT.MPListCons( - // gid (), - // PT.MPInt64(gid (), 1), - // PT.MPVariable(gid (), "tail") - // ) - // whenCondition = None - // rhs = eVar "tail" } ] - - // let tuple = - // eMatch - // (eTuple (eInt64 1) (eInt64 2) []) - // [ { pat = - // PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) - // whenCondition = None - // rhs = eStr [ strText "first branch" ] } ] + module Match = + /// match true with + /// | false -> "first branch" + /// | true -> "second branch" + let simple = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPBool(gid (), true) + whenCondition = None + rhs = eStr [ strText "second branch" ] } ] + + /// match true with + /// | false -> "first branch" + let notMatched = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + /// match true with + /// | x -> x + let withVar = + eMatch + (eBool true) + [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] + + // /// match 4 with + // /// | 1 -> "first branch" + // /// | x when x % 2 == 0 -> "second branch" + // let withVarAndWhenCondition = + // eMatch + // (eInt64 4) + // [ { pat = PT.MPInt64(gid (), 1) + // whenCondition = None + // rhs = eStr [ strText "first branch" ] } + // { pat = PT.MPVariable(gid (), "x") + // // "is even" + // whenCondition = + // Some( + // eApply + // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + // [] + // [ eApply + // (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + // [] + // [ eVar "x" ] + // eInt64 2 ] + // ) + // rhs = eStr [ strText "second branch" ] } ] + + let list = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + let listCons = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = + PT.MPListCons( + gid (), + PT.MPInt64(gid (), 1), + PT.MPVariable(gid (), "tail") + ) + whenCondition = None + rhs = eVar "tail" } ] + + let tuple = + eMatch + (eTuple (eInt64 1) (eInt64 2) []) + [ { pat = + PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] module Records = From 688bdd6106bdeda04f382d5050af5f83b7a9b565 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 13 Sep 2024 12:26:19 -0400 Subject: [PATCH 23/60] Starts to apply named fns; partial app works; pkgs barely started --- backend/src/BuiltinExecution/Builtin.fs | 2 +- .../BuiltinExecution/BuiltinExecution.fsproj | 2 +- backend/src/BuiltinExecution/Libs/Int64.fs | 12 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 28 +-- backend/src/LibExecution/Interpreter.fs | 125 +++++++--- backend/src/LibExecution/ProgramTypes.fs | 20 +- backend/src/LibExecution/ProgramTypesAst.fs | 12 +- .../ProgramTypesToRuntimeTypes.fs | 97 ++++---- backend/src/LibExecution/RuntimeTypes.fs | 235 +++++++++--------- backend/tests/TestUtils/PTShortcuts.fs | 23 +- backend/tests/TestUtils/TestUtils.fs | 6 +- backend/tests/Tests/Interpreter.Tests.fs | 51 +++- backend/tests/Tests/PT2RT.Tests.fs | 132 +++++++++- backend/tests/Tests/TestValues.fs | 36 +++ 14 files changed, 532 insertions(+), 249 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 3e6df8ab25..a24d3a9228 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -22,7 +22,7 @@ let builtins httpConfig : Builtins = // Libs.UInt16.builtins // Libs.Int32.builtins // Libs.UInt32.builtins - // Libs.Int64.builtins + Libs.Int64.builtins // Libs.UInt64.builtins // Libs.Int128.builtins // Libs.UInt128.builtins diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 441c69d5df..3d6c06435d 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -20,7 +20,7 @@ - + diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 55e8ee2d48..c26bb95382 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -47,9 +47,9 @@ let fns : List = (function | _, vm, _, [ DInt64 v; DInt64 m ] -> if m = 0L then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else if m < 0L then - RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0L then m + result else result @@ -121,7 +121,7 @@ let fns : List = v % d |> DInt64 |> resultOk with e -> if d = 0L then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Exception.raiseInternal "unexpected failure case in Int64.remainder" @@ -188,11 +188,11 @@ let fns : List = | _, vm, _, [ DInt64 number; DInt64 exp ] -> (try if exp < 0L then - RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else (bigint number) ** (int exp) |> int64 |> DInt64 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = SqlBinOp "^" previewable = Pure @@ -208,7 +208,7 @@ let fns : List = (function | _, vm, _, [ DInt64 a; DInt64 b ] -> if b = 0L then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Ply(DInt64(a / b)) | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index c49c4266cc..ebcea6f88a 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -69,19 +69,19 @@ let rec equals (a : Dval) (b : Dval) : bool = | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 r a3 b3 - // | DApplicable a, DApplicable b -> - // match a, b with - // | Lambda _a, Lambda _b -> - // //equalsLambdaImpl a b - // // TODO - // true - // | NamedFn _a, NamedFn _b -> - // //a = b - // // TODO - // true - // | Lambda _, _ - - // | NamedFn _, _ -> false + | DApplicable a, DApplicable b -> + match a, b with + // | Lambda _a, Lambda _b -> + // //equalsLambdaImpl a b + // // TODO + // true + | NamedFn _a, NamedFn _b -> + //a = b + // TODO + true + //| Lambda _, _ + + //| NamedFn _, _ -> false // | DDB a, DDB b -> a = b @@ -108,7 +108,7 @@ let rec equals (a : Dval) (b : Dval) : bool = | DDict _, _ | DRecord _, _ | DEnum _, _ - //| DApplicable _, _ + | DApplicable _, _ // | DDB _, _ -> // type errors; should be caught above by the caller diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 5e185560c1..2e8fba275d 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -122,9 +122,26 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = let raiseRTE rte = raiseRTE vm.threadID rte - while counter < currentFrame.instructions.Length do + let! something = + match currentFrame.context with + | Source -> Ply vm.sourceInfo + | PackageFn fn -> + uply { + match Map.find fn vm.packageFns with + | Some fn -> return fn + | None -> + match! exeState.fns.package fn with + | Some fn -> + return + { instructions = List.toArray fn.body.instructions + resultReg = fn.body.resultIn } + | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) + } + + + while counter < something.instructions.Length do - match currentFrame.instructions[counter] with + match something.instructions[counter] with // == Simple register operations == | LoadVal(reg, value) -> @@ -286,46 +303,84 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = // counter <- counter + 1 - // // == Working with things that Apply (fns, lambdas) == - // // `add (increment 1L) (3L)` and store results in `putResultIn` - // | Apply(putResultIn, thingToCallReg, _typeArgs, argRegs) -> - // let thingToCall = vm.registers[thingToCallReg] - - // let result = - // match thingToCall with - // | DApplicable applicable -> - // match applicable with - // | Lambda lambda -> - // let impl = Map.findUnsafe lambda.exprId vm.lambdas - - // // TODO: too many args - // if - // (NEList.length impl.patterns) = (lambda.argsSoFar.Length - // + NEList.length argRegs) - // then - // DUnit // TODO - // else - // // TODO - // DApplicable applicable + // == Working with things that Apply (fns, lambdas) == + // `add (increment 1L) (3L)` and store results in `putResultIn` + | Apply(putResultIn, thingToCallReg, typeArgs, newArgRegs) -> + // CLEANUP + // only the first apply of an applicable should be allowed to provide type args + + // further constraint: only named fns can have type args? no, see below. + // let x = Json.parse + // x "3" + + let thingToCall = registers[thingToCallReg] + + let newArgDvals = + newArgRegs |> NEList.toList |> List.map (fun r -> registers[r]) + + let applicable = + match thingToCall with + | DApplicable applicable -> applicable + | _ -> + raiseRTE ( + RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) + ) + + let! result = + uply { + match applicable with + // | Lambda lambda -> DApplicable applicable + + | NamedFn applicable -> + // TODO: typechecking + match applicable.name with + | FQFnName.Builtin builtin -> + match Map.find builtin exeState.fns.builtIn with + | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE + | Some fn -> + let allArgs = applicable.argsSoFar @ newArgDvals + + let argCount = List.length allArgs + let paramCount = List.length fn.parameters + + let typeParamCount = List.length fn.typeParams + let typeArgCount = List.length typeArgs + // TODO: error on these not matching^, too. + + if argCount = paramCount then + let! result = fn.fn (exeState, vm, [], allArgs) + return result + else if argCount > paramCount then + return + RTE.TooManyArgs( + FQFnName.Builtin fn.name, + typeParamCount, + typeArgCount, + paramCount, + argCount + ) + |> raiseRTE + else + return + { applicable with argsSoFar = allArgs } + |> NamedFn + |> DApplicable + + | FQFnName.Package _pkg -> + // TODO + return DUnit + } + + registers[putResultIn] <- result - // | NamedFn _namedFn -> - // // TODO - // DApplicable applicable - - // | _ -> - // RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) - // |> raiseRTE - - // vm.registers[putResultIn] <- result - - // counter <- counter + 1 + counter <- counter + 1 | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) // If we've reached the end of the instructions, return the result - return registers[currentFrame.resultReg] + return registers[something.resultReg] } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index e54722d26c..04dad3439c 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -323,15 +323,15 @@ type Expr = | EDict of id * List | ETuple of id * Expr * Expr * List - // // // -- "Applying" args to things, such as fns and lambdas -- - // /// This is a function call, the first expression is the value of the function. - // /// - `expr (args[0])` - // /// - `expr (args[0]) (args[1])` - // /// - `expr (args[0])` - // | EApply of id * expr : Expr * typeArgs : List * args : NEList + // // -- "Applying" args to things, such as fns and lambdas -- + /// This is a function call, the first expression is the value of the function. + /// - `expr (args[0])` + /// - `expr (args[0]) (args[1])` + /// - `expr (args[0])` + | EApply of id * expr : Expr * typeArgs : List * args : NEList - // /// Reference a function name, _usually_ so we can _apply_ it with args - // | EFnName of id * NameResolution + /// Reference a function name, _usually_ so we can _apply_ it with args + | EFnName of id * NameResolution // // Composed of a parameters * the expression itself // // The id in the varname list is the analysis id, used to get a livevalue @@ -430,9 +430,9 @@ module Expr = | EIf(id, _, _, _) //| EInfix(id, _, _, _) // | ELambda(id, _, _) - // | EFnName(id, _) + | EFnName(id, _) | EVariable(id, _) - // | EApply(id, _, _, _) + | EApply(id, _, _, _) | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index d39cd6986b..fdb172c935 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -78,9 +78,9 @@ let rec symbolsUsedIn (expr : Expr) : Set = | ERecordFieldAccess(_, expr, _) -> r expr -// // things that can be applied -// | EFnName(_, _) -> Set.empty -// | ELambda(_, _, body) -> r body -// | EApply(_, thingToApply, _, args) -> -// Set.unionMany -// [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] + // things that can be applied + | EFnName(_, _) -> Set.empty + // | ELambda(_, _, body) -> r body + | EApply(_, thingToApply, _, args) -> + Set.unionMany + [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 2aba510f29..9e61a65a5b 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -503,54 +503,55 @@ module Expr = resultIn = resultReg } - // | PT.EFnName(_, Ok name) -> - // let namedFn : RT.ApplicableNamedFn = - // { name = FQFnName.toRT name; argsSoFar = [] } - // let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) - // { registerCount = rc + 1 - // instructions = [ RT.LoadVal(rc, applicable) ] - // resultIn = rc } - - // | PT.EFnName(_, Error nre) -> - // // TODO improve - // // hmm maybe we shouldn't fail yet here. - // // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. - // // maybe the 'value' here is (still) some unresolved name? - // // (which should fail when we apply it) - // { registerCount = rc - // instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] - // resultIn = rc } - - - // | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> - // let thingToApply = toRT rc thingToApplyExpr - // // TODO: maybe one or both of these lists should be an `NEList`? - - // // CLEANUP find a way to get rid of silly NEList stuff - // let (regCounter, argInstrs, argRegs) = - // let init = (thingToApply.registerCount, [], []) - - // args - // |> NEList.fold - // (fun (rc, instrs, argResultRegs) arg -> - // let newInstrs = toRT rc arg - // (newInstrs.registerCount, - // instrs @ newInstrs.instructions, - // argResultRegs @ [ newInstrs.resultIn ])) - // init - - // let putResultIn = regCounter - // let callInstr = - // RT.Apply( - // putResultIn, - // thingToApply.resultIn, - // List.map TypeReference.toRT typeArgs, - // NEList.ofListUnsafe "" [] argRegs - // ) - - // { registerCount = regCounter + 1 - // instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] - // resultIn = putResultIn } + | PT.EFnName(_, Ok name) -> + let namedFn : RT.ApplicableNamedFn = + { name = FQFnName.toRT name; argsSoFar = [] } + let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) + + { registerCount = rc + 1 + instructions = [ RT.LoadVal(rc, applicable) ] + resultIn = rc } + + | PT.EFnName(_, Error nre) -> + // TODO improve + // hmm maybe we shouldn't fail yet here. + // It's ok to _reference_ a bad name, so long as we don't try to `apply` it. + // maybe the 'value' here is (still) some unresolved name? + // (which should fail when we apply it) + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = rc } + + + | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> + let thingToApply = toRT symbols rc thingToApplyExpr + // TODO: maybe one or both of these lists should be an `NEList`? + + // CLEANUP find a way to get rid of silly NEList stuff + let (regCounter, argInstrs, argRegs) = + let init = (thingToApply.registerCount, [], []) + + args + |> NEList.fold + (fun (rc, instrs, argResultRegs) arg -> + let newInstrs = toRT symbols rc arg + (newInstrs.registerCount, + instrs @ newInstrs.instructions, + argResultRegs @ [ newInstrs.resultIn ])) + init + + let putResultIn = regCounter + let callInstr = + RT.Apply( + putResultIn, + thingToApply.resultIn, + List.map TypeReference.toRT typeArgs, + NEList.ofListUnsafe "" [] argRegs + ) + + { registerCount = regCounter + 1 + instructions = thingToApply.instructions @ argInstrs @ [ callInstr ] + resultIn = putResultIn } | PT.EMatch(_id, expr, cases) -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 7dddc0e6d7..280ce12424 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -305,7 +305,7 @@ type MatchPattern = | MPChar of string | MPString of string | MPList of List - | MPListCons of head : MatchPattern * tail : MatchPattern // TODO: but the tail is a list... + | MPListCons of head : MatchPattern * tail : MatchPattern | MPTuple of first : MatchPattern * second : MatchPattern * @@ -317,14 +317,7 @@ type StringSegment = | Text of string | Interpolated of Register -/// TODO: consider if each of these should include the Expr ID that they came from -/// -/// Would Expr ID be enough? -/// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) -/// -/// We could also record the Instruction Index -> ExprID mapping _adjacent_ to RT, -/// and only load it when needed. -/// That way, the Interpreter could be lighter-weight. + type Instruction = // == Simple register operations == /// Push a ("constant") value into a register @@ -332,19 +325,17 @@ type Instruction = | CopyVal of copyTo : Register * copyFrom : Register + // == Working with Basic Types == + | CreateString of createTo : Register * segments : List // == Working with Variables == - /// Extract values in a Register to 0 or more variables, per the pattern. + /// Extract values in a Register to 0 or more registers, per the pattern. /// (e.g. `let (x, y) = (1, 2)`) /// /// Errors if the pattern doesn't match the value. | CheckLetPatternAndExtractVars of valueReg : Register * pat : LetPattern - // == Working with Basic Types == - | CreateString of createTo : Register * segments : List - - // == Flow Control == // -- Jumps -- @@ -354,14 +345,16 @@ type Instruction = /// Go `n` instructions forward, unconditionally | JumpBy of instrsToJump : int + // -- Match -- /// Check if the value in the noted register the noted pattern, - /// and extract vars per MPVariable as relevant. + /// and extract values to registers per the nested patterns. | CheckMatchPatternAndExtractVars of - // what we're matching against + /// what we're matching against valueReg : Register * pat : MatchPattern * - // jump here if it doesn't match (to the next case, or to the "unmatched" instruction) + /// jump over the current `match` expr's instructions if it doesn't match + /// (to the next case, or to the "unmatched" instruction) failJump : int /// Could not find matching case in a match expression @@ -412,19 +405,17 @@ type Instruction = fields : List - // // == Working with things that Apply == + // == Working with things that Apply == // | CreateLambda of createTo : Register * lambda : LambdaImpl - // /// Apply some args (and maybe type args) to something - // /// (a named function, or lambda, etc) - // | Apply of - // createTo : Register * - // thingToApply : Register * - // //symbolsToClose : List * // any symbols referenced in the thingToApply that should be closed - // //typeSymbolsToClose : List * - // typeArgs : List * - // args : NEList + /// Apply some args (and maybe type args) to something + /// (a named function, or lambda, etc) + | Apply of + createTo : Register * + thingToApply : Register * + typeArgs : List * + args : NEList // == Errors == | RaiseNRE of NameResolutionError @@ -445,35 +436,20 @@ and Instructions = resultIn : Register } -// and InstructionsWithDebugSymbols = -// { -// /// How many registers are used in evaluating these instructions -// registerCount : int -// /// The instructions themselves -- but with source expr ID -// instructions : List - -// /// The register that will hold the result of the instructions -// resultIn : Register -// } +and DvalMap = Map -// static member withoutDebugSymbols -// (self : InstructionsWithDebugSymbols) -// : Instructions = -// { registerCount = self.registerCount -// instructions = self.instructions |> List.map fst -// resultIn = self.resultIn } -// and later, the expr sources are extracted out +(* +let -and DvalMap = Map +*) /// Lambdas are a bit special: /// they have to close over variables, and have their own set of instructions, not embedded in the main set /// -/// Note to self: trying to remove symTable and typeSymbolTable here +/// Note to self: trying to remove typeSymbolTable here /// causes all sorts of scoping issues. Beware. -/// (that said, typeSymbolTable seems the less-risky to remove...) and LambdaImpl = { // -- Things we know as soon as we create the lambda -- @@ -484,10 +460,24 @@ and LambdaImpl = /// /// When we've received as many args as there are patterns, /// we should either apply the lambda, or error. - patterns : NEList + patterns : NEList // LPVar 1 - /// When the lambda is bound/used, what symbols should be closed? - symbolsToClose : Set + /// When the lambda is defined, + /// we need to "close over" any symbols 'above' that are referenced. + /// + /// e.g. in + /// ```fsharp + /// let a = 1 + /// let incr = fn x -> x + a + /// incr 2 + /// ``` + /// , the lambda `fn x -> x + a` closes over `a`, + /// which we record as `[(1, 2)]` + /// (copy from register '1' above into register '2' in this CF) + /// + /// PT2RT has the duty of creating and passing in (PT2RT-only) + /// symbtable for the evaluation of the expr on the RHS + registersToClose : List // Hmm do these actually belong here, or somewhere else? idk how we get this to work. // do we need to call eval within eval or something? would love to avoid that. @@ -495,10 +485,20 @@ and LambdaImpl = instructions : Instructions } -/// Note: the fn's instructions are loaded to VMState -/// but -- where is the pc and return address stored -/// in a way that doesn't require us to go deeper in some call stack? -and ApplicableNamedFn = { name : FQFnName.FQFnName; argsSoFar : List } + + +and ApplicableNamedFn = + { + name : FQFnName.FQFnName + + // /// We need these around, even for a partially-applied fn + // /// , to make sure we can fail on type errors appropriately + // /// e.g. `Int64.add true` should fail before a second arg is provided. + // parameters : NEList + + /// CLEANUP should this be a list of registers instead? + argsSoFar : List + } // if we're just evaluating a "raw expr," I suppose that's InputClosure? // eval probably handles whichever of these, @@ -552,14 +552,14 @@ and ApplicableLambda = // | Lambda of parent : CallFrameReference * ApplicableLambda -// /// Any thing that can be applied, -// /// along with anything needed within their application closure -// /// TODO: follow up with typeSymbols -// /// TODO needs a better name, clearly. -// and Applicable = -// | Lambda of ApplicableLambda +/// Any thing that can be applied, +/// along with anything needed within their application closure +/// TODO: follow up with typeSymbols +/// TODO needs a better name, clearly. +and Applicable = + //| Lambda of ApplicableLambda -// | NamedFn of ApplicableNamedFn + | NamedFn of ApplicableNamedFn @@ -624,7 +624,7 @@ and [] Dval = caseName : string * fields : List -//| DApplicable of Applicable + | DApplicable of Applicable // // References // | DDB of name : string @@ -760,13 +760,14 @@ module RuntimeError = | ZeroModulus + // module Execution = // type Error = // | MatchExprUnmatched of RuntimeTypes.Dval.Dval // | NonStringInStringInterpolation of RuntimeTypes.Dval.Dval // | ConstDoesntExist of RuntimeTypes.FQConstantName.FQConstantName // | EnumConstructionCaseNotFound of typeName: RuntimeTypes.FQTypeName * caseName: String - // | WrongNumberOfFnArgs of fn: RuntimeTypes.FQFnName * expectedTypeArgs: Int64 * expectedArgs: Int64 * actualTypeArgs: Int64 * actualArgs: Int64 + // // // TODO: Record submodule // | RecordConstructionFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * fieldName: String @@ -877,6 +878,14 @@ module RuntimeError = | MatchUnmatched + // TODO consider currying instead, at which point a `Int.add 0 1 2` would result in "can't apply 2 to 1" + | TooManyArgs of + fn : FQFnName.FQFnName * + expectedTypeArgs : int64 * + expectedArgs : int64 * + actualTypeArgs : int64 * + actualArgs : int64 + // /// "The condition for an `if` expression must be a `Bool`, // /// but is here a `{someFn actualValueType}` (`{someFn actualValue}`)" @@ -925,7 +934,9 @@ module RuntimeError = // backend/src/LibExecution/Interpreter.fs: // - "TODO" - // - $"Function {FQFnName.toString fnName} is not found" + + /// $"Function {FQFnName.toString fnName} is not found" + | FnNotFound of fnName : FQFnName.FQFnName // backend/src/LibExecution/Interpreter.Old.fs: // - "TODO" @@ -1111,18 +1122,18 @@ module Dval = | DEnum(typeName, _, typeArgs, _, _) -> KTCustomType(typeName, typeArgs) |> ValueType.Known -// | DApplicable applicable -> -// match applicable with -// | Lambda _lambda -> -// // KTFn( -// // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, -// // ValueType.Unknown -// // ) -// // |> ValueType.Known -// ValueType.Unknown + | DApplicable applicable -> + match applicable with + // | Lambda _lambda -> + // // KTFn( + // // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, + // // ValueType.Unknown + // // ) + // // |> ValueType.Known + // ValueType.Unknown -// // VTTODO look up type, etc -// | NamedFn _named -> ValueType.Unknown + // VTTODO look up type, etc + | NamedFn _named -> ValueType.Unknown // // CLEANUP follow up when DDB has a typeReference // | DDB _ -> ValueType.Unknown @@ -1388,10 +1399,10 @@ and PackageManager = /// Allows you to side-load a few 'extras' in-memory, along /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras - (pm : PackageManager) (types : List) (constants : List) (fns : List) + (pm : PackageManager) : PackageManager = { getType = fun id -> @@ -1451,8 +1462,22 @@ and ExecutionState = and Registers = Dval array and CallFrameContext = - | Source + | Source // from raw expr (for test) or TopLevel | PackageFn of FQFnName.Package +//| Lambda of parent : CallFrameContext * id + +// all package fn applications (reaching into the interpreter) +// - should be done with eApply with w/e args +// `eApply (fn, ???)` +// + +(* +let incr a = + Int.add 1 a + +let add3 a = + fun b -> add a b +*) and CallFrame = { @@ -1460,17 +1485,10 @@ and CallFrame = parent : Option - argCount : int // TODO uint8 - - // TODO the instructions and resultReg should be extracted - // elsewhere so we have only one copy of them per CallFrameContext, - // in the VMState -- so we don't have to copy them around so much + // TODO the instructions and resultReg are not in the CallFrame itself + // -- multiple CFs may be operating on the same fn or w/e + // so we keep only one copy of such, in the root of the VMState context : CallFrameContext - instructions : Instruction array // move this elsewhere? - /// The register that the result of the program will be in - resultReg : Register - - /// Program counter (what instruction index we are currently 'at') mutable pc : int @@ -1478,50 +1496,43 @@ and CallFrame = registers : Registers // mutable because array? } +and Something = + { + instructions : Instruction array + + /// The register that the result of the block will be in + resultReg : Register + } + and VMState = - { callFrames : Map + { mutable threadID : uuid + callFrames : Map currentFrameID : uuid + sourceInfo : Something //mutable lambdas : Map + mutable packageFns : Map } - mutable threadID : uuid - - // TODO: call stack separately - - // Maybe these all belong in call frames. - // maybe the set of these _is_ the call frame? - //registers : Registers // mutable because array? - //mutable symbolTable : Symtable // should this be a ConcurrentDictionary rather than a Map that's `mutable`? - //mutable typeSymbolTable : TypeSymbolTable // same here - } - - static member fromExpr(exprInstrs : Instructions) : VMState = + static member fromExpr(expr : Instructions) : VMState = let callFrameId = System.Guid.NewGuid() let callFrame : CallFrame = { id = callFrameId context = Source pc = 0 - argCount = 0 - instructions = List.toArray exprInstrs.instructions - registers = Array.zeroCreate exprInstrs.registerCount - resultReg = exprInstrs.resultIn - + registers = Array.zeroCreate expr.registerCount parent = None } { threadID = System.Guid.NewGuid() currentFrameID = callFrameId - callFrames = Map [ callFrameId, callFrame ] } + callFrames = Map [ callFrameId, callFrame ] + sourceInfo = + { instructions = List.toArray expr.instructions; resultReg = expr.resultIn } + packageFns = Map.empty } - -// // symbolTable = Map.empty -// // typeSymbolTable = Map.empty -// // lambdas = Map.empty -// } - and Types = { typeSymbolTable : TypeSymbolTable package : FQTypeName.Package -> Ply> } diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 2cb37f3f7e..60fe9ead31 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -74,10 +74,11 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // EEnum(gid (), typeName, name, args) -// let eBuiltinFnName (name : string) (version : int) : Expr = -// PT.FQFnName.fqBuiltIn name version -// |> PT2RT.FQFnName.toRT -// |> fun x -> EFnName(gid (), x) +let eBuiltinFn (name : string) (version : int) : Expr = + EFnName(gid (), Ok(FQFnName.fqBuiltIn name version)) + +let ePackageFn (id : uuid) : Expr = EFnName(gid (), Ok(FQFnName.fqPackage id)) + // let eLambda id (pats : List) (body : Expr) : Expr = // let pats = NEList.ofListUnsafe "eLambda" [] pats @@ -102,13 +103,13 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // eFn' function_ version typeArgs args -// let eApply -// (target : Expr) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eApply" [] args -// EApply(gid (), target, typeArgs, args) +let eApply + (target : Expr) + (typeArgs : List) + (args : List) + : Expr = + let args = NEList.ofListUnsafe "eApply" [] args + EApply(gid (), target, typeArgs, args) diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 30238cceae..86fc706270 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -376,7 +376,7 @@ module Expect = | DDateTime _ | DUuid _ - //| DApplicable _ + | DApplicable _ // | DDB _ -> true @@ -881,7 +881,7 @@ module Expect = | DDict _, _ | DRecord _, _ | DEnum _, _ - //| DApplicable _, _ + | DApplicable _, _ // | DDB _, _ -> check path actual expected @@ -954,7 +954,7 @@ let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = | DString _ // TODO: should actually traverse in interpolations | DUuid _ | DDateTime _ - //| DApplicable _ + | DApplicable _ // | DDB _ -> f dv f dv diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 1df51d1ea2..93edc01b72 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -325,6 +325,55 @@ module RecordFieldAccess = // let tests = testList "Lambdas" [ identityUnapplied; identityApplied ] +module Fns = + module Builtin = + let unapplied = + t + "Builtin.int64Add" + E.Fns.Builtin.unapplied + (RT.DApplicable( + RT.NamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + )) + + let partiallyApplied = + t + "Builtin.int64Add 1" + E.Fns.Builtin.partiallyApplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [ RT.DInt64 1 ] } + )) + + let fullyApplied = + t "Builtin.int64Add 1 2" E.Fns.Builtin.fullyApplied (RT.DInt64 3L) + + let twoStepApplied = + t "(Builtin.int64Add 1) 2" E.Fns.Builtin.twoStepApplication (RT.DInt64 3L) + + let tests = + testList + "Builtin" + [ unapplied; partiallyApplied; fullyApplied; twoStepApplied ] + + + module Package = + + let unapplied = + t + "packageFnAddWrapper" + E.Fns.Package.unapplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID; argsSoFar = [] } + )) + + // TODO: partially- and fully-applied tests + + let tests = testList "Package" [ unapplied ] + + let tests = testList "Fns" [ Builtin.tests; Package.tests ] + let tests = testList @@ -340,4 +389,4 @@ let tests = Records.tests RecordFieldAccess.tests // Lambdas.tests - ] + Fns.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 975185cdec..89170bf28d 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -640,6 +640,135 @@ module Expr = // let tests = testList "Lambda" [ identityUnapplied; identityApplied ] + module Fns = + module Builtin = + let unapplied = + t + "Builtin.int64Add" + E.Fns.Builtin.unapplied + (1, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) ], + 0) + + let partiallyApplied = + t + "Builtin.int64Add 1" + E.Fns.Builtin.partiallyApplied + (3, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + let fullyApplied = + t + "Builtin.int64Add 1 2" + E.Fns.Builtin.fullyApplied + (4, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) + + let twoStepApplication = + t + "(Builtin.int64Add 1) 2" + E.Fns.Builtin.twoStepApplication + (5, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) + RT.LoadVal(3, RT.DInt64 2L) + RT.Apply(4, 2, [], NEList.ofList 3 []) ], + 4) + + let tests = + testList + "Fns" + [ unapplied; partiallyApplied; fullyApplied; twoStepApplication ] + + + module Package = + let unapplied = + t + "Test.myAdd" + E.Fns.Package.unapplied + (1, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID + argsSoFar = [] } + ) + ) ], + 0) + + let partiallyApplied = + t + "Test.myAdd 1" + E.Fns.Package.partiallyApplied + (3, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + let fullyApplied = + t + "Test.myAdd 1 2" + E.Fns.Package.fullyApplied + (4, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) + + let tests = testList "Fns" [ unapplied; partiallyApplied; fullyApplied ] + + + let tests = testList "Fns" [ Builtin.tests; Package.tests ] + let tests = testList @@ -656,7 +785,8 @@ module Expr = RecordFieldAccess.tests // RecordUpdate.tests // Lambda.tests - ] + Fns.tests ] + module PackageFn = let t name fnName typeParams params' returnType expr expected = diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index dc24cce2b5..6d00dd032d 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -5,6 +5,7 @@ open TestUtils.TestUtils module PT = LibExecution.ProgramTypes module PackageIDs = LibExecution.PackageIDs +module RT = LibExecution.RuntimeTypes open TestUtils.PTShortcuts @@ -254,4 +255,39 @@ module Expressions = // let identityApplied = eApply identityUnapplied [] [ eInt64 1 ] + module Fns = + module Builtin = + let unapplied = eBuiltinFn "int64Add" 0 + let partiallyApplied = eApply unapplied [] [ eInt64 1 ] + let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] + let twoStepApplication = eApply partiallyApplied [] [ eInt64 2 ] + + module Package = + let myAddID = System.Guid.NewGuid() + + let unapplied = ePackageFn myAddID + let partiallyApplied = eApply unapplied [] [ eInt64 1 ] + let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] + let stayIndented = true + + + let stayIndented = true + + + +// let pm: RT.PackageManager = +// RT.PackageManager.empty +// |> RT.PackageManager.withExtras +// [] +// [] +// [ { id = uuid +// typeParams = List + +// // CLEANUP I have an odd suspicion we might not need this field +// // Maybe we just need a paramCount, and the Instructinos in PT2RT ???? +// parameters = NEList +// returnType = TypeReference + +// // CLEANUP consider renaming - just `instructions` maybe? +// body = Instructions }] From 51be1a9b3bc799654e9d9cbbd5ac409270f47cf2 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 13 Sep 2024 13:15:17 -0400 Subject: [PATCH 24/60] trying to call frames --- backend/src/LibExecution/Execution.fs | 2 +- backend/src/LibExecution/Interpreter.fs | 115 ++++++++++++++++------- backend/src/LibExecution/RuntimeTypes.fs | 5 +- backend/tests/Tests/Interpreter.Tests.fs | 2 +- 4 files changed, 87 insertions(+), 37 deletions(-) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index fbb505e66d..f97f197523 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -54,7 +54,7 @@ let executeExpr // TODO: handle secrets and DBs by explicit references instead of relying on symbol table // vmState.symbolTable <- Interpreter.withGlobals state inputVars - let! result = Interpreter.eval exeState vmState + let! result = Interpreter.execute exeState vmState return Ok result with diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 2e8fba275d..19bf1b90d4 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -113,16 +113,19 @@ let rec checkAndExtractMatchPattern /// , like ExecutionContext or Execution /// /// TODO potentially make this a loop instead of recursive -let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = +let execute (exeState : ExecutionState) (vm : VMState) : Ply = uply { + let raiseRTE rte = raiseRTE vm.threadID rte + + //while Map.count vm.callFrames > 1 do + let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames - let mutable counter = currentFrame.pc // what instruction (by index) we're on + let mutable counter = currentFrame.pc let registers = currentFrame.registers - let raiseRTE rte = raiseRTE vm.threadID rte - let! something = + let! instrData = match currentFrame.context with | Source -> Ply vm.sourceInfo | PackageFn fn -> @@ -139,9 +142,9 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = } - while counter < something.instructions.Length do + while counter < instrData.instructions.Length do - match something.instructions[counter] with + match instrData.instructions[counter] with // == Simple register operations == | LoadVal(reg, value) -> @@ -326,27 +329,28 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) ) - let! result = - uply { - match applicable with - // | Lambda lambda -> DApplicable applicable + match applicable with + // | Lambda lambda -> DApplicable applicable - | NamedFn applicable -> - // TODO: typechecking - match applicable.name with - | FQFnName.Builtin builtin -> - match Map.find builtin exeState.fns.builtIn with - | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE - | Some fn -> - let allArgs = applicable.argsSoFar @ newArgDvals + | NamedFn applicable -> + // TODO: typechecking + // TODO: reduce duplication between branches + match applicable.name with + | FQFnName.Builtin builtin -> + match Map.find builtin exeState.fns.builtIn with + | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE + | Some fn -> + let allArgs = applicable.argsSoFar @ newArgDvals - let argCount = List.length allArgs - let paramCount = List.length fn.parameters + let argCount = List.length allArgs + let paramCount = List.length fn.parameters - let typeParamCount = List.length fn.typeParams - let typeArgCount = List.length typeArgs - // TODO: error on these not matching^, too. + let typeParamCount = List.length fn.typeParams + let typeArgCount = List.length typeArgs + // TODO: error on these not matching^, too. + let! result = + uply { if argCount = paramCount then let! result = fn.fn (exeState, vm, [], allArgs) return result @@ -365,13 +369,51 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = { applicable with argsSoFar = allArgs } |> NamedFn |> DApplicable + } + + registers[putResultIn] <- result - | FQFnName.Package _pkg -> - // TODO - return DUnit - } + | FQFnName.Package pkg -> + match! exeState.fns.package pkg with + | None -> return RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE + | Some fn -> + let allArgs = applicable.argsSoFar @ newArgDvals + + let argCount = List.length allArgs + let paramCount = NEList.length fn.parameters + + let typeParamCount = List.length fn.typeParams + let typeArgCount = List.length typeArgs + // TODO: error on these not matching^, too. + + if argCount = paramCount then + // fun with call frames + let newFrameID = guuid () + let newFrame = + { id = newFrameID + parent = Some vm.currentFrameID + pc = 0 + registers = Array.zeroCreate fn.body.registerCount + context = PackageFn fn.id } + + allArgs |> List.iteri (fun i arg -> newFrame.registers[i] <- arg) + + vm.callFrames <- Map.add newFrameID newFrame vm.callFrames + vm.currentFrameID <- newFrameID + + else if argCount > paramCount then + RTE.TooManyArgs( + FQFnName.Package fn.id, + typeParamCount, + typeArgCount, + paramCount, + argCount + ) + |> raiseRTE + else + registers[putResultIn] <- + { applicable with argsSoFar = allArgs } |> NamedFn |> DApplicable - registers[putResultIn] <- result counter <- counter + 1 @@ -380,9 +422,18 @@ let rec private execute (exeState : ExecutionState) (vm : VMState) : Ply = // If we've reached the end of the instructions, return the result - return registers[something.resultReg] - } + return registers[instrData.resultReg] + + + + // return registers[instrData.resultReg] -and eval (exeState : ExecutionState) (vmState : VMState) : Ply = - execute exeState vmState + + // if there are only 1 call frame left, and the counter is at the end of the instructions + // _then_ return registers[instrData.resultReg] + + // if there are more than 1 call frame left, and the counter is at the end of the instructions + // _then_ pop the current frame, and continue executing the next instruction in the parent frame + // don't I need to return the result of the child frame? + } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 280ce12424..0b06d94c75 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -1482,7 +1482,6 @@ let add3 a = and CallFrame = { id : uuid - parent : Option // TODO the instructions and resultReg are not in the CallFrame itself @@ -1508,8 +1507,8 @@ and Something = and VMState = { mutable threadID : uuid - callFrames : Map - currentFrameID : uuid + mutable callFrames : Map + mutable currentFrameID : uuid sourceInfo : Something //mutable lambdas : Map diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 93edc01b72..cd81c60ca6 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -25,7 +25,7 @@ let tCheckVM let! exeState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false - let! actual = LibExecution.Interpreter.eval exeState vmState |> Ply.toTask + let! actual = LibExecution.Interpreter.execute exeState vmState |> Ply.toTask Expect.equal actual expectedInsts "" extraVmStateAssertions vmState From b1ea257da8d7f3bdb6fcb1eeac475cd836ae8871 Mon Sep 17 00:00:00 2001 From: Ocean Date: Mon, 16 Sep 2024 15:34:03 +0000 Subject: [PATCH 25/60] we can call functions now --- backend/src/LibExecution/Interpreter.fs | 593 ++++++++++++----------- backend/src/LibExecution/ProgramTypes.fs | 2 +- backend/src/LibExecution/RuntimeTypes.fs | 5 +- backend/tests/Tests/Interpreter.Tests.fs | 19 +- backend/tests/Tests/TestValues.fs | 48 +- 5 files changed, 338 insertions(+), 329 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 19bf1b90d4..f01d6c2701 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -119,321 +119,326 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = //while Map.count vm.callFrames > 1 do - let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames + // If there's a parent frame to return to, continue execution + // let mutable continueExecution = true + let mutable finalResult : Dval option = None - let mutable counter = currentFrame.pc - let registers = currentFrame.registers + // while continueExecution && Map.containsKey vm.currentFrameID vm.callFrames do + while Map.containsKey vm.currentFrameID vm.callFrames do + let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames + let mutable counter = currentFrame.pc + let registers = currentFrame.registers - let! instrData = - match currentFrame.context with - | Source -> Ply vm.sourceInfo - | PackageFn fn -> - uply { - match Map.find fn vm.packageFns with - | Some fn -> return fn - | None -> - match! exeState.fns.package fn with - | Some fn -> - return - { instructions = List.toArray fn.body.instructions - resultReg = fn.body.resultIn } - | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) - } + let! instrData = + match currentFrame.context with + | Source -> Ply vm.sourceInfo - while counter < instrData.instructions.Length do + | PackageFn fn -> + uply { + match Map.find fn vm.packageFns with + | Some fn -> return fn + | None -> + match! exeState.fns.package fn with + | Some fn -> + return + { instructions = List.toArray fn.body.instructions + resultReg = fn.body.resultIn } + | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) + } - match instrData.instructions[counter] with - - // == Simple register operations == - | LoadVal(reg, value) -> - registers[reg] <- value - counter <- counter + 1 - - | CopyVal(copyTo, copyFrom) -> - registers[copyTo] <- registers[copyFrom] - counter <- counter + 1 - - - // // == Working with Variables == - | CheckLetPatternAndExtractVars(valueReg, pat) -> - let dv = registers[valueReg] - let doesMatch, registersToAssign = checkAndExtractLetPattern pat dv - - if doesMatch then - registersToAssign - |> List.iter (fun (reg, value) -> registers[reg] <- value) - - counter <- counter + 1 - else - raiseRTE (RTE.Let(RTE.Lets.PatternDoesNotMatch(dv, pat))) - - - | VarNotFound varName -> raiseRTE (RTE.VariableNotFound varName) - - - // == Working with Basic Types == - | CreateString(targetReg, segments) -> - let sb = new System.Text.StringBuilder() - - segments - |> List.iter (fun seg -> - match seg with - | Text s -> sb.Append s |> ignore - | Interpolated reg -> - match registers[reg] with - | DString s -> sb.Append s |> ignore - | _ -> raiseRTE (RTE.String RTE.Strings.Error.InvalidStringAppend)) - - registers[targetReg] <- DString(sb.ToString()) - counter <- counter + 1 + let mutable frameToPush = None - // == Flow Control == - // -- Jumps -- - | JumpBy jumpBy -> counter <- counter + jumpBy + 1 - - | JumpByIfFalse(jumpBy, condReg) -> - match registers[condReg] with - | DBool false -> counter <- counter + jumpBy + 1 - | DBool true -> counter <- counter + 1 - | dv -> - let vt = Dval.toValueType dv - raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) - - // -- Match -- - | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> - let doesMatch, registersToAssign = - checkAndExtractMatchPattern pat registers[valueReg] - - if doesMatch then - registersToAssign - |> List.iter (fun (reg, value) -> registers[reg] <- value) - counter <- counter + 1 - else - counter <- counter + failJump + 1 - - | MatchUnmatched -> raiseRTE RTE.MatchUnmatched - - - // == Working with Collections == - | CreateList(listReg, itemsToAddRegs) -> - // CLEANUP reference registers directly in DvalCreator.list, - // so we don't have to copy things - let itemsToAdd = itemsToAddRegs |> List.map (fun r -> registers[r]) - registers[listReg] <- - TypeChecker.DvalCreator.list vm.threadID VT.unknown itemsToAdd - counter <- counter + 1 - - | CreateDict(dictReg, entries) -> - // CLEANUP reference registers directly in DvalCreator.dict, - // so we don't have to copy things - let entries = - entries |> List.map (fun (key, valueReg) -> (key, registers[valueReg])) - registers[dictReg] <- - TypeChecker.DvalCreator.dict vm.threadID VT.unknown entries - counter <- counter + 1 - - | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> - let first = registers[firstReg] - let second = registers[secondReg] - let theRest = theRestRegs |> List.map (fun r -> registers[r]) - registers[tupleReg] <- DTuple(first, second, theRest) - counter <- counter + 1 - + while counter < instrData.instructions.Length && frameToPush = None do - // == Working with Custom Data == - // -- Records -- - | CreateRecord(recordReg, typeName, typeArgs, fields) -> - let fields = - fields |> List.map (fun (name, valueReg) -> (name, registers[valueReg])) + let inst = instrData.instructions[counter] + match inst with - let! record = - TypeChecker.DvalCreator.record - vm.threadID - exeState.types - typeName - typeArgs - fields + // == Simple register operations == + | LoadVal(reg, value) -> registers[reg] <- value - registers[recordReg] <- record - counter <- counter + 1 + | CopyVal(copyTo, copyFrom) -> registers[copyTo] <- registers[copyFrom] - // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> - // let originalRecord = vm.registers[originalRecordReg] - // let updates = - // updates - // |> List.map (fun (fieldName, valueReg) -> - // (fieldName, vm.registers[valueReg])) - // let updatedRecord = - // TypeChecker.DvalCreator.record - // exeState.tracing.callStack - // typeName - // typeArgs - // updates - - // vm.registers[targetReg] <- updatedRecord - // counter <- counter + 1 - - | GetRecordField(targetReg, recordReg, fieldName) -> - match registers[recordReg] with - | DRecord(_, _, _, fields) -> - match Map.find fieldName fields with - | Some value -> - registers[targetReg] <- value - counter <- counter + 1 - | None -> - RTE.Records.FieldAccessFieldNotFound fieldName |> RTE.Record |> raiseRTE - | dv -> - RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) - |> RTE.Record - |> raiseRTE - - // -- Enums -- - | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> - // TODO: safe dval creation - let fields = fields |> List.map (fun (valueReg) -> registers[valueReg]) - registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) - counter <- counter + 1 - // | CreateLambda(lambdaReg, impl) -> - // vm.lambdas <- Map.add impl.exprId impl vm.lambdas - // vm.registers[lambdaReg] <- - // { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } - // |> Applicable.Lambda - // |> DApplicable - // counter <- counter + 1 - - - // == Working with things that Apply (fns, lambdas) == - // `add (increment 1L) (3L)` and store results in `putResultIn` - | Apply(putResultIn, thingToCallReg, typeArgs, newArgRegs) -> - // CLEANUP - // only the first apply of an applicable should be allowed to provide type args - - // further constraint: only named fns can have type args? no, see below. - // let x = Json.parse - // x "3" - - let thingToCall = registers[thingToCallReg] - - let newArgDvals = - newArgRegs |> NEList.toList |> List.map (fun r -> registers[r]) - - let applicable = - match thingToCall with - | DApplicable applicable -> applicable - | _ -> - raiseRTE ( - RTE.ExpectedApplicableButNot(Dval.toValueType thingToCall, thingToCall) - ) - - match applicable with - // | Lambda lambda -> DApplicable applicable - - | NamedFn applicable -> - // TODO: typechecking - // TODO: reduce duplication between branches - match applicable.name with - | FQFnName.Builtin builtin -> - match Map.find builtin exeState.fns.builtIn with - | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE - | Some fn -> - let allArgs = applicable.argsSoFar @ newArgDvals - - let argCount = List.length allArgs - let paramCount = List.length fn.parameters - - let typeParamCount = List.length fn.typeParams - let typeArgCount = List.length typeArgs - // TODO: error on these not matching^, too. - - let! result = - uply { - if argCount = paramCount then - let! result = fn.fn (exeState, vm, [], allArgs) - return result - else if argCount > paramCount then - return - RTE.TooManyArgs( - FQFnName.Builtin fn.name, - typeParamCount, - typeArgCount, - paramCount, - argCount - ) - |> raiseRTE - else - return - { applicable with argsSoFar = allArgs } - |> NamedFn - |> DApplicable - } - - registers[putResultIn] <- result - - | FQFnName.Package pkg -> - match! exeState.fns.package pkg with - | None -> return RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE - | Some fn -> - let allArgs = applicable.argsSoFar @ newArgDvals - - let argCount = List.length allArgs - let paramCount = NEList.length fn.parameters - - let typeParamCount = List.length fn.typeParams - let typeArgCount = List.length typeArgs - // TODO: error on these not matching^, too. - - if argCount = paramCount then - // fun with call frames - let newFrameID = guuid () - let newFrame = - { id = newFrameID - parent = Some vm.currentFrameID - pc = 0 - registers = Array.zeroCreate fn.body.registerCount - context = PackageFn fn.id } - - allArgs |> List.iteri (fun i arg -> newFrame.registers[i] <- arg) - - vm.callFrames <- Map.add newFrameID newFrame vm.callFrames - vm.currentFrameID <- newFrameID - - else if argCount > paramCount then - RTE.TooManyArgs( - FQFnName.Package fn.id, - typeParamCount, - typeArgCount, - paramCount, - argCount + // == Working with Variables == + | CheckLetPatternAndExtractVars(valueReg, pat) -> + let dv = registers[valueReg] + let doesMatch, registersToAssign = checkAndExtractLetPattern pat dv + + if doesMatch then + registersToAssign + |> List.iter (fun (reg, value) -> registers[reg] <- value) + else + raiseRTE (RTE.Let(RTE.Lets.PatternDoesNotMatch(dv, pat))) + + + | VarNotFound varName -> raiseRTE (RTE.VariableNotFound varName) + + + // == Working with Basic Types == + | CreateString(targetReg, segments) -> + let sb = new System.Text.StringBuilder() + + segments + |> List.iter (fun seg -> + match seg with + | Text s -> sb.Append s |> ignore + | Interpolated reg -> + match registers[reg] with + | DString s -> sb.Append s |> ignore + | _ -> raiseRTE (RTE.String RTE.Strings.Error.InvalidStringAppend)) + + registers[targetReg] <- DString(sb.ToString()) + + + // == Flow Control == + // -- Jumps -- + | JumpBy jumpBy -> counter <- counter + jumpBy + + | JumpByIfFalse(jumpBy, condReg) -> + match registers[condReg] with + | DBool false -> counter <- counter + jumpBy + | DBool true -> () + | dv -> + let vt = Dval.toValueType dv + raiseRTE (RTE.Bool(RTE.Bools.ConditionRequiresBool(vt, dv))) + + // -- Match -- + | CheckMatchPatternAndExtractVars(valueReg, pat, failJump) -> + let doesMatch, registersToAssign = + checkAndExtractMatchPattern pat registers[valueReg] + + if doesMatch then + registersToAssign + |> List.iter (fun (reg, value) -> registers[reg] <- value) + else + counter <- counter + failJump + + | MatchUnmatched -> raiseRTE RTE.MatchUnmatched + + + // == Working with Collections == + | CreateList(listReg, itemsToAddRegs) -> + // CLEANUP reference registers directly in DvalCreator.list, + // so we don't have to copy things + let itemsToAdd = itemsToAddRegs |> List.map (fun r -> registers[r]) + registers[listReg] <- + TypeChecker.DvalCreator.list vm.threadID VT.unknown itemsToAdd + + | CreateDict(dictReg, entries) -> + // CLEANUP reference registers directly in DvalCreator.dict, + // so we don't have to copy things + let entries = + entries |> List.map (fun (key, valueReg) -> (key, registers[valueReg])) + registers[dictReg] <- + TypeChecker.DvalCreator.dict vm.threadID VT.unknown entries + + | CreateTuple(tupleReg, firstReg, secondReg, theRestRegs) -> + let first = registers[firstReg] + let second = registers[secondReg] + let theRest = theRestRegs |> List.map (fun r -> registers[r]) + registers[tupleReg] <- DTuple(first, second, theRest) + + + // == Working with Custom Data == + // -- Records -- + | CreateRecord(recordReg, typeName, typeArgs, fields) -> + let fields = + fields |> List.map (fun (name, valueReg) -> (name, registers[valueReg])) + + let! record = + TypeChecker.DvalCreator.record + vm.threadID + exeState.types + typeName + typeArgs + fields + + registers[recordReg] <- record + + // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> + // let originalRecord = vm.registers[originalRecordReg] + // let updates = + // updates + // |> List.map (fun (fieldName, valueReg) -> + // (fieldName, vm.registers[valueReg])) + // let updatedRecord = + // TypeChecker.DvalCreator.record + // exeState.tracing.callStack + // typeName + // typeArgs + // updates + + // vm.registers[targetReg] <- updatedRecord + + | GetRecordField(targetReg, recordReg, fieldName) -> + match registers[recordReg] with + | DRecord(_, _, _, fields) -> + match Map.find fieldName fields with + | Some value -> registers[targetReg] <- value + | None -> + RTE.Records.FieldAccessFieldNotFound fieldName + |> RTE.Record + |> raiseRTE + | dv -> + RTE.Records.FieldAccessNotRecord(Dval.toValueType dv) + |> RTE.Record + |> raiseRTE + + // -- Enums -- + | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> + // TODO: safe dval creation + let fields = fields |> List.map (fun (valueReg) -> registers[valueReg]) + registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) + + // | CreateLambda(lambdaReg, impl) -> + // vm.lambdas <- Map.add impl.exprId impl vm.lambdas + // vm.registers[lambdaReg] <- + // { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } + // |> Applicable.Lambda + // |> DApplicable + + + // == Working with things that Apply (fns, lambdas) == + // `add (increment 1L) (3L)` and store results in `putResultIn` + | Apply(putResultIn, thingToCallReg, typeArgs, newArgRegs) -> + // CLEANUP + // only the first apply of an applicable should be allowed to provide type args + + // further constraint: only named fns can have type args? no, see below. + // let x = Json.parse + // x "3" + + let thingToCall = registers[thingToCallReg] + + let newArgDvals = + newArgRegs |> NEList.toList |> List.map (fun r -> registers[r]) + + let applicable = + match thingToCall with + | DApplicable applicable -> applicable + | _ -> + raiseRTE ( + RTE.ExpectedApplicableButNot( + Dval.toValueType thingToCall, + thingToCall ) - |> raiseRTE - else - registers[putResultIn] <- - { applicable with argsSoFar = allArgs } |> NamedFn |> DApplicable - + ) + + match applicable with + // | Lambda lambda -> DApplicable applicable + + | NamedFn applicable -> + // TODO: typechecking + // TODO: reduce duplication between branches + match applicable.name with + | FQFnName.Builtin builtin -> + match Map.find builtin exeState.fns.builtIn with + | None -> return RTE.FnNotFound(FQFnName.Builtin builtin) |> raiseRTE + | Some fn -> + let allArgs = applicable.argsSoFar @ newArgDvals + + let argCount = List.length allArgs + let paramCount = List.length fn.parameters + + let typeParamCount = List.length fn.typeParams + let typeArgCount = List.length typeArgs + // TODO: error on these not matching^, too. + + let! result = + uply { + if argCount = paramCount then + let! result = fn.fn (exeState, vm, [], allArgs) + return result + else if argCount > paramCount then + return + RTE.TooManyArgs( + FQFnName.Builtin fn.name, + typeParamCount, + typeArgCount, + paramCount, + argCount + ) + |> raiseRTE + else + return + { applicable with argsSoFar = allArgs } + |> NamedFn + |> DApplicable + } + + registers[putResultIn] <- result + + | FQFnName.Package pkg -> + match! exeState.fns.package pkg with + | None -> return RTE.FnNotFound(FQFnName.Package pkg) |> raiseRTE + | Some fn -> + let allArgs = applicable.argsSoFar @ newArgDvals + + let argCount = List.length allArgs + let paramCount = NEList.length fn.parameters + + let typeParamCount = List.length fn.typeParams + let typeArgCount = List.length typeArgs + // TODO: error on these not matching^, too. + + if argCount = paramCount then + // fun with call frames + frameToPush <- + { id = guuid () + parent = Some(vm.currentFrameID, putResultIn, counter + 1) + pc = 0 + registers = + let r = Array.zeroCreate fn.body.registerCount + allArgs |> List.iteri (fun i arg -> r[i] <- arg) + r + context = PackageFn fn.id } + |> Some + + else if argCount > paramCount then + RTE.TooManyArgs( + FQFnName.Package fn.id, + typeParamCount, + typeArgCount, + paramCount, + argCount + ) + |> raiseRTE + else + registers[putResultIn] <- + { applicable with argsSoFar = allArgs } |> NamedFn |> DApplicable + + | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) counter <- counter + 1 - | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) - - - // If we've reached the end of the instructions, return the result - return registers[instrData.resultReg] + match frameToPush with + | None -> + // we are at the end of the instructions of the current frame + let resultOfFrame = registers[instrData.resultReg] + match currentFrame.parent with + | Some(parentID, regOfParentToPutResultInto, pcOfParent) -> + vm.callFrames <- Map.remove vm.currentFrameID vm.callFrames + vm.currentFrameID <- parentID + let parentFrame = Map.findUnsafe parentID vm.callFrames + parentFrame.registers[regOfParentToPutResultInto] <- resultOfFrame + parentFrame.pc <- pcOfParent + | None -> + vm.callFrames <- Map.remove vm.currentFrameID vm.callFrames + finalResult <- Some resultOfFrame + | Some newFrame -> + vm.callFrames <- Map.add newFrame.id newFrame vm.callFrames + vm.currentFrameID <- newFrame.id - // return registers[instrData.resultReg] + // If we've reached the end of the instructions, return the result + match finalResult with + | Some dv -> return dv + | None -> return raiseRTE RTE.MatchUnmatched // TODO better error - - // if there are only 1 call frame left, and the counter is at the end of the instructions - // _then_ return registers[instrData.resultReg] - - // if there are more than 1 call frame left, and the counter is at the end of the instructions - // _then_ pop the current frame, and continue executing the next instruction in the parent frame - // don't I need to return the result of the child frame? } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 04dad3439c..5c3680c3d3 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -639,10 +639,10 @@ type PackageManager = /// Allows you to side-load a few 'extras' in-memory, along /// the normal fetching functionality. (Mostly helpful for tests) static member withExtras - (pm : PackageManager) (types : List) (constants : List) (fns : List) + (pm : PackageManager) : PackageManager = { findType = fun name -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 0b06d94c75..1bad4689b3 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -1482,7 +1482,8 @@ let add3 a = and CallFrame = { id : uuid - parent : Option + /// Id * where to put result in parent * pc of parent + parent : Option // TODO the instructions and resultReg are not in the CallFrame itself // -- multiple CFs may be operating on the same fn or w/e @@ -1493,6 +1494,8 @@ and CallFrame = mutable pc : int registers : Registers // mutable because array? + + // putResultInParent : Option } and Something = diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index cd81c60ca6..525530b771 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -23,7 +23,7 @@ let tCheckVM let vmState = ptExpr |> PT2RT.Expr.toRT Map.empty 0 |> RT.VMState.fromExpr let! exeState = - executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false + executionStateFor TestValues.pm (System.Guid.NewGuid()) false false let! actual = LibExecution.Interpreter.execute exeState vmState |> Ply.toTask Expect.equal actual expectedInsts "" @@ -41,7 +41,7 @@ let tFail name ptExpr expectedRte = let instructions = ptExpr |> PT2RT.Expr.toRT Map.empty 0 let! exeState = - executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false + executionStateFor TestValues.pm (System.Guid.NewGuid()) false false let! actual = LibExecution.Execution.executeExpr exeState instructions @@ -368,9 +368,20 @@ module Fns = { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID; argsSoFar = [] } )) - // TODO: partially- and fully-applied tests + let partiallyApplied = + t + "packageFnAddWrapper 1" + E.Fns.Package.partiallyApplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID + argsSoFar = [ RT.DInt64 1 ] } + )) + + let fullyApplied = + t "packageFnAddWrapper 1 2" E.Fns.Package.fullyApplied (RT.DInt64 3L) - let tests = testList "Package" [ unapplied ] + let tests = testList "Package" [ unapplied; partiallyApplied; fullyApplied ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 6d00dd032d..37ac53b3c4 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -53,13 +53,6 @@ module PM = let all = [] - // TODO - let fake : PT.PackageManager = - PT.PackageManager.withExtras - PT.PackageManager.empty - Types.all - Constants.all - Functions.all module Expressions = module Basic = @@ -263,31 +256,28 @@ module Expressions = let twoStepApplication = eApply partiallyApplied [] [ eInt64 2 ] module Package = - let myAddID = System.Guid.NewGuid() + let myAddID = System.Guid.Parse "a180ed3b-e8ee-42e5-b3c6-9e7ca32ee273" let unapplied = ePackageFn myAddID let partiallyApplied = eApply unapplied [] [ eInt64 1 ] let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] - let stayIndented = true - - let stayIndented = true - - - -// let pm: RT.PackageManager = -// RT.PackageManager.empty -// |> RT.PackageManager.withExtras -// [] -// [] -// [ { id = uuid -// typeParams = List - -// // CLEANUP I have an odd suspicion we might not need this field -// // Maybe we just need a paramCount, and the Instructinos in PT2RT ???? -// parameters = NEList -// returnType = TypeReference - -// // CLEANUP consider renaming - just `instructions` maybe? -// body = Instructions }] +module PT2RT = LibExecution.ProgramTypesToRuntimeTypes + +let pm : PT.PackageManager = + PT.PackageManager.empty + |> PT.PackageManager.withExtras + [] + [] + [ { id = Expressions.Fns.Package.myAddID + name = PT.PackageFn.name "Test" [] "add" + typeParams = [] + parameters = + NEList.ofList + { name = "a"; typ = PT.TInt64; description = "TODO" } + [ { name = "b"; typ = PT.TInt64; description = "TODO" } ] + returnType = PT.TInt64 + body = eApply (eBuiltinFn "int64Add" 0) [] [ eVar "a"; eVar "b" ] + description = "TODO" + deprecated = PT.NotDeprecated } ] From 6fc96f27367e59d39c278001b2f2538a5e72bc1b Mon Sep 17 00:00:00 2001 From: Ocean Date: Mon, 16 Sep 2024 16:37:17 +0000 Subject: [PATCH 26/60] added recursion tests --- backend/tests/Tests/Interpreter.Tests.fs | 74 +++++++++++----- backend/tests/Tests/PT2RT.Tests.fs | 106 ++++++++++++----------- backend/tests/Tests/TestValues.fs | 42 +++++++-- 3 files changed, 141 insertions(+), 81 deletions(-) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 525530b771..a25dd77a16 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -358,30 +358,56 @@ module Fns = module Package = - - let unapplied = - t - "packageFnAddWrapper" - E.Fns.Package.unapplied - (RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID; argsSoFar = [] } - )) - - let partiallyApplied = - t - "packageFnAddWrapper 1" - E.Fns.Package.partiallyApplied - (RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID - argsSoFar = [ RT.DInt64 1 ] } - )) - - let fullyApplied = - t "packageFnAddWrapper 1 2" E.Fns.Package.fullyApplied (RT.DInt64 3L) - - let tests = testList "Package" [ unapplied; partiallyApplied; fullyApplied ] + module MyAdd = + + let unapplied = + t + "Test.myAdd" + E.Fns.Package.MyAdd.unapplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id; argsSoFar = [] } + )) + + let partiallyApplied = + t + "Test.myAdd 1" + E.Fns.Package.MyAdd.partiallyApplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [ RT.DInt64 1 ] } + )) + + let fullyApplied = + t "Test.myAdd 1 2" E.Fns.Package.MyAdd.fullyApplied (RT.DInt64 3L) + + + let tests = testList "Myadd" [ unapplied; partiallyApplied; fullyApplied ] + + + module Fact = + let unapplied = + t + "Test.fact" + E.Fns.Package.Fact.unapplied + (RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.Fact.id; argsSoFar = [] } + )) + + let appliedWith2 = + t "Test.fact 2" E.Fns.Package.Fact.appliedWith2 (RT.DInt64 2L) + + let appliedWith20 = + t + "Test.fact 20" + E.Fns.Package.Fact.appliedWith20 + (RT.DInt64 2432902008176640000L) + + let tests = testList "Fact" [ unapplied; appliedWith2; appliedWith20 ] + + let tests = testList "Package" [ MyAdd.tests; Fact.tests ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 89170bf28d..eca1b4626d 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -714,58 +714,60 @@ module Expr = module Package = - let unapplied = - t - "Test.myAdd" - E.Fns.Package.unapplied - (1, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID - argsSoFar = [] } - ) - ) ], - 0) - - let partiallyApplied = - t - "Test.myAdd 1" - E.Fns.Package.partiallyApplied - (3, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID - argsSoFar = [] } - ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.Apply(2, 0, [], NEList.ofList 1 []) ], - 2) - - let fullyApplied = - t - "Test.myAdd 1 2" - E.Fns.Package.fullyApplied - (4, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.myAddID - argsSoFar = [] } - ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], - 3) - - let tests = testList "Fns" [ unapplied; partiallyApplied; fullyApplied ] - + module MyAdd = + let unapplied = + t + "Test.myAdd" + E.Fns.Package.MyAdd.unapplied + (1, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) ], + 0) + + let partiallyApplied = + t + "Test.myAdd 1" + E.Fns.Package.MyAdd.partiallyApplied + (3, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + let fullyApplied = + t + "Test.myAdd 1 2" + E.Fns.Package.MyAdd.fullyApplied + (4, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.NamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) + + let tests = testList "MyAdd" [ unapplied; partiallyApplied; fullyApplied ] + + let tests = testList "Package" [ MyAdd.tests ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 37ac53b3c4..283e85c403 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -256,11 +256,19 @@ module Expressions = let twoStepApplication = eApply partiallyApplied [] [ eInt64 2 ] module Package = - let myAddID = System.Guid.Parse "a180ed3b-e8ee-42e5-b3c6-9e7ca32ee273" + module MyAdd = + let id = System.Guid.Parse "a180ed3b-e8ee-42e5-b3c6-9e7ca32ee273" + + let unapplied = ePackageFn id + let partiallyApplied = eApply unapplied [] [ eInt64 1 ] + let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] - let unapplied = ePackageFn myAddID - let partiallyApplied = eApply unapplied [] [ eInt64 1 ] - let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] + + module Fact = + let id = System.Guid.Parse "34c0c7bb-2bfa-4dc3-85f9-b965ba3c7880" + let unapplied = ePackageFn id + let appliedWith2 = eApply unapplied [] [ eInt64 2 ] + let appliedWith20 = eApply unapplied [] [ eInt64 20 ] module PT2RT = LibExecution.ProgramTypesToRuntimeTypes @@ -270,7 +278,7 @@ let pm : PT.PackageManager = |> PT.PackageManager.withExtras [] [] - [ { id = Expressions.Fns.Package.myAddID + [ { id = Expressions.Fns.Package.MyAdd.id name = PT.PackageFn.name "Test" [] "add" typeParams = [] parameters = @@ -279,5 +287,29 @@ let pm : PT.PackageManager = [ { name = "b"; typ = PT.TInt64; description = "TODO" } ] returnType = PT.TInt64 body = eApply (eBuiltinFn "int64Add" 0) [] [ eVar "a"; eVar "b" ] + description = "TODO" + deprecated = PT.NotDeprecated } + + { id = Expressions.Fns.Package.Fact.id + name = PT.PackageFn.name "Test" [] "fact" + typeParams = [] + parameters = + NEList.ofList { name = "a"; typ = PT.TInt64; description = "TODO" } [] + returnType = PT.TInt64 + body = + eIf + (eApply (eBuiltinFn "equals" 0) [] [ eVar "a"; eInt64 1 ]) + (eInt64 1) + (Some( + eApply + (eBuiltinFn "int64Multiply" 0) + [] + [ eVar "a" + (eApply + (ePackageFn Expressions.Fns.Package.Fact.id) + [] + [ eApply (eBuiltinFn "int64Subtract" 0) [] [ eVar "a"; eInt64 1 ] ]) ] + )) + description = "TODO" deprecated = PT.NotDeprecated } ] From 0bfe82c8994f7d3d199a6ac1bd2c7b78f69fb5dd Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 16 Sep 2024 15:24:03 -0400 Subject: [PATCH 27/60] lambdas seem to work --- backend/src/BuiltinExecution/Builtin.fs | 2 +- .../BuiltinExecution/BuiltinExecution.fsproj | 2 +- .../BuiltinExecution/Libs/LanguageTools.fs | 1 - backend/src/BuiltinExecution/Libs/List.fs | 4 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 14 +- backend/src/LibExecution/Interpreter.fs | 82 +++++++-- backend/src/LibExecution/ProgramTypes.fs | 11 +- backend/src/LibExecution/ProgramTypesAst.fs | 2 +- .../ProgramTypesToRuntimeTypes.fs | 62 ++++--- backend/src/LibExecution/RuntimeTypes.fs | 65 +++----- backend/src/Prelude/Option.fs | 6 + backend/tests/TestUtils/PTShortcuts.fs | 6 +- backend/tests/Tests/Interpreter.Tests.fs | 46 ++++-- backend/tests/Tests/PT2RT.Tests.fs | 156 +++++++++--------- backend/tests/Tests/TestValues.fs | 16 +- packages/darklang/stdlib/list.dark | 9 + 16 files changed, 290 insertions(+), 194 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index a24d3a9228..c3db78cc04 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -36,7 +36,7 @@ let builtins httpConfig : Builtins = // Libs.Char.builtins // Libs.String.builtins - // Libs.List.builtins + Libs.List.builtins // Libs.Dict.builtins // Libs.DateTime.builtins diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 3d6c06435d..238d86c3ee 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -34,7 +34,7 @@ - + diff --git a/backend/src/BuiltinExecution/Libs/LanguageTools.fs b/backend/src/BuiltinExecution/Libs/LanguageTools.fs index 92d53d0223..75033bfd73 100644 --- a/backend/src/BuiltinExecution/Libs/LanguageTools.fs +++ b/backend/src/BuiltinExecution/Libs/LanguageTools.fs @@ -6,7 +6,6 @@ open LibExecution.Builtin.Shortcuts module VT = LibExecution.ValueType module Dval = LibExecution.Dval -module Interpreter = LibExecution.Interpreter module TypeChecker = LibExecution.TypeChecker module PackageIDs = LibExecution.PackageIDs diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index a9f04469a4..e7318c9d79 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -500,7 +500,7 @@ 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.callStack vt1 (List.append l1 l2)) + Ply(TypeChecker.DvalCreator.list vm.threadID vt1 (List.append l1 l2)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -670,7 +670,7 @@ let fns : List = // long time. let index = RNG.GetInt32(l.Length) (List.tryItem index l) - |> TypeChecker.DvalCreator.option vm.callStack optType + |> TypeChecker.DvalCreator.option vm.threadID optType |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index ebcea6f88a..0be2c0149c 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -71,17 +71,15 @@ let rec equals (a : Dval) (b : Dval) : bool = | DApplicable a, DApplicable b -> match a, b with - // | Lambda _a, Lambda _b -> - // //equalsLambdaImpl a b - // // TODO - // true - | NamedFn _a, NamedFn _b -> - //a = b + | AppLambda _a, AppLambda _b -> + //equalsLambdaImpl a b // TODO true - //| Lambda _, _ - //| NamedFn _, _ -> false + | AppNamedFn a, AppNamedFn b -> a = b + + | AppLambda _, _ + | AppNamedFn _, _ -> false // | DDB a, DDB b -> a = b diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index f01d6c2701..d9b1cc7aaa 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -135,6 +135,13 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = match currentFrame.context with | Source -> Ply vm.sourceInfo + | Lambda(parentContext, lambdaID) -> + let lambda = + Map.findUnsafe (parentContext, lambdaID) vm.lambdas |> _.instructions + { instructions = List.toArray lambda.instructions + resultReg = lambda.resultIn } + |> Ply + | PackageFn fn -> uply { match Map.find fn vm.packageFns with @@ -142,9 +149,12 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | None -> match! exeState.fns.package fn with | Some fn -> - return + let instrData = { instructions = List.toArray fn.body.instructions resultReg = fn.body.resultIn } + vm.packageFns <- Map.add fn.id instrData vm.packageFns + return instrData + | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) } @@ -293,12 +303,18 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = let fields = fields |> List.map (fun (valueReg) -> registers[valueReg]) registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) - // | CreateLambda(lambdaReg, impl) -> - // vm.lambdas <- Map.add impl.exprId impl vm.lambdas - // vm.registers[lambdaReg] <- - // { exprId = impl.exprId; symtable = Map.empty; argsSoFar = [] } - // |> Applicable.Lambda - // |> DApplicable + | CreateLambda(lambdaReg, impl) -> + vm.lambdas <- Map.add (currentFrame.context, impl.exprId) impl vm.lambdas + registers[lambdaReg] <- + { exprId = impl.exprId + closedRegisters = + impl.registersToClose + |> List.map (fun (parentReg, childReg) -> + childReg, registers[parentReg]) + argsSoFar = [] } + |> AppLambda + |> DApplicable + () // == Working with things that Apply (fns, lambdas) == @@ -327,10 +343,49 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = ) ) - match applicable with - // | Lambda lambda -> DApplicable applicable - | NamedFn applicable -> + match applicable with + | AppLambda applicableLambda -> + let foundLambda = + Map.findUnsafe + (currentFrame.context, applicableLambda.exprId) + vm.lambdas + + let allArgs = applicableLambda.argsSoFar @ newArgDvals + + let argCount = List.length allArgs + let paramCount = NEList.length foundLambda.patterns + + //let typeArgCount = List.length typeArgs + // TODO: fail if we try to apply a lambda with type args + + if argCount = paramCount then + frameToPush <- + { id = guuid () + parent = Some(vm.currentFrameID, putResultIn, counter + 1) + pc = 0 + registers = + let r = Array.zeroCreate foundLambda.instructions.registerCount + + allArgs |> List.iteri (fun i arg -> r[i] <- arg) + + applicableLambda.closedRegisters + |> List.iter (fun (reg, value) -> r[reg] <- value) + + r + context = Lambda(currentFrame.context, applicableLambda.exprId) } + |> Some + + else if argCount > paramCount then + // TODO + RTE.MatchUnmatched |> raiseRTE + else + registers[putResultIn] <- + { applicableLambda with argsSoFar = allArgs } + |> AppLambda + |> DApplicable + + | AppNamedFn applicable -> // TODO: typechecking // TODO: reduce duplication between branches match applicable.name with @@ -365,7 +420,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = else return { applicable with argsSoFar = allArgs } - |> NamedFn + |> AppNamedFn |> DApplicable } @@ -408,7 +463,9 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = |> raiseRTE else registers[putResultIn] <- - { applicable with argsSoFar = allArgs } |> NamedFn |> DApplicable + { applicable with argsSoFar = allArgs } + |> AppNamedFn + |> DApplicable | RaiseNRE nre -> raiseRTE (RTE.NameResolution nre) @@ -440,5 +497,4 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = match finalResult with | Some dv -> return dv | None -> return raiseRTE RTE.MatchUnmatched // TODO better error - } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 5c3680c3d3..1d78c0e77d 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -333,10 +333,10 @@ type Expr = /// Reference a function name, _usually_ so we can _apply_ it with args | EFnName of id * NameResolution - // // Composed of a parameters * the expression itself - // // The id in the varname list is the analysis id, used to get a livevalue - // // from the analysis engine - // | ELambda of id * pats : NEList * body : Expr + // Composed of a parameters * the expression itself + // The id in the varname list is the analysis id, used to get a livevalue + // from the analysis engine + | ELambda of id * pats : NEList * body : Expr // /// Calls upon an infix function // | EInfix of id * Infix * lhs : Expr * rhs : Expr @@ -429,7 +429,7 @@ module Expr = | ELet(id, _, _, _) | EIf(id, _, _, _) //| EInfix(id, _, _, _) - // | ELambda(id, _, _) + | ELambda(id, _, _) | EFnName(id, _) | EVariable(id, _) | EApply(id, _, _, _) @@ -443,6 +443,7 @@ module Expr = | EEnum(id, _, _, _, _) | EMatch(id, _, _) -> id + // module PipeExpr = // let toID (expr : PipeExpr) : id = // match expr with diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index fdb172c935..57470deed0 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -80,7 +80,7 @@ let rec symbolsUsedIn (expr : Expr) : Set = // things that can be applied | EFnName(_, _) -> Set.empty - // | ELambda(_, _, body) -> r body + | ELambda(_, _, body) -> r body | EApply(_, thingToApply, _, args) -> Set.unionMany [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 9e61a65a5b..4177140997 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -506,7 +506,7 @@ module Expr = | PT.EFnName(_, Ok name) -> let namedFn : RT.ApplicableNamedFn = { name = FQFnName.toRT name; argsSoFar = [] } - let applicable = RT.DApplicable(RT.Applicable.NamedFn namedFn) + let applicable = RT.DApplicable(RT.AppNamedFn namedFn) { registerCount = rc + 1 instructions = [ RT.LoadVal(rc, applicable) ] @@ -749,26 +749,46 @@ module Expr = resultIn = enumReg } -// | PT.ELambda(id, pats, body) -> -// let symbolsToClose = -// // exclude symbols that are defined/overridden in the lambda's parameters/pats -// let usedInBody = ProgramTypesAst.symbolsUsedIn body -// let usedInPats = -// pats -// |> NEList.toList -// |> List.map PT.LetPattern.symbolsUsed -// |> Set.unionMany -// Set.difference usedInBody usedInPats - -// let impl : RT.LambdaImpl = -// { exprId = id -// patterns = NEList.map LetPattern.toRT pats -// symbolsToClose = symbolsToClose -// instructions = toRT 0 body } - -// { registerCount = rc + 1 -// instructions = [ RT.CreateLambda(rc, impl) ] -// resultIn = rc } + | PT.ELambda(id, pats, body) -> + let symbolsUsedInBody = ProgramTypesAst.symbolsUsedIn body + let symbolsUsedInPats = + pats |> NEList.toList |> List.map PT.LetPattern.symbolsUsed |> Set.unionMany + let symbolsOnlyUsedInBody = Set.difference symbolsUsedInBody symbolsUsedInPats + + let (pats, symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) + : (List * Map * int) = + pats + |> NEList.toList + |> List.fold + (fun (pats, symbols, rc) p -> + let (pat, newSymbols, rcAfterPat) = LetPattern.toRT symbols rc p + (pats @ [ pat ], Map.mergeFavoringRight symbols newSymbols, rcAfterPat)) + ([], Map.empty, 0) + + let (registersToClose, symbolsOfNewFrameAfterOnesOnlyUsedInBoty, rcOfNewFrame) + : (List * Map * int) = + symbolsOnlyUsedInBody + |> Set.toList + |> List.fold + (fun (registersToClose, symbols, rc) name -> + let parentReg = Map.findUnsafe name symbols + let childReg = rc + (registersToClose @ [ parentReg, childReg ], + Map.add name childReg symbols, + rc + 1)) + ([], symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) + + + let impl : RT.LambdaImpl = + { exprId = id + patterns = pats |> NEList.ofListUnsafe "" [] + registersToClose = registersToClose + instructions = + toRT symbolsOfNewFrameAfterOnesOnlyUsedInBoty rcOfNewFrame body } + + { registerCount = rc + 1 + instructions = [ RT.CreateLambda(rc, impl) ] + resultIn = rc } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 1bad4689b3..43a774cf65 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -407,7 +407,7 @@ type Instruction = // == Working with things that Apply == - // | CreateLambda of createTo : Register * lambda : LambdaImpl + | CreateLambda of createTo : Register * lambda : LambdaImpl /// Apply some args (and maybe type args) to something /// (a named function, or lambda, etc) @@ -509,18 +509,20 @@ and ApplicableLambda = /// (the actual implementation is stored in the VMState) exprId : id - // we need registers here, right? - - - // /// The symtable at the time of creation (only copy what's noted in `symbolsToClose`) - // /// , along with anything created throughout processing so far - // symtable : Symtable + /// We _could_ have this be Register * Register + /// , but we run some risk of the register's value changing + /// between the time we create the lambda and the time we apply it. + /// (even though, at time of writing, this seems impossible.) + closedRegisters : List // TODO: typeSymbolTable : TypeSymbolTable argsSoFar : List } + + + // // Is this a _kind_ of closure? I think so! // // So do we need // // @@ -557,9 +559,8 @@ and ApplicableLambda = /// TODO: follow up with typeSymbols /// TODO needs a better name, clearly. and Applicable = - //| Lambda of ApplicableLambda - - | NamedFn of ApplicableNamedFn + | AppLambda of ApplicableLambda + | AppNamedFn of ApplicableNamedFn @@ -880,7 +881,7 @@ module RuntimeError = // TODO consider currying instead, at which point a `Int.add 0 1 2` would result in "can't apply 2 to 1" | TooManyArgs of - fn : FQFnName.FQFnName * + fn : FQFnName.FQFnName * // maybe this should expect either a named fn _or_ a lambda? expectedTypeArgs : int64 * expectedArgs : int64 * actualTypeArgs : int64 * @@ -1124,16 +1125,16 @@ module Dval = | DApplicable applicable -> match applicable with - // | Lambda _lambda -> - // // KTFn( - // // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, - // // ValueType.Unknown - // // ) - // // |> ValueType.Known - // ValueType.Unknown + | AppLambda _lambda -> + // KTFn( + // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, + // ValueType.Unknown + // ) + // |> ValueType.Known + ValueType.Unknown // VTTODO look up type, etc - | NamedFn _named -> ValueType.Unknown + | AppNamedFn _named -> ValueType.Unknown // // CLEANUP follow up when DDB has a typeReference // | DDB _ -> ValueType.Unknown @@ -1464,24 +1465,13 @@ and Registers = Dval array and CallFrameContext = | Source // from raw expr (for test) or TopLevel | PackageFn of FQFnName.Package -//| Lambda of parent : CallFrameContext * id + | Lambda of parent : CallFrameContext * id -// all package fn applications (reaching into the interpreter) -// - should be done with eApply with w/e args -// `eApply (fn, ???)` -// - -(* -let incr a = - Int.add 1 a - -let add3 a = - fun b -> add a b -*) and CallFrame = { id : uuid + /// Id * where to put result in parent * pc of parent parent : Option @@ -1494,11 +1484,9 @@ and CallFrame = mutable pc : int registers : Registers // mutable because array? - - // putResultInParent : Option } -and Something = +and InstrData = { instructions : Instruction array @@ -1513,9 +1501,9 @@ and VMState = mutable callFrames : Map mutable currentFrameID : uuid - sourceInfo : Something - //mutable lambdas : Map - mutable packageFns : Map } + sourceInfo : InstrData + mutable lambdas : Map + mutable packageFns : Map } static member fromExpr(expr : Instructions) : VMState = let callFrameId = System.Guid.NewGuid() @@ -1532,6 +1520,7 @@ and VMState = callFrames = Map [ callFrameId, callFrame ] sourceInfo = { instructions = List.toArray expr.instructions; resultReg = expr.resultIn } + lambdas = Map.empty packageFns = Map.empty } diff --git a/backend/src/Prelude/Option.fs b/backend/src/Prelude/Option.fs index e4dfdda741..073fdde917 100644 --- a/backend/src/Prelude/Option.fs +++ b/backend/src/Prelude/Option.fs @@ -4,3 +4,9 @@ let unwrap (default' : 'a) (t : Option<'a>) : 'a = match t with | None -> default' | Some value -> value + + +let getUnsafe (msg : string) (metadata : Exception.Metadata) (t : Option<'a>) : 'a = + match t with + | None -> Exception.raiseInternal msg metadata + | Some value -> value diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 60fe9ead31..93815a1cbf 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -80,9 +80,9 @@ let eBuiltinFn (name : string) (version : int) : Expr = let ePackageFn (id : uuid) : Expr = EFnName(gid (), Ok(FQFnName.fqPackage id)) -// let eLambda id (pats : List) (body : Expr) : Expr = -// let pats = NEList.ofListUnsafe "eLambda" [] pats -// ELambda(id, pats, body) +let eLambda id (pats : List) (body : Expr) : Expr = + let pats = NEList.ofListUnsafe "eLambda" [] pats + ELambda(id, pats, body) // let eFn' diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index a25dd77a16..63ae6550f7 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -310,20 +310,24 @@ module RecordFieldAccess = testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] -// module Lambdas = -// let identityUnapplied = -// tCheckVM -// "fn x -> x" -// E.Lambdas.identityUnapplied -// (RT.DApplicable( -// RT.Applicable.Lambda -// { exprId = E.Lambdas.identityID; symtable = Map.empty; argsSoFar = [] } -// )) -// (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") +module Lambdas = + module Identity = + let unapplied = + tCheckVM + "fn x -> x" + E.Lambdas.Identity.unapplied + (RT.DApplicable( + RT.AppLambda + { exprId = E.Lambdas.Identity.id; closedRegisters = []; argsSoFar = [] } + )) + (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") -// let identityApplied = t "(fn x -> x) 1" E.Lambdas.identityApplied (RT.DInt64 1L) + let applied = t "(fn x -> x) 1" E.Lambdas.Identity.applied (RT.DInt64 1L) + + let tests = testList "Identity" [ unapplied; applied ] + + let tests = testList "Lambdas" [ Identity.tests ] -// let tests = testList "Lambdas" [ identityUnapplied; identityApplied ] module Fns = module Builtin = @@ -332,7 +336,7 @@ module Fns = "Builtin.int64Add" E.Fns.Builtin.unapplied (RT.DApplicable( - RT.NamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } )) let partiallyApplied = @@ -340,7 +344,7 @@ module Fns = "Builtin.int64Add 1" E.Fns.Builtin.partiallyApplied (RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0 argsSoFar = [ RT.DInt64 1 ] } )) @@ -365,7 +369,7 @@ module Fns = "Test.myAdd" E.Fns.Package.MyAdd.unapplied (RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id; argsSoFar = [] } )) @@ -374,7 +378,7 @@ module Fns = "Test.myAdd 1" E.Fns.Package.MyAdd.partiallyApplied (RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id argsSoFar = [ RT.DInt64 1 ] } )) @@ -392,7 +396,7 @@ module Fns = "Test.fact" E.Fns.Package.Fact.unapplied (RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqPackage E.Fns.Package.Fact.id; argsSoFar = [] } )) @@ -412,6 +416,12 @@ module Fns = let tests = testList "Fns" [ Builtin.tests; Package.tests ] +(* +((PACKAGE.Darklang.Stdlib.List.repeat_v0 348L 1L) + |> Builtin.unwrap + |> PACKAGE.Darklang.Stdlib.List.map (fun f -> f)) = [] + *) + let tests = testList "Interpreter" @@ -425,5 +435,5 @@ let tests = Match.tests Records.tests RecordFieldAccess.tests - // Lambdas.tests + Lambdas.tests Fns.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index eca1b4626d..641495638e 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -39,7 +39,7 @@ module Expr = // [ RT.LoadVal( // 0, // RT.DFnVal( - // RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) + // RT.AppNamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) // ) // ) // RT.LoadVal(1, RT.DInt64 1L) @@ -386,8 +386,8 @@ module Expr = // // second branch // RT.CheckMatchPatternAndExtractVars(0, RT.MPVariable "x", 12) - // RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) - // RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + // RT.LoadVal(2, (RT.DFnVal(RT.AppNamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + // RT.LoadVal(3, (RT.DFnVal(RT.AppNamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) // RT.GetVar(4, "x") // RT.Apply(5, 3, [], NEList.ofList 4 []) // RT.LoadVal(6, RT.DInt64 2L) @@ -601,44 +601,44 @@ module Expr = // let tests = testList "RecordUpdate" [] - // module Lambda = - // let identityUnapplied = - // t - // "fn x -> x" - // E.Lambdas.identityUnapplied - // (1, - // [ RT.CreateLambda( - // 0, - // { exprId = E.Lambdas.identityID - // patterns = NEList.ofList (RT.LPVariable "x") [] - // symbolsToClose = [] |> Set.ofList - // instructions = - // { registerCount = 1 - // instructions = [ RT.GetVar(0, "x") ] - // resultIn = 0 } } - // ) ], - // 0) - - // let identityApplied = - // t - // "(fn x -> x) 1" - // E.Lambdas.identityApplied - // (3, - // [ RT.CreateLambda( - // 0, - // { exprId = E.Lambdas.identityID - // patterns = NEList.ofList (RT.LPVariable "x") [] - // symbolsToClose = [] |> Set.ofList - // instructions = - // { registerCount = 1 - // instructions = [ RT.GetVar(0, "x") ] - // resultIn = 0 } } - // ) - // RT.LoadVal(1, RT.DInt64 1L) - // RT.Apply(2, 0, [], NEList.ofList 1 []) ], - // 2) - - // let tests = testList "Lambda" [ identityUnapplied; identityApplied ] + module Lambda = + module Identity = + + let unapplied = + t + "fn x -> x" + E.Lambdas.Identity.unapplied + (1, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Identity.id + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = + { registerCount = 1; instructions = []; resultIn = 0 } } + ) ], + 0) + + let applied = + t + "(fn x -> x) 1" + E.Lambdas.Identity.applied + (3, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Identity.id + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = + { registerCount = 1; instructions = []; resultIn = 0 } } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + let tests = testList "Identity" [ unapplied; applied ] + + let tests = testList "Lambda" [ Identity.tests ] module Fns = module Builtin = @@ -650,7 +650,7 @@ module Expr = [ RT.LoadVal( 0, RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } ) ) ], @@ -664,7 +664,7 @@ module Expr = [ RT.LoadVal( 0, RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } ) ) @@ -680,7 +680,7 @@ module Expr = [ RT.LoadVal( 0, RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } ) ) @@ -697,7 +697,7 @@ module Expr = [ RT.LoadVal( 0, RT.DApplicable( - RT.NamedFn + RT.AppNamedFn { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } ) ) @@ -720,50 +720,50 @@ module Expr = "Test.myAdd" E.Fns.Package.MyAdd.unapplied (1, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id - argsSoFar = [] } - ) - ) ], - 0) + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) ], + 0) let partiallyApplied = t "Test.myAdd 1" E.Fns.Package.MyAdd.partiallyApplied (3, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id - argsSoFar = [] } - ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.Apply(2, 0, [], NEList.ofList 1 []) ], - 2) + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) let fullyApplied = t "Test.myAdd 1 2" E.Fns.Package.MyAdd.fullyApplied (4, - [ RT.LoadVal( - 0, - RT.DApplicable( - RT.NamedFn - { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id - argsSoFar = [] } - ) - ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], - 3) + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqPackage E.Fns.Package.MyAdd.id + argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) let tests = testList "MyAdd" [ unapplied; partiallyApplied; fullyApplied ] @@ -786,7 +786,7 @@ module Expr = Records.tests RecordFieldAccess.tests // RecordUpdate.tests - // Lambda.tests + Lambda.tests Fns.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 283e85c403..cacb25a326 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -241,12 +241,20 @@ module Expressions = // //module RecordUpdate = - // module Lambdas = - // let identityID = gid () + module Lambdas = + module Identity = - // let identityUnapplied = eLambda identityID [ lpVar "x" ] (eVar "x") + let id = gid () - // let identityApplied = eApply identityUnapplied [] [ eInt64 1 ] + let unapplied = eLambda id [ lpVar "x" ] (eVar "x") + + let applied = eApply unapplied [] [ eInt64 1 ] + + // TODO: + // module Add = + // module AddWithClosedVar = + // SomethingWIthMultipleClosedVars + // TODO: partial application module Fns = module Builtin = diff --git a/packages/darklang/stdlib/list.dark b/packages/darklang/stdlib/list.dark index 01f1c5e9ac..4c599e1eff 100644 --- a/packages/darklang/stdlib/list.dark +++ b/packages/darklang/stdlib/list.dark @@ -154,6 +154,15 @@ module Darklang = let uniqueBy (list: List<'a>) (fn: 'a -> 'b) : List<'a> = Builtin.listUniqueBy_v0 list fn + (* + // let uniqueBy' (list: List<'a>) (fn: 'a -> 'b) : List<'a> = + // let projected = map list (fun dv -> (dv, fn dv)) + // projected + // |> List.distinctBy snd + // |> List.map fst + // |> List.sortWith DvalComparator.compareDval + *) + /// Returns the passed list, with only unique values. /// Only one of each value will be returned, but the From c31df32f8284b9e1937c8d69298a6db67d09449d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 16 Sep 2024 16:01:09 -0400 Subject: [PATCH 28/60] we tested lambdas --- backend/src/BuiltinExecution/Libs/Dict.fs | 59 +++--- backend/src/LibExecution/Interpreter.fs | 14 -- .../ProgramTypesToRuntimeTypes.fs | 10 +- backend/tests/Tests/Interpreter.Tests.fs | 50 ++++- backend/tests/Tests/PT2RT.Tests.fs | 191 +++++++++++++++++- backend/tests/Tests/TestValues.fs | 47 ++++- 6 files changed, 315 insertions(+), 56 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index 1ede86e00e..05581b50a1 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -85,38 +85,37 @@ let fns : List = deprecated = NotDeprecated } + { name = fn "dictFromListOverwritingDuplicates" 0 + typeParams = [] + parameters = [ Param.make "entries" (TList(TTuple(TString, varA, []))) "" ] + returnType = TDict varB + description = + "Returns a with . Each value in + must be a {{(key, value)}} tuple, where is a . - // { name = fn "dictFromListOverwritingDuplicates" 0 - // typeParams = [] - // parameters = [ Param.make "entries" (TList(TTuple(TString, varA, []))) "" ] - // returnType = TDict varB - // description = - // "Returns a with . Each value in - // must be a {{(key, value)}} tuple, where is a . - - // If contains duplicate s, the last entry with that - // key will be used in the resulting dictionary (use if you - // want to enforce unique keys). + If contains duplicate s, the last entry with that + key will be used in the resulting dictionary (use if you + want to enforce unique keys). - // This function is the opposite of ." - // fn = - // (function - // | _, _, _, [ DList(_, l) ] -> - // let f acc dv = - // match dv with - // | DTuple(DString k, value, []) -> Map.add k value acc - // | _ -> - // Exception.raiseInternal - // "Not string tuples in fromListOverwritingDuplicates" - // [ "dval", dv ] - - // List.fold f Map.empty l - // |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + This function is the opposite of ." + fn = + (function + | _, _, _, [ DList(_, l) ] -> + let f acc dv = + match dv with + | DTuple(DString k, value, []) -> Map.add k value acc + | _ -> + Exception.raiseInternal + "Not string tuples in fromListOverwritingDuplicates" + [ "dval", dv ] + + List.fold f Map.empty l + |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } { name = fn "dictFromList" 0 diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index d9b1cc7aaa..7719cd960a 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -106,24 +106,12 @@ let rec checkAndExtractMatchPattern | _ -> false, [] -/// TODO: don't pass ExecutionState around so much? -/// The parts that change, (e.g. `st` and `tst`) should probably all be part of VMState -/// -/// Maybe rename ExecutionState to something else -/// , like ExecutionContext or Execution -/// -/// TODO potentially make this a loop instead of recursive let execute (exeState : ExecutionState) (vm : VMState) : Ply = uply { let raiseRTE rte = raiseRTE vm.threadID rte - //while Map.count vm.callFrames > 1 do - - // If there's a parent frame to return to, continue execution - // let mutable continueExecution = true let mutable finalResult : Dval option = None - // while continueExecution && Map.containsKey vm.currentFrameID vm.callFrames do while Map.containsKey vm.currentFrameID vm.callFrames do let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames @@ -314,7 +302,6 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = argsSoFar = [] } |> AppLambda |> DApplicable - () // == Working with things that Apply (fns, lambdas) == @@ -440,7 +427,6 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = // TODO: error on these not matching^, too. if argCount = paramCount then - // fun with call frames frameToPush <- { id = guuid () parent = Some(vm.currentFrameID, putResultIn, counter + 1) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 4177140997..3634347045 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -753,7 +753,8 @@ module Expr = let symbolsUsedInBody = ProgramTypesAst.symbolsUsedIn body let symbolsUsedInPats = pats |> NEList.toList |> List.map PT.LetPattern.symbolsUsed |> Set.unionMany - let symbolsOnlyUsedInBody = Set.difference symbolsUsedInBody symbolsUsedInPats + let symbolsUsedInBodyNotDefinedInPats = + Set.difference symbolsUsedInBody symbolsUsedInPats let (pats, symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) : (List * Map * int) = @@ -767,14 +768,15 @@ module Expr = let (registersToClose, symbolsOfNewFrameAfterOnesOnlyUsedInBoty, rcOfNewFrame) : (List * Map * int) = - symbolsOnlyUsedInBody + symbolsUsedInBodyNotDefinedInPats |> Set.toList |> List.fold - (fun (registersToClose, symbols, rc) name -> + (fun (registersToClose, newSymbols, rc) name -> + debuG "name" name let parentReg = Map.findUnsafe name symbols let childReg = rc (registersToClose @ [ parentReg, childReg ], - Map.add name childReg symbols, + Map.add name childReg newSymbols, rc + 1)) ([], symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 63ae6550f7..bd72c71df7 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -326,7 +326,55 @@ module Lambdas = let tests = testList "Identity" [ unapplied; applied ] - let tests = testList "Lambdas" [ Identity.tests ] + module Add = + let unapplied = + tCheckVM + "fn x y -> x + y" + E.Lambdas.Add.unapplied + (RT.DApplicable( + RT.AppLambda + { exprId = E.Lambdas.Add.id; closedRegisters = []; argsSoFar = [] } + )) + (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + + let partiallyApplied = + t + "(fn x y -> x + y) 1" + E.Lambdas.Add.partiallyApplied + (RT.DApplicable( + RT.AppLambda + { exprId = E.Lambdas.Add.id + closedRegisters = [] + argsSoFar = [ RT.DInt64 1L ] } + )) + + let fullyApplied = + t "(fn x y -> x + y) 1 2" E.Lambdas.Add.fullyApplied (RT.DInt64 3L) + + let tests = testList "Add" [ unapplied; partiallyApplied; fullyApplied ] + + module AddToClosedVars = + let unapplied = + tCheckVM + "let x = 5\nlet y=10\nfun a -> a + x + y" + E.Lambdas.AddToClosedVars.unapplied + (RT.DApplicable( + RT.AppLambda + { exprId = E.Lambdas.AddToClosedVars.id + closedRegisters = [ (1, RT.DInt64 5); (2, RT.DInt64 10) ] + argsSoFar = [] } + )) + (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + + let applied = + t + "let x = 5\nlet y=10\nlet addFifteen = fun a -> a + x + y\naddFifteen 25" + E.Lambdas.AddToClosedVars.applied + (RT.DInt64 40L) + + let tests = testList "AddToClosedVars" [ unapplied; applied ] + + let tests = testList "Lambdas" [ Identity.tests; Add.tests; AddToClosedVars.tests ] module Fns = diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 641495638e..d57755804d 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -638,7 +638,196 @@ module Expr = let tests = testList "Identity" [ unapplied; applied ] - let tests = testList "Lambda" [ Identity.tests ] + module Add = + let unapplied = + t + "fn a b -> Builtin.int64Add a b" + E.Lambdas.Add.unapplied + (1, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Add.id + patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) ], + 0) + + let partiallyApplied = + t + "(fn a b -> Builtin.int64Add a b) 1" + E.Lambdas.Add.partiallyApplied + (3, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Add.id + patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 2) + + + let fullyApplied = + t + "(fn a b -> Builtin.int64Add a b) 1 2" + E.Lambdas.Add.fullyApplied + (4, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Add.id + patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) + + + let tests = testList "Add" [ unapplied; partiallyApplied; fullyApplied ] + + ///```fsharp + /// let x = 5 + /// let y = 10 + /// let addFifteen = fun a -> a + x + y + /// addFifteen 25 + /// ``` + module AddToClosedVars = + let unapplied = + t + "let x = 5\nlet y=10\nfun a -> a + x + y" + E.Lambdas.AddToClosedVars.unapplied + (5, + [ RT.LoadVal(0, RT.DInt64 5L) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) + + RT.LoadVal(2, RT.DInt64 10L) + RT.CheckLetPatternAndExtractVars(2, RT.LPVariable 3) + + RT.CreateLambda( + 4, + { exprId = E.Lambdas.AddToClosedVars.id + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [ (1, 1); (3, 2) ] + instructions = + { registerCount = 7 + instructions = + [ RT.LoadVal( + 3, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.LoadVal( + 4, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(5, 4, [], NEList.ofList 1 [ 2 ]) + RT.Apply(6, 3, [], NEList.ofList 0 [ 5 ]) ] + resultIn = 6 } } + ) ], + 4) + + let applied = + t + "let x = 5\nlet y=10\nlet addFifteen = fun a -> a + x + y\naddFifteen 25" + E.Lambdas.AddToClosedVars.applied + (8, + [ RT.LoadVal(0, RT.DInt64 5L) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) + + RT.LoadVal(2, RT.DInt64 10L) + RT.CheckLetPatternAndExtractVars(2, RT.LPVariable 3) + + RT.CreateLambda( + 4, + { exprId = E.Lambdas.AddToClosedVars.id + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [ (1, 1); (3, 2) ] + instructions = + { registerCount = 7 + instructions = + [ RT.LoadVal( + 3, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.LoadVal( + 4, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(5, 4, [], NEList.ofList 1 [ 2 ]) + RT.Apply(6, 3, [], NEList.ofList 0 [ 5 ]) ] + resultIn = 6 } } + ) + + RT.CheckLetPatternAndExtractVars(4, RT.LPVariable 5) + + RT.LoadVal(6, RT.DInt64 25L) + + RT.Apply(7, 5, [], NEList.ofList 6 []) ], + 7) + + let tests = testList "AddToClosedVars" [ unapplied; applied ] + + + let tests = + testList "Lambda" [ Identity.tests; Add.tests; AddToClosedVars.tests ] + + module Fns = module Builtin = diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index cacb25a326..1960dbde22 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -241,20 +241,55 @@ module Expressions = // //module RecordUpdate = + // TODO: test nested lambdas module Lambdas = module Identity = - let id = gid () let unapplied = eLambda id [ lpVar "x" ] (eVar "x") let applied = eApply unapplied [] [ eInt64 1 ] - // TODO: - // module Add = - // module AddWithClosedVar = - // SomethingWIthMultipleClosedVars - // TODO: partial application + module Add = + let id = gid () + let unapplied = + eLambda + id + [ lpVar "a"; lpVar "b" ] + (eApply (eBuiltinFn "int64Add" 0) [] [ eVar "a"; eVar "b" ]) + let partiallyApplied = eApply unapplied [] [ eInt64 1 ] + let fullyApplied = eApply unapplied [] [ eInt64 1; eInt64 2 ] + + ///```fsharp + /// let x = 5 + /// let y = 10 + /// let addFifteen = fun a -> a + x + y + /// addFifteen 25 + /// ``` + module AddToClosedVars = + let id = gid () + let unapplied = + eLet + (lpVar "x") + (eInt64 5) + (eLet + (lpVar "y") + (eInt64 10) + (eLambda + id + [ lpVar "a" ] + (eApply + (eBuiltinFn "int64Add" 0) + [] + [ (eVar "a") + (eApply (eBuiltinFn "int64Add" 0) [] [ eVar "x"; eVar "y" ]) ]))) + + let applied = + eLet + (lpVar "addFifteen") + unapplied + (eApply (eVar "addFifteen") [] [ eInt64 25 ]) + module Fns = module Builtin = From b31b39ffeb08817a3411b3c03cc606b2a0269493 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 16 Sep 2024 16:13:03 -0400 Subject: [PATCH 29/60] tidy --- backend/src/LibExecution/RuntimeTypes.fs | 79 +----------------------- 1 file changed, 1 insertion(+), 78 deletions(-) diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 43a774cf65..a3c48ce2c1 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -440,11 +440,6 @@ and Instructions = and DvalMap = Map -(* -let - -*) - /// Lambdas are a bit special: /// they have to close over variables, and have their own set of instructions, not embedded in the main set /// @@ -486,16 +481,10 @@ and LambdaImpl = } - and ApplicableNamedFn = { name : FQFnName.FQFnName - // /// We need these around, even for a partially-applied fn - // /// , to make sure we can fail on type errors appropriately - // /// e.g. `Int64.add true` should fail before a second arg is provided. - // parameters : NEList - /// CLEANUP should this be a list of registers instead? argsSoFar : List } @@ -521,43 +510,9 @@ and ApplicableLambda = } - - -// // Is this a _kind_ of closure? I think so! -// // So do we need -// // -// and CallFrameReference = -// | InputExpr -// | TopLevel of tlid -// | NamedFn of FQFnName.FQFnName -// | Lambda of id - -// /// TODO VMState holds a Map of these? and we fetch by ID? -// /// specifically `Map`? idk. -// /// -// /// Any of these things can be applied, and _somewhere_ have a set of instructions to evaluate -// and CallFrame = -// /// for raw exprs, e.g. tests, one-off scripts, etc -// /// -// /// Thinking... -// /// I think this one actually needs its Instructions -- and maybe registers and such? -// /// This might be where more of VMState gets moved to. -// | InputExpr of parent : Option * Instructions - -// /// TODO probably good to 'migrate' some usages from "raw" expr evaluation to these. -// | TopLevel of parent : Option * tlid - -// | NamedFn of parent : Option * ApplicableNamedFn - -// /// Note: the impl details are stored "centrally" in the VMState -// /// in a LambdaImpl object, after being loaded by a LoadLambda instruction -// | Lambda of parent : CallFrameReference * ApplicableLambda - - /// Any thing that can be applied, /// along with anything needed within their application closure /// TODO: follow up with typeSymbols -/// TODO needs a better name, clearly. and Applicable = | AppLambda of ApplicableLambda | AppNamedFn of ApplicableNamedFn @@ -634,15 +589,7 @@ and [] Dval = and DvalTask = Ply -// /// Our record/tracking of any variable bindings in scope -// /// -// /// i.e. within the execution of `x+y` in -// /// `let x = 1; let y = 2; x + y` -// /// , we would have a Symtable of -// /// `{ "x" => DInt64 1; "y" => DInt64 2 }` -// and Symtable = Map - - +// TODO mayube kill this? and ExecutionPoint = /// User is executing some "arbitrary" expression, passed in by a user. /// @@ -665,24 +612,6 @@ and ExecutionPoint = /// TODO maybe rename to ExprLocation and Source = ExecutionPoint * Option -// and CallStack = -// { -// /// The entrypoint of the execution -// /// (whatever we're executing for a user) -// entrypoint : ExecutionPoint - -// // TODO: bring this back and do something with it, -// // and improve it to be more useful -// // (i.e. maintain order of calls, deal with recursions, etc.) -// // See https://chatgpt.com/share/087935f9-44be-4686-8209-66e701e887b1 -// // /// All of the fns that have been called in this execution -// // calledFns : Set - -// /// The last-called thing (roughly) -// /// -// /// If we've encountered an exception, this should be where things failed -// lastCalled : Source -// } and ThreadID = uuid @@ -1005,10 +934,6 @@ module RuntimeError = -// module CallStack = -// let fromEntryPoint (entrypoint : ExecutionPoint) : CallStack = -// { entrypoint = entrypoint; lastCalled = (entrypoint, None) } - module TypeReference = let result (t1 : TypeReference) (t2 : TypeReference) : TypeReference = TCustomType(Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.result), [ t1; t2 ]) @@ -1033,8 +958,6 @@ exception RuntimeErrorException of ThreadID * rte : RuntimeError.Error let raiseRTE (threadId : ThreadID) (rte : RuntimeError.Error) : 'a = raise (RuntimeErrorException(threadId, rte)) -// let raiseRTE (callStack : CallStack) (rte : RuntimeError) : 'a = -// raise (RuntimeErrorException(Some callStack, rte)) // // (only?) OK in builtins because we "fill in" the callstack in the Interpreter for such failures // // CLEANUP maybe (somehow) restrict to only Builtins From 0b656e33eaf5808c227926d5f06210035ddb8170 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 16 Sep 2024 19:47:48 -0400 Subject: [PATCH 30/60] record updates work (basic) --- backend/src/LibExecution/Interpreter.fs | 36 +++++----- backend/src/LibExecution/ProgramTypes.fs | 8 +-- backend/src/LibExecution/ProgramTypesAst.fs | 5 ++ .../ProgramTypesToRuntimeTypes.fs | 49 +++++++------- backend/src/LibExecution/RuntimeTypes.fs | 16 +++-- backend/tests/TestUtils/PTShortcuts.fs | 3 + backend/tests/Tests/Interpreter.Tests.fs | 33 ++++++++++ backend/tests/Tests/PT2RT.Tests.fs | 65 +++++++++++++++++-- backend/tests/Tests/TestValues.fs | 8 ++- 9 files changed, 169 insertions(+), 54 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 7719cd960a..e867c3678a 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -256,20 +256,27 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = registers[recordReg] <- record - // | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> - // let originalRecord = vm.registers[originalRecordReg] - // let updates = - // updates - // |> List.map (fun (fieldName, valueReg) -> - // (fieldName, vm.registers[valueReg])) - // let updatedRecord = - // TypeChecker.DvalCreator.record - // exeState.tracing.callStack - // typeName - // typeArgs - // updates - - // vm.registers[targetReg] <- updatedRecord + + | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> + let originalRecord = registers[originalRecordReg] + match originalRecord with + | DRecord(_, typeName, typeArgs, originalFields) -> + // TODO: type-saftety + let fields = + List.fold + (fun acc (fieldName, valueReg) -> + Map.add fieldName (registers[valueReg]) acc) + originalFields + updates + + registers[targetReg] <- DRecord(typeName, typeName, typeArgs, fields) + + | dv -> + Dval.toValueType dv + |> RTE.Records.UpdateNotRecord + |> RTE.Record + |> raiseRTE + | GetRecordField(targetReg, recordReg, fieldName) -> match registers[recordReg] with @@ -330,7 +337,6 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = ) ) - match applicable with | AppLambda applicableLambda -> let foundLambda = diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 1d78c0e77d..86150c8719 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -357,9 +357,9 @@ type Expr = /// Access a field of some record (e.g. `someExpr.fieldName`) | ERecordFieldAccess of id * record : Expr * fieldName : string - // /// Clone a record, and update some of its values - // /// `{ r with key = value }` - // | ERecordUpdate of id * record : Expr * updates : NEList + /// Clone a record, and update some of its values + /// `{ r with key = value }` + | ERecordUpdate of id * record : Expr * updates : NEList // Enums include `Some`, `None`, `Error`, `Ok`, as well @@ -438,7 +438,7 @@ module Expr = | ETuple(id, _, _, _) // | EPipe(id, _, _) | ERecord(id, _, _, _) - // | ERecordUpdate(id, _, _) + | ERecordUpdate(id, _, _) | ERecordFieldAccess(id, _, _) | EEnum(id, _, _, _, _) | EMatch(id, _, _) -> id diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 57470deed0..08cfa41580 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -78,6 +78,11 @@ let rec symbolsUsedIn (expr : Expr) : Set = | ERecordFieldAccess(_, expr, _) -> r expr + | ERecordUpdate(_, expr, updates) -> + Set.union + (r expr) + (updates |> NEList.toList |> List.map (fun (_, e) -> r e) |> Set.unionMany) + // things that can be applied | EFnName(_, _) -> Set.empty | ELambda(_, _, body) -> r body diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 3634347045..46c2b64e25 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -685,25 +685,27 @@ module Expr = ) ] resultIn = recordReg } - // | PT.ERecordUpdate(_id, expr, updates) -> - // let (rcAfterOriginalRecord, originalRecordInstrs, originalRecordReg) = - // toRT rc expr - - // let (rcAfterUpdates, updatesInstrs, updates) = - // updates - // |> NEList.fold - // (fun (rc, instrs, regs) (fieldName, fieldExpr) -> - // let (newRc, newInstrs, newReg) = toRT rc fieldExpr - // (newRc, instrs @ newInstrs, regs @ [ (fieldName, newReg) ])) - // (rcAfterOriginalRecord, [], []) - - // let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 - // let instrs = - // originalRecordInstrs - // @ updatesInstrs - // @ [ RT.CloneRecordWithUpdates(targetReg, originalRecordReg, updates) ] - - // (rc, instrs, targetReg) + | PT.ERecordUpdate(_id, expr, updates) -> + let expr = toRT symbols rc expr + + let (rcAfterUpdates, updatesInstrs, updates) = + updates + |> NEList.fold + (fun (rc, instrs, regs) (fieldName, fieldExpr) -> + let update = toRT symbols rc fieldExpr + (update.registerCount, + instrs @ update.instructions, + regs @ [ (fieldName, update.resultIn) ])) + (expr.registerCount, [], []) + + let targetReg, rc = rcAfterUpdates, rcAfterUpdates + 1 + let instrs = + expr.instructions + @ updatesInstrs + @ [ RT.CloneRecordWithUpdates(targetReg, expr.resultIn, updates) ] + + { registerCount = rc; instructions = instrs; resultIn = targetReg } + | PT.ERecordFieldAccess(_id, expr, fieldName) -> let expr = toRT symbols rc expr @@ -771,16 +773,11 @@ module Expr = symbolsUsedInBodyNotDefinedInPats |> Set.toList |> List.fold - (fun (registersToClose, newSymbols, rc) name -> - debuG "name" name + (fun (regs, newSymbols, rc) name -> let parentReg = Map.findUnsafe name symbols - let childReg = rc - (registersToClose @ [ parentReg, childReg ], - Map.add name childReg newSymbols, - rc + 1)) + (regs @ [ parentReg, rc ], Map.add name rc newSymbols, rc + 1)) ([], symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) - let impl : RT.LambdaImpl = { exprId = id patterns = pats |> NEList.ofListUnsafe "" [] diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index a3c48ce2c1..fe8d1859cc 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -385,10 +385,10 @@ type Instruction = typeArgs : List * fields : List - // | CloneRecordWithUpdates of - // createTo : Register * - // originalRecordReg : Register * - // updates : List + | CloneRecordWithUpdates of + createTo : Register * + originalRecordReg : Register * + updates : List | GetRecordField of // todo: rename to "lhs"? Look into this. @@ -771,6 +771,7 @@ module RuntimeError = | CreationEmptyKey | CreationMissingField of fieldName : string | CreationDuplicateField of fieldName : string + | CreationFieldNotExpected of fieldName : string | CreationFieldOfWrongType of fieldName : string * expectedType : TypeReference * @@ -779,6 +780,13 @@ module RuntimeError = | FieldAccessFieldNotFound of fieldName : string | FieldAccessNotRecord of actualType : ValueType + | UpdateNotRecord of actualType : ValueType + | UpdateFieldOfWrongType of + fieldName : string * + expectedType : TypeReference * + actualType : ValueType + | UpdateFieldNotExpected of fieldName : string + /// RuntimeError is the major way of representing errors in the runtime. These are diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 93815a1cbf..345f768436 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -66,6 +66,9 @@ let eRecord let eFieldAccess (expr : Expr) (fieldName : string) : Expr = ERecordFieldAccess(gid (), expr, fieldName) +let eRecordUpdate (expr : Expr) (updates : List) : Expr = + ERecordUpdate(gid (), expr, NEList.ofListUnsafe "" [] updates) + // let eEnum // (typeName : FQTypeName.FQTypeName) // (name : string) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index bd72c71df7..2af4e7c471 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -309,6 +309,38 @@ module RecordFieldAccess = let tests = testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] +module RecordUpdate = + let simple = + t + "let r = Test.Test { key = true }\nlet r2 = { r | key = false }" + E.RecordUpdate.simple + (RT.DRecord( + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + Map [ "key", RT.DBool false ] + )) + + let notRecord = + tFail + "let r = 1\nlet r2 = { r | key = false }" + E.RecordUpdate.notRecord + (RTE.Record(RTE.Records.UpdateNotRecord VT.int64)) + + // let fieldThatShouldNotExist = + // tFail + // "let r = Test.Test { key = true }\nlet r2 = { r | bonus = false }\nr2.key" + // E.RecordUpdate.fieldThatShouldNotExist + // (RTE.Record(RTE.Records.UpdateFieldNotExpected "bonus")) + + // let fieldWithWrongType = + // tFail + // "let r = Test.Test { key = true }\nlet r2 = { r | key = 1 }\nr2.key" + // E.RecordUpdate.fieldWithWrongType + // (RTE.Record(RTE.Records.UpdateFieldOfWrongType("key", RT.TBool, VT.int64))) + + let tests = testList "RecordUpdate" [ simple; notRecord ] // fieldThatShouldNotExist; fieldWithWrongType ] + module Lambdas = module Identity = @@ -483,5 +515,6 @@ let tests = Match.tests Records.tests RecordFieldAccess.tests + RecordUpdate.tests Lambdas.tests Fns.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index d57755804d..d2db0d3837 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -595,10 +595,67 @@ module Expr = testList "RecordFieldAccess" [ simple; notRecord; missingField; nested ] - // module RecordUpdate = - // // TODO + module RecordUpdate = - // let tests = testList "RecordUpdate" [] + let simple = + t + "let r = Test.Test { key = true }\n{ r with key = false }" + E.RecordUpdate.simple + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.LoadVal(2, RT.DBool false) + RT.CloneRecordWithUpdates(3, 0, [ ("key", 2) ]) ], + 3) + let notRecord = + t + "1 with key = false" + E.RecordUpdate.notRecord + (3, + [ RT.LoadVal(0, RT.DInt64 1L) + RT.LoadVal(1, RT.DBool false) + RT.CloneRecordWithUpdates(2, 0, [ ("key", 1) ]) ], + 2) + let fieldThatShouldNotExist = + t + "let r = Test.Test { key = true }\n{ r with bonus = false }" + E.RecordUpdate.fieldThatShouldNotExist + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.LoadVal(2, RT.DBool false) + RT.CloneRecordWithUpdates(3, 0, [ ("bonus", 2) ]) ], + 3) + let fieldWithWrongType = + t + "let r = Test.Test { key = true }\n{ r with key = 1 }" + E.RecordUpdate.fieldWithWrongType + (4, + [ RT.LoadVal(1, RT.DBool true) + RT.CreateRecord( + 0, + RT.FQTypeName.fqPackage PM.Types.Records.singleField, + [], + [ ("key", 1) ] + ) + RT.LoadVal(2, RT.DInt64 1L) + RT.CloneRecordWithUpdates(3, 0, [ ("key", 2) ]) ], + 3) + + let tests = + testList + "RecordUpdate" + [ simple; notRecord; fieldThatShouldNotExist; fieldWithWrongType ] module Lambda = @@ -974,7 +1031,7 @@ module Expr = Match.tests Records.tests RecordFieldAccess.tests - // RecordUpdate.tests + RecordUpdate.tests Lambda.tests Fns.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 1960dbde22..b827f9403a 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -239,7 +239,13 @@ module Expressions = let nested = eFieldAccess (eFieldAccess Records.nested "outer") "key" - // //module RecordUpdate = + module RecordUpdate = + let simple = eRecordUpdate Records.simple [ "key", eBool false ] + let notRecord = eRecordUpdate (eInt64 1) [ "key", eBool false ] + let fieldThatShouldNotExist = + eRecordUpdate Records.simple [ "bonus", eBool false ] + let fieldWithWrongType = eRecordUpdate Records.simple [ "key", eInt64 1 ] + // TODO: test nested lambdas module Lambdas = From 3497553b0212b260b731e223cc2692057eadcea3 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 16 Sep 2024 20:44:51 -0400 Subject: [PATCH 31/60] EInfix works --- backend/src/LibExecution/Interpreter.fs | 16 ++++ backend/src/LibExecution/ProgramTypes.fs | 6 +- backend/src/LibExecution/ProgramTypesAst.fs | 1 + .../ProgramTypesToRuntimeTypes.fs | 82 +++++++++++++++---- backend/src/LibExecution/RuntimeTypes.fs | 7 +- backend/tests/TestUtils/PTShortcuts.fs | 4 + backend/tests/Tests/Interpreter.Tests.fs | 27 ++++++ backend/tests/Tests/PT2RT.Tests.fs | 61 ++++++++++++++ backend/tests/Tests/TestValues.fs | 22 +++++ 9 files changed, 205 insertions(+), 21 deletions(-) diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index e867c3678a..fd83873bba 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -159,6 +159,22 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | CopyVal(copyTo, copyFrom) -> registers[copyTo] <- registers[copyFrom] + | Or(createTo, left, right) -> + match registers[left], registers[right] with + | DBool l, DBool r -> registers[createTo] <- DBool(l || r) + | l, r -> + let lvt = Dval.toValueType l + let rvt = Dval.toValueType r + raiseRTE (RTE.Bool(RTE.Bools.OrOnlySupportsBooleans(lvt, rvt))) + + | And(createTo, left, right) -> + match registers[left], registers[right] with + | DBool l, DBool r -> registers[createTo] <- DBool(l && r) + | l, r -> + let lvt = Dval.toValueType l + let rvt = Dval.toValueType r + raiseRTE (RTE.Bool(RTE.Bools.AndOnlySupportsBooleans(lvt, rvt))) + // == Working with Variables == | CheckLetPatternAndExtractVars(valueReg, pat) -> diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 86150c8719..6eb2873d48 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -338,8 +338,8 @@ type Expr = // from the analysis engine | ELambda of id * pats : NEList * body : Expr - // /// Calls upon an infix function - // | EInfix of id * Infix * lhs : Expr * rhs : Expr + /// Calls upon an infix function + | EInfix of id * Infix * lhs : Expr * rhs : Expr // -- References to custom types and data -- @@ -428,7 +428,7 @@ module Expr = // | EConstant(id, _) | ELet(id, _, _, _) | EIf(id, _, _, _) - //| EInfix(id, _, _, _) + | EInfix(id, _, _, _) | ELambda(id, _, _) | EFnName(id, _) | EVariable(id, _) diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 08cfa41580..1433e600a2 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -84,6 +84,7 @@ let rec symbolsUsedIn (expr : Expr) : Set = (updates |> NEList.toList |> List.map (fun (_, e) -> r e) |> Set.unionMany) // things that can be applied + | EInfix(_, _, left, right) -> Set.union (r left) (r right) | EFnName(_, _) -> Set.empty | ELambda(_, _, body) -> r body | EApply(_, thingToApply, _, args) -> diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 46c2b64e25..9a44e6b6c8 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -122,22 +122,23 @@ module TypeReference = //| PT.TDB typ -> RT.TDB(toRT typ) -// module InfixFnName = -// let toFnName (name : PT.InfixFnName) : (string * int) = -// match name with -// | PT.ArithmeticPlus -> ("int64Add", 0) -// | PT.ArithmeticMinus -> ("int64Subtract", 0) -// | PT.ArithmeticMultiply -> ("int64Multiply", 0) -// | PT.ArithmeticDivide -> ("floatDivide", 0) -// | PT.ArithmeticModulo -> ("int64Mod", 0) -// | PT.ArithmeticPower -> ("int64Power", 0) -// | PT.ComparisonGreaterThan -> ("int64GreaterThan", 0) -// | PT.ComparisonGreaterThanOrEqual -> ("int64GreaterThanOrEqualTo", 0) -// | PT.ComparisonLessThan -> ("int64LessThan", 0) -// | PT.ComparisonLessThanOrEqual -> ("int64LessThanOrEqualTo", 0) -// | PT.StringConcat -> ("stringAppend", 0) -// | PT.ComparisonEquals -> ("equals", 0) -// | PT.ComparisonNotEquals -> ("notEquals", 0) +module InfixFnName = + let toFnName (name : PT.InfixFnName) : RT.FQFnName.Builtin = + let make = RT.FQFnName.builtin + match name with + | PT.ArithmeticPlus -> make "int64Add" 0 + | PT.ArithmeticMinus -> make "int64Subtract" 0 + | PT.ArithmeticMultiply -> make "int64Multiply" 0 + | PT.ArithmeticDivide -> make "floatDivide" 0 + | PT.ArithmeticModulo -> make "int64Mod" 0 + | PT.ArithmeticPower -> make "int64Power" 0 + | PT.ComparisonGreaterThan -> make "int64GreaterThan" 0 + | PT.ComparisonGreaterThanOrEqual -> make "int64GreaterThanOrEqualTo" 0 + | PT.ComparisonLessThan -> make "int64LessThan" 0 + | PT.ComparisonLessThanOrEqual -> make "int64LessThanOrEqualTo" 0 + | PT.StringConcat -> make "stringAppend" 0 + | PT.ComparisonEquals -> make "equals" 0 + | PT.ComparisonNotEquals -> make "notEquals" 0 module LetPattern = @@ -503,6 +504,55 @@ module Expr = resultIn = resultReg } + | PT.EInfix(_, PT.BinOp op, left, right) -> + let left = toRT symbols rc left + let right = toRT symbols left.registerCount right + + let resultReg, rcAfterResult = right.registerCount, right.registerCount + 1 + + let opInstr = + match op with + | PT.BinOpOr -> RT.Or(resultReg, left.resultIn, right.resultIn) + | PT.BinOpAnd -> RT.And(resultReg, left.resultIn, right.resultIn) + + { registerCount = rcAfterResult + instructions = left.instructions @ right.instructions @ [ opInstr ] + resultIn = resultReg } + + + + | PT.EInfix(_, PT.InfixFnCall infix, left, right) -> + let left = toRT symbols rc left + let right = toRT symbols left.registerCount right + let infixInstr, infixRc, rcAfterInfix = + RT.LoadVal( + right.registerCount, + RT.AppNamedFn + { name = InfixFnName.toFnName infix |> RT.FQFnName.Builtin + argsSoFar = [] } + |> RT.DApplicable + ), + right.registerCount, + right.registerCount + 1 + + let resultReg, rcAfterResult = rcAfterInfix, rcAfterInfix + 1 + + { registerCount = rcAfterResult + instructions = + left.instructions + @ right.instructions + @ [ infixInstr ] + @ [ RT.Apply( + resultReg, + infixRc, + [], + NEList.ofList left.resultIn [ right.resultIn ] + ) ] + resultIn = resultReg } + + + + | PT.EFnName(_, Ok name) -> let namedFn : RT.ApplicableNamedFn = { name = FQFnName.toRT name; argsSoFar = [] } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index fe8d1859cc..872e408e99 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -325,6 +325,9 @@ type Instruction = | CopyVal of copyTo : Register * copyFrom : Register + | Or of createTo : Register * lhs : Register * rhs : Register + | And of createTo : Register * lhs : Register * rhs : Register + // == Working with Basic Types == | CreateString of createTo : Register * segments : List @@ -737,8 +740,8 @@ module RuntimeError = module Bools = type Error = - // | AndOnlySupportsBooleans of gotInstead: Dval - // | OrOnlySupportsBooleans of gotInstead: Dval + | AndOnlySupportsBooleans of gotLeft : ValueType * gotRight : ValueType + | OrOnlySupportsBooleans of gotRight : ValueType * gotLeft : ValueType | ConditionRequiresBool of actualValueType : ValueType * actualValue : Dval module Strings = diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 345f768436..c238d5bbb2 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -77,6 +77,10 @@ let eRecordUpdate (expr : Expr) (updates : List) : Expr = // EEnum(gid (), typeName, name, args) +let eInfix (op : Infix) (left : Expr) (right : Expr) : Expr = + EInfix(gid (), op, left, right) + + let eBuiltinFn (name : string) (version : int) : Expr = EFnName(gid (), Ok(FQFnName.fqBuiltIn name version)) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 2af4e7c471..f6e4712682 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -342,6 +342,32 @@ module RecordUpdate = let tests = testList "RecordUpdate" [ simple; notRecord ] // fieldThatShouldNotExist; fieldWithWrongType ] +module Infix = + module And = + let mixed = t "true && false" E.Infix.And.mixed (RT.DBool false) + let nested = t "true && (true && false)" E.Infix.And.nested (RT.DBool false) + let bothTrue = t "true && true" E.Infix.And.bothTrue (RT.DBool true) + let bothFalse = t "false && false" E.Infix.And.bothFalse (RT.DBool false) + let tests = testList "And" [ mixed; nested; bothTrue; bothFalse ] + + module Or = + let mixed = t "true || false" E.Infix.Or.mixed (RT.DBool true) + let nested = t "true || (true || false)" E.Infix.Or.nested (RT.DBool true) + let bothTrue = t "true || true" E.Infix.Or.bothTrue (RT.DBool true) + let bothFalse = t "false || false" E.Infix.Or.bothFalse (RT.DBool false) + let tests = testList "Or" [ mixed; nested; bothTrue; bothFalse ] + + module Add = + let simple = t "1 + 2" E.Infix.Add.simple (RT.DInt64 3L) + let tests = testList "Add" [ simple ] + + module Subtract = + let simple = t "1 - 2" E.Infix.Subtract.simple (RT.DInt64(-1L)) + let tests = testList "Subtract" [ simple ] + + let tests = testList "Infix" [ And.tests; Or.tests; Add.tests; Subtract.tests ] + + module Lambdas = module Identity = let unapplied = @@ -516,5 +542,6 @@ let tests = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Infix.tests Lambdas.tests Fns.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index d2db0d3837..1c3e3840ae 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -658,6 +658,66 @@ module Expr = [ simple; notRecord; fieldThatShouldNotExist; fieldWithWrongType ] + (* + module Infix = + module And = + let mixed = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool true) (eBool false) + let nested = eInfix (PT.Infix.BinOp PT.BinOpAnd) mixed (eBool true) + let bothTrue = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool true) (eBool true) + let bothFalse = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool false) (eBool false) + + module Or = + let mixed = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool true) (eBool false) + let nested = eInfix (PT.Infix.BinOp PT.BinOpOr) mixed (eBool true) + let bothTrue = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool true) (eBool true) + let bothFalse = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool false) (eBool false) + + module Add = + let simple = + eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 1) (eInt64 2) + + module Subtract = + let simple = + eInfix (PT.Infix.InfixFnCall PT.ArithmeticMinus) (eInt64 1) (eInt64 2)*) + + + module Infix = + module And = + let mixed = + t + "true && false" + E.Infix.And.mixed + (3, + [ RT.LoadVal(0, RT.DBool true) + RT.LoadVal(1, RT.DBool false) + RT.And(2, 0, 1) ], + 2) + let tests = testList "And" [ mixed ] + + module Add = + let simple = + t + "1 + 2" + E.Infix.Add.simple + (4, + [ RT.LoadVal(0, RT.DInt64 1L) + RT.LoadVal(1, RT.DInt64 2L) + RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ], + 3) + let tests = testList "Add" [ simple ] + + + let tests = testList "Infix" [ And.tests; Add.tests ] + + + module Lambda = module Identity = @@ -1032,6 +1092,7 @@ module Expr = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Infix.tests Lambda.tests Fns.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index b827f9403a..bb6b87b907 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -246,6 +246,28 @@ module Expressions = eRecordUpdate Records.simple [ "bonus", eBool false ] let fieldWithWrongType = eRecordUpdate Records.simple [ "key", eInt64 1 ] + module Infix = + module And = + let mixed = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool true) (eBool false) + let nested = eInfix (PT.Infix.BinOp PT.BinOpAnd) mixed (eBool true) + let bothTrue = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool true) (eBool true) + let bothFalse = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool false) (eBool false) + + module Or = + let mixed = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool true) (eBool false) + let nested = eInfix (PT.Infix.BinOp PT.BinOpOr) mixed (eBool true) + let bothTrue = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool true) (eBool true) + let bothFalse = eInfix (PT.Infix.BinOp PT.BinOpOr) (eBool false) (eBool false) + + module Add = + let simple = + eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 1) (eInt64 2) + + module Subtract = + let simple = + eInfix (PT.Infix.InfixFnCall PT.ArithmeticMinus) (eInt64 1) (eInt64 2) + + // TODO: test nested lambdas module Lambdas = From 7358ad0b139cb389108f552f81a0818ad297ddd7 Mon Sep 17 00:00:00 2001 From: Ocean Date: Tue, 17 Sep 2024 15:34:31 +0000 Subject: [PATCH 32/60] Uncomment many Builtins --- backend/src/BuiltinExecution/Builtin.fs | 56 +- .../BuiltinExecution/BuiltinExecution.fsproj | 54 +- backend/src/BuiltinExecution/Libs/Dict.fs | 88 +- backend/src/BuiltinExecution/Libs/Int128.fs | 18 +- backend/src/BuiltinExecution/Libs/Int16.fs | 24 +- backend/src/BuiltinExecution/Libs/Int32.fs | 12 +- backend/src/BuiltinExecution/Libs/Int8.fs | 22 +- backend/src/BuiltinExecution/Libs/Json.fs | 326 ++- backend/src/BuiltinExecution/Libs/List.fs | 372 +-- backend/src/BuiltinExecution/Libs/Packages.fs | 14 +- backend/src/BuiltinExecution/Libs/UInt128.fs | 12 +- backend/src/BuiltinExecution/Libs/UInt16.fs | 14 +- backend/src/BuiltinExecution/Libs/UInt32.fs | 14 +- backend/src/BuiltinExecution/Libs/UInt64.fs | 14 +- backend/src/BuiltinExecution/Libs/UInt8.fs | 14 +- backend/src/LibExecution/DvalDecoder.fs | 5 - backend/src/LibExecution/Interpreter.fs | 36 +- backend/src/LibExecution/LibExecution.fsproj | 2 +- backend/src/LibExecution/PackageIDs.fs | 16 +- backend/src/LibExecution/ProgramTypes.fs | 12 +- .../LibExecution/ProgramTypesToDarkTypes.fs | 2088 +++++++++-------- .../ProgramTypesToRuntimeTypes.fs | 28 +- backend/src/LibExecution/RuntimeTypes.fs | 144 +- .../LibExecution/RuntimeTypesToDarkTypes.fs | 680 ++---- backend/src/LibExecution/TypeChecker.fs | 103 +- backend/tests/TestUtils/TestUtils.fs | 4 +- backend/tests/Tests/TestValues.fs | 2 +- 27 files changed, 1957 insertions(+), 2217 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index c3db78cc04..0aab0b7bac 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -10,51 +10,53 @@ let fnRenames = // eg: fn "Http" "respond" 0, fn "Http" "response" 0 [] -let builtins httpConfig : Builtins = +let builtins + (httpConfig : Libs.HttpClient.Configuration) + (pm : LibExecution.ProgramTypes.PackageManager) + : Builtins = Builtin.combine [ Libs.NoModule.builtins - // Libs.Bool.builtins + Libs.Bool.builtins - // Libs.Int8.builtins - // Libs.UInt8.builtins - // Libs.Int16.builtins - // Libs.UInt16.builtins - // Libs.Int32.builtins - // Libs.UInt32.builtins + Libs.Int8.builtins + Libs.UInt8.builtins + Libs.Int16.builtins + Libs.UInt16.builtins + Libs.Int32.builtins + Libs.UInt32.builtins Libs.Int64.builtins - // Libs.UInt64.builtins - // Libs.Int128.builtins - // Libs.UInt128.builtins + Libs.UInt64.builtins + Libs.Int128.builtins + Libs.UInt128.builtins - // Libs.Float.builtins + Libs.Float.builtins - // Libs.Math.builtins + Libs.Math.builtins - // Libs.Bytes.builtins + Libs.Bytes.builtins - // Libs.Char.builtins - // Libs.String.builtins + Libs.Char.builtins + Libs.String.builtins Libs.List.builtins - // Libs.Dict.builtins + Libs.Dict.builtins - // Libs.DateTime.builtins - // Libs.Uuid.builtins + Libs.DateTime.builtins + Libs.Uuid.builtins - // Libs.Base64.builtins + Libs.Base64.builtins // Libs.Json.builtins - // Libs.AltJson.builtins + Libs.AltJson.builtins Libs.HttpClient.builtins httpConfig - // Libs.LanguageTools.builtins - //Libs.Parser.builtins + Libs.LanguageTools.builtins + Libs.Parser.builtins - // Libs.Crypto.builtins - // Libs.X509.builtins + Libs.Crypto.builtins + Libs.X509.builtins - //Libs.Packages.builtins pm - ] + Libs.Packages.builtins pm ] fnRenames diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 238d86c3ee..b130000b4b 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -12,48 +12,48 @@ - - - - - - - - + + + + + + + + - - - + + + - + - + - + - - + + - + - - + + - + - - + + - - + + - - + + - + diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index 05581b50a1..a389afe12b 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -100,7 +100,7 @@ let fns : List = This function is the opposite of ." fn = (function - | _, _, _, [ DList(_, l) ] -> + | _, vm, _, [ DList(listType, l) ] -> let f acc dv = match dv with | DTuple(DString k, value, []) -> Map.add k value acc @@ -110,7 +110,9 @@ let fns : List = [ "dval", dv ] List.fold f Map.empty l - |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + // CLEANUP: performance + |> Map.toList + |> TypeChecker.DvalCreator.dict vm.threadID listType |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -150,7 +152,7 @@ let fns : List = match result with | Some entries -> DDict(dictType, entries) - |> TypeChecker.DvalCreator.optionSome vmState.callStack optType + |> TypeChecker.DvalCreator.optionSome vmState.threadID optType |> Ply | None -> TypeChecker.DvalCreator.optionNone optType |> Ply | _ -> incorrectArgs ()) @@ -159,23 +161,23 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "dictGet" 0 - // typeParams = [] - // parameters = [ Param.make "dict" (TDict varA) ""; Param.make "key" TString "" ] - // returnType = TypeReference.option varA - // description = - // "If the contains , returns the corresponding value, - // wrapped in an : {{Some value}}. Otherwise, returns {{None}}." - // fn = - // (function - // | state, _, [ DDict(_vtTODO, o); DString s ] -> - // Map.find s o - // |> TypeChecker.DvalCreator.option vmState.callStack VT.unknownTODO - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "dictGet" 0 + typeParams = [] + parameters = [ Param.make "dict" (TDict varA) ""; Param.make "key" TString "" ] + returnType = TypeReference.option varA + description = + "If the contains , returns the corresponding value, + wrapped in an : {{Some value}}. Otherwise, returns {{None}}." + fn = + (function + | _, vm, _, [ DDict(_vtTODO, o); DString s ] -> + Map.find s o + |> TypeChecker.DvalCreator.option vm.threadID VT.unknownTODO + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } { name = fn "dictMember" 0 @@ -245,7 +247,7 @@ let fns : List = // "Evaluates {{fn key value}} on every entry in . Returns {{()}}." // fn = // (function - // | state, _, [ DDict(_, o); DFnVal b ] -> + // | state, _, _, [ DDict(_, o); DFnVal b ] -> // uply { // do! // Map.toList o @@ -285,7 +287,7 @@ let fns : List = // returned {{true}}." // fn = // (function - // | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> + // | state, _, _, [ DDict(_vtTODO, o); DFnVal b ] -> // uply { // let f (key : string) (data : Dval) : Ply = // uply { @@ -325,7 +327,7 @@ let fns : List = // This function combines and ." // fn = // (function - // | state, _, [ DDict(_vtTODO, o); DFnVal b ] -> + // | state, _, _, [ DDict(_vtTODO, o); DFnVal b ] -> // uply { // let f (key : string) (data : Dval) : Ply> = // uply { @@ -375,25 +377,27 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "dictMerge" 0 - // typeParams = [] - // parameters = - // [ Param.make "left" (TDict varA) ""; Param.make "right" (TDict varA) "" ] - // returnType = TDict varA - // description = - // "Returns a combined dictionary with both dictionaries' entries. - // If the same key exists in both and , - // it will have the value from ." - // fn = - // (function - // | _, _, _, [ DDict(_vtTODO1, l); DDict(_vtTODO2, r) ] -> - // Map.mergeFavoringRight l r - // |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "dictMerge" 0 + typeParams = [] + parameters = + [ Param.make "left" (TDict varA) ""; Param.make "right" (TDict varA) "" ] + returnType = TDict varA + description = + "Returns a combined dictionary with both dictionaries' entries. + If the same key exists in both and , + it will have the value from ." + fn = + (function + | _, vm, _, [ DDict(_vtTODO1, l); DDict(_vtTODO2, r) ] -> + Map.mergeFavoringRight l r + // CLEANUP: performance + |> Map.toList + |> TypeChecker.DvalCreator.dict vm.threadID VT.unknownTODO + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } { name = fn "dictSet" 0 diff --git a/backend/src/BuiltinExecution/Libs/Int128.fs b/backend/src/BuiltinExecution/Libs/Int128.fs index 1c83f7f04e..9f7e82877e 100644 --- a/backend/src/BuiltinExecution/Libs/Int128.fs +++ b/backend/src/BuiltinExecution/Libs/Int128.fs @@ -46,9 +46,9 @@ let fns : List = (function | _, vm, _, [ DInt128 v; DInt128 m ] -> if m = System.Int128.Zero then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else if m < System.Int128.Zero then - RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < System.Int128.Zero then m + result else result @@ -81,7 +81,7 @@ let fns : List = v % d |> DInt128 |> resultOk with e -> if d = System.Int128.Zero then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Exception.raiseInternal "unexpected failure case in Int128.remainder" @@ -105,7 +105,7 @@ let fns : List = let result = System.Int128.op_CheckedAddition (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -124,7 +124,7 @@ let fns : List = let result = System.Int128.op_CheckedSubtraction (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -144,7 +144,7 @@ let fns : List = let result = System.Int128.op_CheckedMultiply (a, b) Ply(DInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -167,9 +167,9 @@ let fns : List = Ply(DInt128(result)) with | :? System.DivideByZeroException -> - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID | :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -188,7 +188,7 @@ let fns : List = let result = System.Int128.op_CheckedUnaryNegation a Ply(DInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/Int16.fs b/backend/src/BuiltinExecution/Libs/Int16.fs index f1a9f9c376..a8bdaddf66 100644 --- a/backend/src/BuiltinExecution/Libs/Int16.fs +++ b/backend/src/BuiltinExecution/Libs/Int16.fs @@ -46,9 +46,9 @@ let fns : List = (function | _, vm, _, [ DInt16 v; DInt16 m ] -> if m = 0s then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else if m < 0s then - RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0s then m + result else result @@ -81,7 +81,7 @@ let fns : List = v % d |> DInt16 |> resultOk with e -> if d = 0s then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Exception.raiseInternal "unexpected failure case in Int16.remainder" @@ -105,7 +105,7 @@ let fns : List = let result = Checked.(+) a b Ply(DInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -124,7 +124,7 @@ let fns : List = let result = Checked.(-) a b Ply(DInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -143,7 +143,7 @@ let fns : List = let result = Checked.(*) a b Ply(DInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -163,11 +163,11 @@ let fns : List = | _, vm, _, [ DInt16 number; DInt16 exp ] -> (try if exp < 0s then - RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else (bigint number) ** (int exp) |> int16 |> DInt16 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -183,13 +183,13 @@ let fns : List = (function | _, vm, _, [ DInt16 a; DInt16 b ] -> if b = 0s then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else if a = int16 System.Int16.MinValue && b = -1s then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else let result = a / b if result < System.Int16.MinValue || result > System.Int16.MaxValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else Ply(DInt16(int16 result)) @@ -208,7 +208,7 @@ let fns : List = (function | _, vm, _, [ DInt16 a ] -> if a = System.Int16.MinValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else let result = -a Ply(DInt16 result) diff --git a/backend/src/BuiltinExecution/Libs/Int32.fs b/backend/src/BuiltinExecution/Libs/Int32.fs index b8a4b7a552..9d1e6feb29 100644 --- a/backend/src/BuiltinExecution/Libs/Int32.fs +++ b/backend/src/BuiltinExecution/Libs/Int32.fs @@ -46,9 +46,9 @@ let fns : List = (function | _, vm, _, [ DInt32 v; DInt32 m ] -> if m = 0 then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else if m < 0 then - RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0 then m + result else result @@ -81,7 +81,7 @@ let fns : List = v % d |> DInt32 |> resultOk with e -> if d = 0 then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Exception.raiseInternal "unexpected failure case in Int32.remainder" @@ -148,11 +148,11 @@ let fns : List = | _, vm, _, [ DInt32 number; DInt32 exp ] -> (try if exp < 0 then - RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else (bigint number) ** (int exp) |> int32 |> DInt32 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -168,7 +168,7 @@ let fns : List = (function | _, vm, _, [ DInt32 a; DInt32 b ] -> if b = 0 then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Ply(DInt32(a / b)) | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/Int8.fs b/backend/src/BuiltinExecution/Libs/Int8.fs index 722e2b07da..9158f122ff 100644 --- a/backend/src/BuiltinExecution/Libs/Int8.fs +++ b/backend/src/BuiltinExecution/Libs/Int8.fs @@ -46,9 +46,9 @@ let fns : List = (function | _, vm, _, [ DInt8 v; DInt8 m ] -> if m = 0y then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else if m < 0y then - RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0y then m + result else result @@ -81,7 +81,7 @@ let fns : List = v % d |> DInt8 |> resultOk with e -> if d = 0y then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else Exception.raiseInternal "unexpected failure case in Int8.remainder" @@ -104,7 +104,7 @@ let fns : List = try DInt8(Checked.(+) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -122,7 +122,7 @@ let fns : List = try DInt8(Checked.(-) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -140,7 +140,7 @@ let fns : List = try DInt8(Checked.(*) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -160,11 +160,11 @@ let fns : List = | _, vm, _, [ DInt8 number; DInt8 exp ] -> (try if exp < 0y then - RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.NegativeExponent |> RTE.Int |> raiseRTE vm.threadID else (bigint number) ** (int exp) |> int8 |> DInt8 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -180,11 +180,11 @@ let fns : List = (function | _, vm, _, [ DInt8 a; DInt8 b ] -> if b = int8 0 then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else let result = int a / int b if result < -128 || result > 127 then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else Ply(DInt8(int8 result)) | _ -> incorrectArgs ()) @@ -203,7 +203,7 @@ let fns : List = | _, vm, _, [ DInt8 a ] -> let result = -(int a) if result < -128 || result > 127 then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else Ply(DInt8(int8 result)) | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index d3b3d39e69..363f3b5f52 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -11,6 +11,7 @@ module VT = LibExecution.ValueType module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker module PackageIDs = LibExecution.PackageIDs +module RTE = RuntimeError // parsing @@ -61,27 +62,6 @@ type Utf8JsonWriter with } -module RuntimeError = - module RT2DT = LibExecution.RuntimeTypesToDarkTypes - - type Error = - /// In the future, we will add a trait to indicate types which can be serialized. For - /// now, we'll raise a RuntimeError instead if any of those types are present. - /// Helpfully, this allows us keep `serialize` from having to return an Error. - | UnsupportedType of TypeReference - - let toRuntimeError (e : Error) : RuntimeError = - let (caseName, fields) = - match e with - | UnsupportedType typ -> "UnsupportedType", [ RT2DT.TypeReference.toDT typ ] - - let typeName = - FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.Json.error - DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.jsonError - - let raiseUnsupportedType (callStack : CallStack) (typ : TypeReference) : 'a = - UnsupportedType(typ) |> toRuntimeError |> raiseRTE callStack - module JsonPath = module Part = @@ -110,13 +90,13 @@ module JsonPath = let rec serialize - (callStack : CallStack) + (threadId : ThreadID) (types : Types) (w : Utf8JsonWriter) (typ : TypeReference) (dv : Dval) : Ply = - let r = serialize callStack types w + let r = serialize threadId types w uply { match typ, dv with // basic types @@ -188,7 +168,7 @@ let rec serialize | TCustomType(Ok typeName, typeArgs), dval -> - match! Types.find typeName types with + match! Types.find types typeName with | None -> Exception.raiseInternal "Couldn't find type" [ "typeName", typeName ] | Some decl -> @@ -239,21 +219,25 @@ let rec serialize Types.substitute decl.typeParams typeArgs matchingFieldDef.typ r typ dval)) | _ -> - Exception.raiseInternal - "Expected a DRecord but got something else" - [ "actualDval", dval - "actualType", LibExecution.DvalReprDeveloper.toTypeName dval - "expectedType", typeName - "expectedFields", fields ] + //TODO + // Exception.raiseInternal + // "Expected a DRecord but got something else" + // [ "actualDval", dval + // "actualType", LibExecution.DvalReprDeveloper.toTypeName dval + // "expectedType", typeName + // "expectedFields", fields ] + RTE.MatchUnmatched |> raiseRTE threadId - | TCustomType(Error err, _typeArgs), _dval -> raiseRTE callStack err + + | TCustomType(Error err, _typeArgs), _dval -> raiseRTE threadId (RTE.NameResolution err) // Not supported | TVariable _, _ - | TFn _, _ - | TDB _, _ -> return! RuntimeError.raiseUnsupportedType callStack typ + | TFn _, _ -> + // | TDB _, _ + return! (RTE.Jsons.UnsupportedType typ) |> RTE.Json |> raiseRTE threadId // Exhaust the types @@ -276,13 +260,11 @@ let rec serialize | TDateTime, _ | TList _, _ | TTuple _, _ - | TDB _, _ + // | TDB _, _ | TCustomType _, _ | TDict _, _ -> // Internal error as this shouldn't get past the typechecker - Exception.raiseInternal - "Can't serialize this type/value combination" - [ "value", dv; "type", DString(LibExecution.DvalReprDeveloper.typeName typ) ] + RTE.Jsons.CannotSerializeTypeValueCombo(dv,typ) |> RTE.Json |> raiseRTE threadId } module ParseError = @@ -356,12 +338,12 @@ let raiseCantMatchWithType let parse - (callStack : CallStack) - (types : Types) + (threadId : ThreadID) + (_types : Types) (typ : TypeReference) (str : string) : Ply> = - let err = raiseError + // let err = raiseError let rec convert (typ : TypeReference) @@ -611,7 +593,7 @@ let parse |> Seq.mapi (fun i v -> convert nested (JsonPath.Part.Index i :: pathSoFar) v) |> Seq.toList |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.list callStack VT.unknownTODO) + |> Ply.map (TypeChecker.DvalCreator.list threadId VT.unknownTODO) | TTuple(t1, t2, rest), JsonValueKind.Array -> let values = j.EnumerateArray() |> Seq.toList @@ -637,134 +619,134 @@ let parse }) |> Seq.toList |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.dict VT.unknownTODO) - - | TCustomType(Ok typeName, typeArgs), jsonValueKind -> - uply { - match! Types.find typeName types with - | None -> - return - Exception.raiseInternal "Couldn't find type" [ "typeName", typeName ] - - | Some decl -> - match decl.definition with - | TypeDeclaration.Alias alias -> - let aliasType = Types.substitute decl.typeParams typeArgs alias - return! convert aliasType pathSoFar j - - | TypeDeclaration.Enum cases -> - if jsonValueKind <> JsonValueKind.Object then - do! raiseCantMatchWithType typ j pathSoFar - - let enumerated = - j.EnumerateObject() - |> Seq.map (fun jp -> (jp.Name, jp.Value)) - |> Seq.toList - - match enumerated with - | [ (caseName, j) ] -> - let matchingCase = - match cases |> NEList.find (fun c -> c.name = caseName) with - | Some c -> c - | None -> - err (ParseError.EnumInvalidCasename(typ, caseName, pathSoFar)) - - let j = j.EnumerateArray() |> Seq.toList - - - let casePath = JsonPath.Part.Field caseName :: pathSoFar - - // If the field count is off, process whatever fields make sense - // and then error afterwards - let expectedFieldCount = List.length matchingCase.fields - let actualFieldCount = List.length j - let maxFields = min expectedFieldCount actualFieldCount - let shortExpectedFields = List.take maxFields matchingCase.fields - let shortActualFields = List.take maxFields j - - let! fields = - List.zip shortExpectedFields shortActualFields - |> List.mapWithIndex (fun i (typ, j) -> - let path = JsonPath.Part.Index i :: casePath - let typ = Types.substitute decl.typeParams typeArgs typ - convert typ path j) - |> Ply.List.flatten - - if expectedFieldCount > actualFieldCount then - let index = actualFieldCount // one higher than greatest index - let expectedType = - List.getAt index matchingCase.fields - |> Exception.unwrapOptionInternal - "Can't find expected field" - [ "index", index - "expectedFields", matchingCase.fields - "actualFields", j ] - return - err (ParseError.EnumMissingField(expectedType, index, casePath)) - else if expectedFieldCount < actualFieldCount then - let index = expectedFieldCount // one higher than greatest index - let fieldJson = - List.getAt index j - |> Exception.unwrapOptionInternal - "Can't find actual field" - [ "index", index - "expectedFields", matchingCase.fields - "actualFields", j ] - let path = JsonPath.Part.Index index :: casePath - return err (ParseError.EnumExtraField(fieldJson.GetRawText(), path)) - else - return! - TypeChecker.DvalCreator.enum typeName typeName caseName fields - - | [] -> return raiseCantMatchWithType typ j pathSoFar - | cases -> - let caseNames = List.map Tuple2.first cases - return err (ParseError.EnumTooManyCases(typ, caseNames, pathSoFar)) - - | TypeDeclaration.Record fields -> - if jsonValueKind <> JsonValueKind.Object then - do! raiseCantMatchWithType typ j pathSoFar - - let enumerated = j.EnumerateObject() |> Seq.toList - - // We allow the user to add extra fields to a record, but we don't allow - // fields to be omitted, so use the definition to get the expected fields - // and then look at the json to match it - let! fields = - fields - |> NEList.toList - |> List.map (fun def -> - uply { - let correspondingValue = - let matchingFieldDef = - // TODO: allow Option<>al fields to be omitted - enumerated |> List.filter (fun v -> v.Name = def.name) - - match matchingFieldDef with - | [] -> err (ParseError.RecordMissingField(def.name, pathSoFar)) - | [ matchingFieldDef ] -> matchingFieldDef.Value - | _ -> - err (ParseError.RecordDuplicateField(def.name, pathSoFar)) - - let typ = Types.substitute decl.typeParams typeArgs def.typ - let! converted = - convert - typ - (JsonPath.Part.Field def.name :: pathSoFar) - correspondingValue - return (def.name, converted) - }) - |> Ply.List.flatten - - return! TypeChecker.DvalCreator.record callStack typeName fields - } + |> Ply.map (TypeChecker.DvalCreator.dict threadId VT.unknownTODO) + + // | TCustomType(Ok typeName, typeArgs), jsonValueKind -> + // uply { + // match! Types.find types typeName with + // | None -> + // return + // Exception.raiseInternal "Couldn't find type" [ "typeName", typeName ] + + // | Some decl -> + // match decl.definition with + // | TypeDeclaration.Alias alias -> + // let aliasType = Types.substitute decl.typeParams typeArgs alias + // return! convert aliasType pathSoFar j + + // | TypeDeclaration.Enum cases -> + // if jsonValueKind <> JsonValueKind.Object then + // do! raiseCantMatchWithType typ j pathSoFar + + // let enumerated = + // j.EnumerateObject() + // |> Seq.map (fun jp -> (jp.Name, jp.Value)) + // |> Seq.toList + + // match enumerated with + // | [ (caseName, j) ] -> + // let matchingCase = + // match cases |> NEList.find (fun c -> c.name = caseName) with + // | Some c -> c + // | None -> + // err (ParseError.EnumInvalidCasename(typ, caseName, pathSoFar)) + + // let j = j.EnumerateArray() |> Seq.toList + + + // let casePath = JsonPath.Part.Field caseName :: pathSoFar + + // // If the field count is off, process whatever fields make sense + // // and then error afterwards + // let expectedFieldCount = List.length matchingCase.fields + // let actualFieldCount = List.length j + // let maxFields = min expectedFieldCount actualFieldCount + // let shortExpectedFields = List.take maxFields matchingCase.fields + // let shortActualFields = List.take maxFields j + + // let! fields = + // List.zip shortExpectedFields shortActualFields + // |> List.mapWithIndex (fun i (typ, j) -> + // let path = JsonPath.Part.Index i :: casePath + // let typ = Types.substitute decl.typeParams typeArgs typ + // convert typ path j) + // |> Ply.List.flatten + + // if expectedFieldCount > actualFieldCount then + // let index = actualFieldCount // one higher than greatest index + // let expectedType = + // List.getAt index matchingCase.fields + // |> Exception.unwrapOptionInternal + // "Can't find expected field" + // [ "index", index + // "expectedFields", matchingCase.fields + // "actualFields", j ] + // return + // err (ParseError.EnumMissingField(expectedType, index, casePath)) + // else if expectedFieldCount < actualFieldCount then + // let index = expectedFieldCount // one higher than greatest index + // let fieldJson = + // List.getAt index j + // |> Exception.unwrapOptionInternal + // "Can't find actual field" + // [ "index", index + // "expectedFields", matchingCase.fields + // "actualFields", j ] + // let path = JsonPath.Part.Index index :: casePath + // return err (ParseError.EnumExtraField(fieldJson.GetRawText(), path)) + // else + // return! + // TypeChecker.DvalCreator.enum typeName typeName caseName fields + + // | [] -> return raiseCantMatchWithType typ j pathSoFar + // | cases -> + // let caseNames = List.map Tuple2.first cases + // return err (ParseError.EnumTooManyCases(typ, caseNames, pathSoFar)) + + // | TypeDeclaration.Record fields -> + // if jsonValueKind <> JsonValueKind.Object then + // do! raiseCantMatchWithType typ j pathSoFar + + // let enumerated = j.EnumerateObject() |> Seq.toList + + // // We allow the user to add extra fields to a record, but we don't allow + // // fields to be omitted, so use the definition to get the expected fields + // // and then look at the json to match it + // let! fields = + // fields + // |> NEList.toList + // |> List.map (fun def -> + // uply { + // let correspondingValue = + // let matchingFieldDef = + // // TODO: allow Option<>al fields to be omitted + // enumerated |> List.filter (fun v -> v.Name = def.name) + + // match matchingFieldDef with + // | [] -> err (ParseError.RecordMissingField(def.name, pathSoFar)) + // | [ matchingFieldDef ] -> matchingFieldDef.Value + // | _ -> + // err (ParseError.RecordDuplicateField(def.name, pathSoFar)) + + // let typ = Types.substitute decl.typeParams typeArgs def.typ + // let! converted = + // convert + // typ + // (JsonPath.Part.Field def.name :: pathSoFar) + // correspondingValue + // return (def.name, converted) + // }) + // |> Ply.List.flatten + + // return! TypeChecker.DvalCreator.record callStack typeName fields + // } // Explicitly not supported | TVariable _, _ | TFn _, _ //| TDB _, _ - -> RuntimeError.raiseUnsupportedType callStack typ + -> (RTE.Jsons.UnsupportedType typ) |> RTE.Json |> raiseRTE threadId // RuntimeError.raiseUnsupportedType threadId typ // exhaust TypeReferences @@ -816,15 +798,15 @@ let fns : List = description = "Serializes a Dark value to a JSON string." fn = (function - | state, [ typeToSerializeAs ], [ arg ] -> + | exeState, vm, [ typeToSerializeAs ], [ arg ] -> uply { // TODO: somehow collect list of TVariable -> TypeReference // "'b = Int", // so we can Json.serialize<'b>, if 'b is in the surrounding context - let types = ExecutionState.availableTypes state + let types = exeState.types let! response = writeJson (fun w -> - serialize state.tracing.callStack types w typeToSerializeAs arg) + serialize vm.threadID types w typeToSerializeAs arg) return DString response } | _ -> incorrectArgs ()) @@ -844,18 +826,18 @@ let fns : List = "Parses a JSON string as a Dark value, matching the type " fn = (function - | state, [ typeArg ], [ DString arg ] -> - let callStack = state.tracing.callStack + | exeState, vm, [ typeArg ], [ DString arg ] -> + let threadID = vm.threadID let okType = VT.unknownTODO // "a" let errType = KTCustomType(ParseError.typeName, []) |> VT.known - let resultOk = TypeChecker.DvalCreator.resultOk callStack okType errType + let resultOk = TypeChecker.DvalCreator.Result.ok threadID okType errType let resultError = - TypeChecker.DvalCreator.resultError callStack okType errType + TypeChecker.DvalCreator.Result.error threadID okType errType - let types = ExecutionState.availableTypes state + let types = exeState.types uply { - match! parse callStack types typeArg arg with + match! parse threadID 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 e7318c9d79..6297239c14 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -13,150 +13,156 @@ module TypeChecker = LibExecution.TypeChecker // CLEANUP something like type ComparatorResult = Higher | Lower | Same // rather than 0/1/-2 -// module DvalComparator = -// let rec compareDval (dv1 : Dval) (dv2 : Dval) : int = -// match dv1, dv2 with -// | DUnit, DUnit -> 0 - -// | DBool b1, DBool b2 -> compare b1 b2 - -// | DInt8 i1, DInt8 i2 -> compare i1 i2 -// | DUInt8 i1, DUInt8 i2 -> compare i1 i2 -// | DInt16 i1, DInt16 i2 -> compare i1 i2 -// | DUInt16 i1, DUInt16 i2 -> compare i1 i2 -// | DInt32 i1, DInt32 i2 -> compare i1 i2 -// | DUInt32 i1, DUInt32 i2 -> compare i1 i2 -// | DInt64 i1, DInt64 i2 -> compare i1 i2 -// | DUInt64 i1, DUInt64 i2 -> compare i1 i2 -// | DInt128 i1, DInt128 i2 -> compare i1 i2 -// | DUInt128 i1, DUInt128 i2 -> compare i1 i2 - -// | DFloat f1, DFloat f2 -> compare f1 f2 - -// | DChar c1, DChar c2 -> compare c1 c2 -// | DString s1, DString s2 -> compare s1 s2 - -// | DDateTime dt1, DDateTime dt2 -> compare dt1 dt2 - -// | DUuid u1, DUuid u2 -> compare u1 u2 - -// | DList(_, l1), DList(_, l2) -> compareLists l1 l2 - -// | DTuple(a1, b1, l1), DTuple(a2, b2, l2) -> -// compareLists (a1 :: b1 :: l1) (a2 :: b2 :: l2) - - -// | DDict(_vtTODO1, o1), DDict(_vtTODO2, o2) -> -// compareMaps (Map.toList o1) (Map.toList o2) - -// | DRecord(tn1, _, _typeArgsTODO1, o1), DRecord(tn2, _, _typeArgsTODO2, o2) -> -// let c = compare tn1 tn2 -// if c = 0 then compareMaps (Map.toList o1) (Map.toList o2) else c - -// | DEnum(typeName1, _, _typeArgsTODO1, case1, fields1), -// DEnum(typeName2, _, _typeArgsTODO2, case2, fields2) -> -// let c = compare typeName1 typeName2 -// if c = 0 then -// let c = compare case1 case2 -// if c = 0 then compareLists fields1 fields2 else c -// else -// c - -// // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> -// // let l1' = NEList.toList l1.parameters -// // let l2' = NEList.toList l2.parameters -// // let c = compareLetPatternsLists l1' l2' -// // if c = 0 then compareExprs l1.body l2.body else c - -// //| DDB name1, DDB name2 -> compare name1 name2 - -// // exhaustiveness check -// | DUnit, _ -// | DBool _, _ -// | DInt8 _, _ -// | DUInt8 _, _ -// | DInt16 _, _ -// | DUInt16 _, _ -// | DInt32 _, _ -// | DUInt32 _, _ -// | DInt64 _, _ -// | DUInt64 _, _ -// | DInt128 _, _ -// | DUInt128 _, _ -// | DFloat _, _ -// | DChar _, _ -// | DString _, _ -// | DList _, _ -// | DDict _, _ -// | DTuple _, _ -// | DDateTime _, _ -// | DUuid _, _ -// | DRecord _, _ -// | DEnum _, _ -// | DFnVal _, _ -// //| DDB _, _ -// -> -// // TODO: Feels like this should hook into typechecker and ValueTypes somehow -// raiseUntargetedString "Comparing different types" [ "dv1", dv1; "dv2", dv2 ] - - -// // and compareLetPatternsLists (l1 : List) (l2 : List) : int = -// // let rec equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : int = -// // match pattern1, pattern2 with -// // | LPVariable(_, name1), LPVariable(_, name2) -> compare name1 name2 -// // | LPUnit _, LPUnit _ -> 0 - -// // | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> -// // let all = first :: second :: theRest -// // let all' = first' :: second' :: theRest' -// // if all.Length <> all'.Length then -// // compare all.Length all'.Length -// // else -// // let c = equalsLetPattern first first' -// // if c = 0 then -// // let c = equalsLetPattern second second' -// // if c = 0 then compareLetPatternsLists theRest theRest' else c -// // else -// // c - -// // | LPTuple _, LPVariable _ -> 1 -// // | LPTuple _, LPUnit _ -> 1 -// // | LPUnit _, LPVariable _ -> -1 -// // | LPVariable _, LPUnit _ -> 1 -// // | LPVariable _, LPTuple _ -> -1 -// // | _, _ -> -1 - -// // match l1, l2 with -// // | [], [] -> 0 -// // | [], _ -> -1 -// // | _, [] -> 1 -// // | h1 :: t1, h2 :: t2 -> -// // let c = equalsLetPattern h1 h2 -// // if c = 0 then compareLetPatternsLists t1 t2 else c - - - -// and compareLists (l1 : List) (l2 : List) : int = -// match l1, l2 with -// | [], [] -> 0 -// | [], _ -> -1 -// | _, [] -> 1 -// | h1 :: t1, h2 :: t2 -> -// let c = compareDval h1 h2 -// if c = 0 then compareLists t1 t2 else c - -// and compareMaps (o1 : List) (o2 : List) : int = -// match o1, o2 with -// | [], [] -> 0 -// | [], _ -> -1 -// | _, [] -> 1 -// | (k1, v1) :: t1, (k2, v2) :: t2 -> -// let c = compare k1 k2 -// if c = 0 then -// let c = compareDval v1 v2 -// if c = 0 then compareMaps t1 t2 else c -// else -// c +module DvalComparator = + // should this take a vmstate? + let rec compareDval (dv1 : Dval) (dv2 : Dval) : int = + match dv1, dv2 with + | DUnit, DUnit -> 0 + + | DBool b1, DBool b2 -> compare b1 b2 + + | DInt8 i1, DInt8 i2 -> compare i1 i2 + | DUInt8 i1, DUInt8 i2 -> compare i1 i2 + | DInt16 i1, DInt16 i2 -> compare i1 i2 + | DUInt16 i1, DUInt16 i2 -> compare i1 i2 + | DInt32 i1, DInt32 i2 -> compare i1 i2 + | DUInt32 i1, DUInt32 i2 -> compare i1 i2 + | DInt64 i1, DInt64 i2 -> compare i1 i2 + | DUInt64 i1, DUInt64 i2 -> compare i1 i2 + | DInt128 i1, DInt128 i2 -> compare i1 i2 + | DUInt128 i1, DUInt128 i2 -> compare i1 i2 + + | DFloat f1, DFloat f2 -> compare f1 f2 + + | DChar c1, DChar c2 -> compare c1 c2 + | DString s1, DString s2 -> compare s1 s2 + + | DDateTime dt1, DDateTime dt2 -> compare dt1 dt2 + + | DUuid u1, DUuid u2 -> compare u1 u2 + + | DList(_, l1), DList(_, l2) -> compareLists l1 l2 + + | DTuple(a1, b1, l1), DTuple(a2, b2, l2) -> + compareLists (a1 :: b1 :: l1) (a2 :: b2 :: l2) + + + | DDict(_vtTODO1, o1), DDict(_vtTODO2, o2) -> + compareMaps (Map.toList o1) (Map.toList o2) + + | DRecord(tn1, _, _typeArgsTODO1, o1), DRecord(tn2, _, _typeArgsTODO2, o2) -> + let c = compare tn1 tn2 + if c = 0 then compareMaps (Map.toList o1) (Map.toList o2) else c + + | DEnum(typeName1, _, _typeArgsTODO1, case1, fields1), + DEnum(typeName2, _, _typeArgsTODO2, case2, fields2) -> + let c = compare typeName1 typeName2 + if c = 0 then + let c = compare case1 case2 + if c = 0 then compareLists fields1 fields2 else c + else + c + + // | DApplicable app1, DApplicable app2 -> + // match app1, app2 with + // | AppLambda l1, AppLambda l2 -> //TODO + // | AppNamedFn n1, AppNamedFn n2 -> //TODO + // | _ -> //TODO + + // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> + // let l1' = NEList.toList l1.parameters + // let l2' = NEList.toList l2.parameters + // let c = compareLetPatternsLists l1' l2' + // if c = 0 then compareExprs l1.body l2.body else c + + //| DDB name1, DDB name2 -> compare name1 name2 + + // exhaustiveness check + | DUnit, _ + | DBool _, _ + | DInt8 _, _ + | DUInt8 _, _ + | DInt16 _, _ + | DUInt16 _, _ + | DInt32 _, _ + | DUInt32 _, _ + | DInt64 _, _ + | DUInt64 _, _ + | DInt128 _, _ + | DUInt128 _, _ + | DFloat _, _ + | DChar _, _ + | DString _, _ + | DList _, _ + | DDict _, _ + | DTuple _, _ + | DDateTime _, _ + | DUuid _, _ + | DRecord _, _ + | DEnum _, _ + | DApplicable _, _ -> + //| DDB _, _ + // TODO: Feels like this should hook into typechecker and ValueTypes somehow + RuntimeError.Error.EqualityCheckOnIncompatibleTypes (Dval.toValueType dv1, Dval.toValueType dv2) |> raiseUntargetedRTE + + + // // and compareLetPatternsLists (l1 : List) (l2 : List) : int = + // // let rec equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : int = + // // match pattern1, pattern2 with + // // | LPVariable(_, name1), LPVariable(_, name2) -> compare name1 name2 + // // | LPUnit _, LPUnit _ -> 0 + + // // | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> + // // let all = first :: second :: theRest + // // let all' = first' :: second' :: theRest' + // // if all.Length <> all'.Length then + // // compare all.Length all'.Length + // // else + // // let c = equalsLetPattern first first' + // // if c = 0 then + // // let c = equalsLetPattern second second' + // // if c = 0 then compareLetPatternsLists theRest theRest' else c + // // else + // // c + + // // | LPTuple _, LPVariable _ -> 1 + // // | LPTuple _, LPUnit _ -> 1 + // // | LPUnit _, LPVariable _ -> -1 + // // | LPVariable _, LPUnit _ -> 1 + // // | LPVariable _, LPTuple _ -> -1 + // // | _, _ -> -1 + + // // match l1, l2 with + // // | [], [] -> 0 + // // | [], _ -> -1 + // // | _, [] -> 1 + // // | h1 :: t1, h2 :: t2 -> + // // let c = equalsLetPattern h1 h2 + // // if c = 0 then compareLetPatternsLists t1 t2 else c + + + + and compareLists (l1 : List) (l2 : List) : int = + match l1, l2 with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | h1 :: t1, h2 :: t2 -> + let c = compareDval h1 h2 + if c = 0 then compareLists t1 t2 else c + + and compareMaps (o1 : List) (o2 : List) : int = + match o1, o2 with + | [], [] -> 0 + | [], _ -> -1 + | _, [] -> 1 + | (k1, v1) :: t1, (k2, v2) :: t2 -> + let c = compare k1 k2 + if c = 0 then + let c = compareDval v1 v2 + if c = 0 then compareMaps t1 t2 else c + else + c // //and compareExprs (_e1 : Expr) (_e2 : Expr) : int = 0 // CLEANUP @@ -333,49 +339,49 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "listUnique" 0 - // typeParams = [] - // parameters = [ Param.make "list" (TList varA) "" ] - // returnType = TList varA - // description = - // "Returns the passed list, with only unique values. - // Only one of each value will be returned, but the - // order will not be maintained." - // fn = - // (function - // | _, _, _, [ DList(vt, l) ] -> - // List.distinct l - // |> List.sortWith DvalComparator.compareDval - // |> fun l -> DList(vt, l) - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "listUnique" 0 + typeParams = [] + parameters = [ Param.make "list" (TList varA) "" ] + returnType = TList varA + description = + "Returns the passed list, with only unique values. + Only one of each value will be returned, but the + order will not be maintained." + fn = + (function + | _, _, _, [ DList(vt, l) ] -> + List.distinct l + |> List.sortWith DvalComparator.compareDval + |> fun l -> DList(vt, l) + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } - // { name = fn "listSort" 0 - // typeParams = [] - // parameters = [ Param.make "list" (TList varA) "" ] - // returnType = TList varA - // description = - // "Returns a copy of with every value sorted in ascending order. + { name = fn "listSort" 0 + typeParams = [] + parameters = [ Param.make "list" (TList varA) "" ] + returnType = TList varA + description = + "Returns a copy of with every value sorted in ascending order. - // Use this if the values have types Dark knows how to sort. + Use this if the values have types Dark knows how to sort. - // Consider or if you need more - // control over the sorting process." - // fn = - // (function - // | _, _, _, [ DList(vt, list) ] -> - // list - // |> List.sortWith DvalComparator.compareDval - // |> (fun l -> DList(vt, l)) - // |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } + Consider or if you need more + control over the sorting process." + fn = + (function + | _, _, _, [ DList(vt, list) ] -> + list + |> List.sortWith DvalComparator.compareDval + |> (fun l -> DList(vt, l)) + |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotYetImplemented + previewable = Pure + deprecated = NotDeprecated } // { name = fn "listSortBy" 0 diff --git a/backend/src/BuiltinExecution/Libs/Packages.fs b/backend/src/BuiltinExecution/Libs/Packages.fs index 3af64112cb..4b3ba0ec1e 100644 --- a/backend/src/BuiltinExecution/Libs/Packages.fs +++ b/backend/src/BuiltinExecution/Libs/Packages.fs @@ -53,7 +53,7 @@ let fns (pm : PT.PackageManager) : List = description = "Returns high-level stats of what's in the Package Manager" fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> uply { // TODO: real #s (requires updates in RuntimeTypes and some other places, I think?) let fields = @@ -76,7 +76,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTUuid (function - | _, _, [ DString name ] -> + | _, _, _, [ DString name ] -> uply { let n = parseGenericName name let name = PT.PackageType.name n.owner n.modules n.name @@ -98,7 +98,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTCustomType(PT2DT.PackageType.typeName, []) (function - | _, _, [ DUuid id ] -> + | _, _, _, [ DUuid id ] -> uply { match! pm.getType id with | Some f -> return f |> PT2DT.PackageType.toDT |> Dval.optionSome optType @@ -120,7 +120,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTUuid (function - | _, _, [ DString name ] -> + | _, _, _, [ DString name ] -> uply { let n = parseGenericName name let name = PT.PackageConstant.name n.owner n.modules n.name @@ -142,7 +142,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTCustomType(PT2DT.PackageConstant.typeName, []) (function - | _, _, [ DUuid id ] -> + | _, _, _, [ DUuid id ] -> uply { match! pm.getConstant id with | Some f -> @@ -165,7 +165,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTUuid (function - | _, _, [ DString name ] -> + | _, _, _, [ DString name ] -> uply { let n = parseGenericName name let name = PT.PackageFn.name n.owner n.modules n.name @@ -187,7 +187,7 @@ let fns (pm : PT.PackageManager) : List = fn = let optType = KTCustomType(PT2DT.PackageFn.typeName, []) (function - | _, _, [ DUuid id ] -> + | _, _, _, [ DUuid id ] -> uply { match! pm.getFn id with | Some f -> return f |> PT2DT.PackageFn.toDT |> Dval.optionSome optType diff --git a/backend/src/BuiltinExecution/Libs/UInt128.fs b/backend/src/BuiltinExecution/Libs/UInt128.fs index 722ec4812f..3cab17fe7d 100644 --- a/backend/src/BuiltinExecution/Libs/UInt128.fs +++ b/backend/src/BuiltinExecution/Libs/UInt128.fs @@ -46,7 +46,7 @@ let fns : List = (function | _, vm, _, [ DUInt128 v; DUInt128 m ] -> if m = System.UInt128.Zero then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < System.UInt128.Zero then m + result else result @@ -69,7 +69,7 @@ let fns : List = let result = System.UInt128.op_CheckedAddition (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -88,7 +88,7 @@ let fns : List = let result = System.UInt128.op_CheckedSubtraction (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -108,7 +108,7 @@ let fns : List = let result = System.UInt128.op_CheckedMultiply (a, b) Ply(DUInt128(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -131,9 +131,9 @@ let fns : List = Ply(DUInt128(result)) with | :? System.DivideByZeroException -> - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID | :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/BuiltinExecution/Libs/UInt16.fs b/backend/src/BuiltinExecution/Libs/UInt16.fs index 8c1617c239..5a05a9242b 100644 --- a/backend/src/BuiltinExecution/Libs/UInt16.fs +++ b/backend/src/BuiltinExecution/Libs/UInt16.fs @@ -47,7 +47,7 @@ let fns : List = (function | _, vm, _, [ DUInt16 v; DUInt16 m ] -> if m = 0us then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID |> Ply else let result = v % m let result = if result < 0us then m + result else result @@ -70,7 +70,7 @@ let fns : List = let result = Checked.(+) a b Ply(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -90,7 +90,7 @@ let fns : List = let result = Checked.(-) a b Ply(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -110,7 +110,7 @@ let fns : List = let result = Checked.(*) a b Ply(DUInt16(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -132,7 +132,7 @@ let fns : List = (try (bigint number) ** (int exp) |> uint16 |> DUInt16 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -148,13 +148,13 @@ let fns : List = (function | _, vm, _, [ DUInt16 a; DUInt16 b ] -> if b = 0us then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID |> Ply else let result = a / b if result < System.UInt16.MinValue || result > System.UInt16.MaxValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply else Ply(DUInt16(uint16 result)) diff --git a/backend/src/BuiltinExecution/Libs/UInt32.fs b/backend/src/BuiltinExecution/Libs/UInt32.fs index a1fe36520d..c955f4b885 100644 --- a/backend/src/BuiltinExecution/Libs/UInt32.fs +++ b/backend/src/BuiltinExecution/Libs/UInt32.fs @@ -47,7 +47,7 @@ let fns : List = (function | _, vm, _, [ DUInt32 v; DUInt32 m ] -> if m = 0ul then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0ul then m + result else result @@ -70,7 +70,7 @@ let fns : List = let result = Checked.(+) a b Ply(DUInt32(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -89,7 +89,7 @@ let fns : List = let result = Checked.(-) a b Ply(DUInt32(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -108,7 +108,7 @@ let fns : List = let result = Checked.(*) a b Ply(DUInt32(result)) with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -129,7 +129,7 @@ let fns : List = (try (bigint number) ** (int exp) |> uint32 |> DUInt32 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -145,13 +145,13 @@ let fns : List = (function | _, vm, _, [ DUInt32 a; DUInt32 b ] -> if b = 0ul then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else let result = a / b if result < System.UInt32.MinValue || result > System.UInt32.MaxValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else Ply(DUInt32(uint32 result)) diff --git a/backend/src/BuiltinExecution/Libs/UInt64.fs b/backend/src/BuiltinExecution/Libs/UInt64.fs index 6ad3846b89..9496113a24 100644 --- a/backend/src/BuiltinExecution/Libs/UInt64.fs +++ b/backend/src/BuiltinExecution/Libs/UInt64.fs @@ -47,7 +47,7 @@ let fns : List = (function | _, vm, _, [ DUInt64 v; DUInt64 m ] -> if m = 0UL then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID else let result = v % m let result = if result < 0UL then m + result else result @@ -69,7 +69,7 @@ let fns : List = try DUInt64(Checked.(+) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -87,7 +87,7 @@ let fns : List = try DUInt64(Checked.(-) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -105,7 +105,7 @@ let fns : List = try DUInt64(Checked.(*) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -126,7 +126,7 @@ let fns : List = (try (bigint number) ** (int exp) |> uint64 |> DUInt64 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -142,13 +142,13 @@ let fns : List = (function | _, vm, _, [ DUInt64 a; DUInt64 b ] -> if b = 0UL then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID else let result = a / b if result < System.UInt64.MinValue || result > System.UInt64.MaxValue then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID else Ply(DUInt64(result)) | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinExecution/Libs/UInt8.fs b/backend/src/BuiltinExecution/Libs/UInt8.fs index a30063cca7..6ef4c23ff6 100644 --- a/backend/src/BuiltinExecution/Libs/UInt8.fs +++ b/backend/src/BuiltinExecution/Libs/UInt8.fs @@ -47,7 +47,7 @@ let fns : List = (function | _, vm, _, [ DUInt8 v; DUInt8 m ] -> if m = 0uy then - RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.ZeroModulus |> RTE.Int |> raiseRTE vm.threadID |> Ply else let result = v % m let result = if result < 0uy then m + result else result @@ -69,7 +69,7 @@ let fns : List = try DUInt8(Checked.(+) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -87,7 +87,7 @@ let fns : List = try DUInt8(Checked.(-) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -105,7 +105,7 @@ let fns : List = try DUInt8(Checked.(*) a b) |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -126,7 +126,7 @@ let fns : List = (try (bigint number) ** (int exp) |> uint8 |> DUInt8 |> Ply with :? System.OverflowException -> - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply) + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -142,11 +142,11 @@ let fns : List = (function | _, vm, _, [ DUInt8 a; DUInt8 b ] -> if b = 0uy then - RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.DivideByZeroError |> RTE.Int |> raiseRTE vm.threadID |> Ply else let result = int a / int b if result < 0 || result > 255 then - RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.callStack |> Ply + RTE.Ints.OutOfRange |> RTE.Int |> raiseRTE vm.threadID |> Ply else Ply(DUInt8(uint8 result)) | _ -> incorrectArgs ()) diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/LibExecution/DvalDecoder.fs index 0200c4528b..3c5d770837 100644 --- a/backend/src/LibExecution/DvalDecoder.fs +++ b/backend/src/LibExecution/DvalDecoder.fs @@ -115,11 +115,6 @@ let field (name : string) (m : DvalMap) : Dval = | Some dv -> dv | None -> Exception.raiseInternal $"Expected '{name}' field" [] -// let stringField (name : string) (m : DvalMap) : string = -// m -// |> field name -// |> getString -// |> unwrap $"Expected '{name}' field to be a string" [] // let listField (name : string) (m : DvalMap) : List = // m diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index fd83873bba..75aba57f4b 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -102,8 +102,30 @@ let rec checkAndExtractMatchPattern | false, _ -> false, [] | _ -> false, [] + | MPEnum(caseName, fields), DEnum(_, _, _, caseNameActual, fieldsActual) -> + if caseName = caseNameActual then rList fields fieldsActual else false, [] + // Dval didn't match the pattern even in a basic sense - | _ -> false, [] + | MPVariable _, _ + | MPUnit, _ + | MPBool _, _ + | MPInt64 _, _ + | MPUInt64 _, _ + | MPInt8 _, _ + | MPUInt8 _, _ + | MPInt16 _, _ + | MPUInt16 _, _ + | MPInt32 _, _ + | MPUInt32 _, _ + | MPInt128 _, _ + | MPUInt128 _, _ + | MPChar _, _ + | MPString _, _ + | MPFloat _, _ + | MPTuple _, _ + | MPListCons _, _ + | MPList _, _ + | MPEnum _, _ -> false, [] let execute (exeState : ExecutionState) (vm : VMState) : Ply = @@ -309,10 +331,18 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = |> raiseRTE // -- Enums -- - | CreateEnum(enumReg, typeName, _typeArgs, caseName, fields) -> + | CreateEnum(enumReg, typeName, typeArgs, caseName, fields) -> // TODO: safe dval creation let fields = fields |> List.map (fun (valueReg) -> registers[valueReg]) - registers[enumReg] <- DEnum(typeName, typeName, [], caseName, fields) + let! enum = + TypeChecker.DvalCreator.enum + vm.threadID + exeState.types + typeName + typeArgs + caseName + fields + registers[enumReg] <- enum | CreateLambda(lambdaReg, impl) -> vm.lambdas <- Map.add (currentFrame.context, impl.exprId) impl vm.lambdas diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index e7524c6e73..fa2ccfa920 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -40,7 +40,7 @@ - + diff --git a/backend/src/LibExecution/PackageIDs.fs b/backend/src/LibExecution/PackageIDs.fs index a23641e3a0..b3115165ba 100644 --- a/backend/src/LibExecution/PackageIDs.fs +++ b/backend/src/LibExecution/PackageIDs.fs @@ -131,11 +131,11 @@ module Type = // let errorMessage = // p [ "Error" ] "ErrorMessage" "3e526964-304f-46a8-919c-6d65bb6ff167" - // module NameResolution = - // let private p addl = p ("NameResolution" :: addl) - // let errorType = p [] "ErrorType" "ada30799-1227-4902-b580-76bca80c9e92" - // let nameType = p [] "NameType" "aafe54e1-d970-4ce0-81a1-1569af86671f" - // let error = p [] "Error" "85dea116-469e-41ca-a166-dc97f5e4fb1d" + module NameResolution = + let private p addl = p ("NameResolution" :: addl) + let errorType = p [] "ErrorType" "ada30799-1227-4902-b580-76bca80c9e92" + let nameType = p [] "NameType" "aafe54e1-d970-4ce0-81a1-1569af86671f" + let error = p [] "Error" "85dea116-469e-41ca-a166-dc97f5e4fb1d" // module TypeChecker = // let private p addl = p ("TypeChecker" :: addl) @@ -149,8 +149,8 @@ module Type = // module Int = // let error = p [ "Int" ] "Error" "8f753bfe-9e35-4a9e-a47e-c1dbb5f83037" - // module Json = - // let error = p [ "Json" ] "Error" "595907db-ab8d-4fe5-b9cf-d1bd8041e9bb" + module Json = + let error = p [ "Json" ] "Error" "595907db-ab8d-4fe5-b9cf-d1bd8041e9bb" // module Cli = // let error = p [ "Cli" ] "Error" "6756f735-2a6a-41ac-a6a8-6e0b7354ca1b" @@ -183,7 +183,7 @@ module Type = let letPattern = p [] "LetPattern" "5ca5d251-0703-49ce-a40d-28c2e4575431" let matchPattern = p [] "MatchPattern" "003c6684-4f9d-4085-bdba-a7f3bea7f587" let matchCase = p [] "MatchCase" "5fb0f282-5f7c-4fb8-b107-b63429080e69" - //let stringSegment = p [] "StringSegment" "ccadbf5b-1802-4db7-a30b-7b9073db78cd" + let stringSegment = p [] "StringSegment" "ccadbf5b-1802-4db7-a30b-7b9073db78cd" //let expr = p [] "Expr" "1f19e838-81f2-4a94-94b8-bad2ce7f7cf7" let dval = p [ "Dval" ] "Dval" "528b682c-a249-4a50-bd93-85e1e8cb529e" diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 6eb2873d48..27c4ded3f2 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -180,7 +180,7 @@ type MatchPattern = | MPListCons of id * head : MatchPattern * tail : MatchPattern | MPTuple of id * MatchPattern * MatchPattern * List - //| MPEnum of id * caseName : string * fieldPats : List + | MPEnum of id * caseName : string * fieldPats : List | MPVariable of id * string @@ -458,10 +458,10 @@ module Expr = module TypeDeclaration = type RecordField = { name : string; typ : TypeReference; description : string } - // type EnumField = - // { typ : TypeReference; label : Option; description : string } + type EnumField = + { typ : TypeReference; label : Option; description : string } - // type EnumCase = { name : string; fields : List; description : string } + type EnumCase = { name : string; fields : List; description : string } /// The right-hand-side of the declaration: eg List<'a> type Definition = @@ -471,8 +471,8 @@ module TypeDeclaration = /// `type MyRecord = { a : int; b : string }` | Record of NEList - // /// `type MyEnum = A | B of int | C of int * (label: string)` - // | Enum of NEList + /// `type MyEnum = A | B of int | C of int * (label: string)` + | Enum of NEList /// Combined the RHS definition, with the list of type parameters. Eg type /// MyType<'a> = List<'a> diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index 4cfabf68bf..81dc8b7da6 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -202,328 +202,328 @@ module NameResolution = C2DT.Result.fromDT f d NameResolutionError.fromDT -// module TypeReference = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.typeReference -// let knownType = KTCustomType(typeName, []) - -// let rec toDT (t : PT.TypeReference) : Dval = -// let (caseName, fields) = -// match t with -// | PT.TVariable name -> "TVariable", [ DString name ] - -// | PT.TUnit -> "TUnit", [] -// | PT.TBool -> "TBool", [] -// | PT.TInt8 -> "TInt8", [] -// | PT.TUInt8 -> "TUInt8", [] -// | PT.TInt16 -> "TInt16", [] -// | PT.TUInt16 -> "TUInt16", [] -// | PT.TInt32 -> "TInt32", [] -// | PT.TUInt32 -> "TUInt32", [] -// | PT.TInt64 -> "TInt64", [] -// | PT.TUInt64 -> "TUInt64", [] -// | PT.TInt128 -> "TInt128", [] -// | PT.TUInt128 -> "TUInt128", [] -// | PT.TFloat -> "TFloat", [] -// | PT.TChar -> "TChar", [] -// | PT.TString -> "TString", [] -// | PT.TDateTime -> "TDateTime", [] -// | PT.TUuid -> "TUuid", [] - -// | PT.TList inner -> "TList", [ toDT inner ] - -// | PT.TTuple(first, second, theRest) -> -// "TTuple", -// [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - -// | PT.TDict inner -> "TDict", [ toDT inner ] - -// | PT.TCustomType(typeName, typeArgs) -> -// "TCustomType", -// [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName -// DList(VT.known knownType, List.map toDT typeArgs) ] - -// | PT.TDB inner -> "TDB", [ toDT inner ] - -// | PT.TFn(args, ret) -> -// "TFn", -// [ DList(VT.known knownType, args |> NEList.toList |> List.map toDT) -// toDT ret ] - -// DEnum(typeName, typeName, [], caseName, fields) - -// let rec fromDT (d : Dval) : PT.TypeReference = -// match d with -// | DEnum(_, _, [], "TVariable", [ DString name ]) -> PT.TVariable(name) - -// | DEnum(_, _, [], "TUnit", []) -> PT.TUnit -// | DEnum(_, _, [], "TBool", []) -> PT.TBool -// | DEnum(_, _, [], "TInt64", []) -> PT.TInt64 -// | DEnum(_, _, [], "TUInt64", []) -> PT.TUInt64 -// | DEnum(_, _, [], "TInt8", []) -> PT.TInt8 -// | DEnum(_, _, [], "TUInt8", []) -> PT.TUInt8 -// | DEnum(_, _, [], "TInt16", []) -> PT.TInt16 -// | DEnum(_, _, [], "TUInt16", []) -> PT.TUInt16 -// | DEnum(_, _, [], "TInt32", []) -> PT.TInt32 -// | DEnum(_, _, [], "TUInt32", []) -> PT.TUInt32 -// | DEnum(_, _, [], "TInt128", []) -> PT.TInt128 -// | DEnum(_, _, [], "TUInt128", []) -> PT.TUInt128 -// | DEnum(_, _, [], "TFloat", []) -> PT.TFloat -// | DEnum(_, _, [], "TChar", []) -> PT.TChar -// | DEnum(_, _, [], "TString", []) -> PT.TString -// | DEnum(_, _, [], "TDateTime", []) -> PT.TDateTime -// | DEnum(_, _, [], "TUuid", []) -> PT.TUuid - -// | DEnum(_, _, [], "TList", [ inner ]) -> PT.TList(fromDT inner) - -// | DEnum(_, _, [], "TTuple", [ first; second; DList(_vtTODO, theRest) ]) -> -// PT.TTuple(fromDT first, fromDT second, List.map fromDT theRest) - -// | DEnum(_, _, [], "TDict", [ inner ]) -> PT.TDict(fromDT inner) - -// | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> -// PT.TCustomType( -// NameResolution.fromDT FQTypeName.fromDT typeName, -// List.map fromDT typeArgs -// ) - -// | DEnum(_, _, [], "TDB", [ inner ]) -> PT.TDB(fromDT inner) -// | DEnum(_, _, [], "TFn", [ DList(_vtTODO, head :: tail); ret ]) -> -// PT.TFn(NEList.ofList head tail |> NEList.map fromDT, fromDT ret) -// | _ -> Exception.raiseInternal "Invalid TypeReference" [] - - -// module LetPattern = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.letPattern -// let knownType = KTCustomType(typeName, []) - -// let rec toDT (p : PT.LetPattern) : Dval = -// let (caseName, fields) = -// match p with -// | PT.LPVariable(id, name) -> "LPVariable", [ DInt64(int64 id); DString name ] -// | PT.LPUnit id -> "LPUnit", [ DInt64(int64 id) ] -// | PT.LPTuple(id, first, second, theRest) -> -// "LPTuple", -// [ DInt64(int64 id) -// toDT first -// toDT second -// DList(VT.known knownType, List.map toDT theRest) ] +module TypeReference = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.typeReference + let knownType = KTCustomType(typeName, []) -// DEnum(typeName, typeName, [], caseName, fields) + let rec toDT (t : PT.TypeReference) : Dval = + let (caseName, fields) = + match t with + | PT.TVariable name -> "TVariable", [ DString name ] + + | PT.TUnit -> "TUnit", [] + | PT.TBool -> "TBool", [] + | PT.TInt8 -> "TInt8", [] + | PT.TUInt8 -> "TUInt8", [] + | PT.TInt16 -> "TInt16", [] + | PT.TUInt16 -> "TUInt16", [] + | PT.TInt32 -> "TInt32", [] + | PT.TUInt32 -> "TUInt32", [] + | PT.TInt64 -> "TInt64", [] + | PT.TUInt64 -> "TUInt64", [] + | PT.TInt128 -> "TInt128", [] + | PT.TUInt128 -> "TUInt128", [] + | PT.TFloat -> "TFloat", [] + | PT.TChar -> "TChar", [] + | PT.TString -> "TString", [] + | PT.TDateTime -> "TDateTime", [] + | PT.TUuid -> "TUuid", [] + + | PT.TList inner -> "TList", [ toDT inner ] + + | PT.TTuple(first, second, theRest) -> + "TTuple", + [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] + + | PT.TDict inner -> "TDict", [ toDT inner ] + + | PT.TCustomType(typeName, typeArgs) -> + "TCustomType", + [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + DList(VT.known knownType, List.map toDT typeArgs) ] + + // | PT.TDB inner -> "TDB", [ toDT inner ] + + | PT.TFn(args, ret) -> + "TFn", + [ DList(VT.known knownType, args |> NEList.toList |> List.map toDT) + toDT ret ] + DEnum(typeName, typeName, [], caseName, fields) -// let rec fromDT (d : Dval) : PT.LetPattern = -// match d with -// | DEnum(_, _, [], "LPVariable", [ DInt64 id; DString name ]) -> -// PT.LPVariable(uint64 id, name) -// | DEnum(_, _, [], "LPUnit", [ DInt64 id ]) -> PT.LPUnit(uint64 id) -// | DEnum(_, -// _, -// [], -// "LPTuple", -// [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> -// PT.LPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) -// | _ -> Exception.raiseInternal "Invalid LetPattern" [] + let rec fromDT (d : Dval) : PT.TypeReference = + match d with + | DEnum(_, _, [], "TVariable", [ DString name ]) -> PT.TVariable(name) + + | DEnum(_, _, [], "TUnit", []) -> PT.TUnit + | DEnum(_, _, [], "TBool", []) -> PT.TBool + | DEnum(_, _, [], "TInt64", []) -> PT.TInt64 + | DEnum(_, _, [], "TUInt64", []) -> PT.TUInt64 + | DEnum(_, _, [], "TInt8", []) -> PT.TInt8 + | DEnum(_, _, [], "TUInt8", []) -> PT.TUInt8 + | DEnum(_, _, [], "TInt16", []) -> PT.TInt16 + | DEnum(_, _, [], "TUInt16", []) -> PT.TUInt16 + | DEnum(_, _, [], "TInt32", []) -> PT.TInt32 + | DEnum(_, _, [], "TUInt32", []) -> PT.TUInt32 + | DEnum(_, _, [], "TInt128", []) -> PT.TInt128 + | DEnum(_, _, [], "TUInt128", []) -> PT.TUInt128 + | DEnum(_, _, [], "TFloat", []) -> PT.TFloat + | DEnum(_, _, [], "TChar", []) -> PT.TChar + | DEnum(_, _, [], "TString", []) -> PT.TString + | DEnum(_, _, [], "TDateTime", []) -> PT.TDateTime + | DEnum(_, _, [], "TUuid", []) -> PT.TUuid + + | DEnum(_, _, [], "TList", [ inner ]) -> PT.TList(fromDT inner) + + | DEnum(_, _, [], "TTuple", [ first; second; DList(_vtTODO, theRest) ]) -> + PT.TTuple(fromDT first, fromDT second, List.map fromDT theRest) + + | DEnum(_, _, [], "TDict", [ inner ]) -> PT.TDict(fromDT inner) + + | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> + PT.TCustomType( + NameResolution.fromDT FQTypeName.fromDT typeName, + List.map fromDT typeArgs + ) + + // | DEnum(_, _, [], "TDB", [ inner ]) -> PT.TDB(fromDT inner) + | DEnum(_, _, [], "TFn", [ DList(_vtTODO, head :: tail); ret ]) -> + PT.TFn(NEList.ofList head tail |> NEList.map fromDT, fromDT ret) + | _ -> Exception.raiseInternal "Invalid TypeReference" [] + + +module LetPattern = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.letPattern + let knownType = KTCustomType(typeName, []) + let rec toDT (p : PT.LetPattern) : Dval = + let (caseName, fields) = + match p with + | PT.LPVariable(id, name) -> "LPVariable", [ DInt64(int64 id); DString name ] + | PT.LPUnit id -> "LPUnit", [ DInt64(int64 id) ] + | PT.LPTuple(id, first, second, theRest) -> + "LPTuple", + [ DInt64(int64 id) + toDT first + toDT second + DList(VT.known knownType, List.map toDT theRest) ] -// module MatchPattern = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchPattern -// let knownType = KTCustomType(typeName, []) + DEnum(typeName, typeName, [], caseName, fields) -// let rec toDT (p : PT.MatchPattern) : Dval = -// let (caseName, fields) = -// match p with -// | PT.MPVariable(id, name) -> "MPVariable", [ DInt64(int64 id); DString name ] - -// | PT.MPUnit id -> "MPUnit", [ DInt64(int64 id) ] -// | PT.MPBool(id, b) -> "MPBool", [ DInt64(int64 id); DBool b ] -// | PT.MPInt64(id, i) -> "MPInt64", [ DInt64(int64 id); DInt64 i ] -// | PT.MPUInt64(id, i) -> "MPUInt64", [ DInt64(int64 id); DUInt64 i ] -// | PT.MPInt8(id, i) -> "MPInt8", [ DInt64(int64 id); DInt8 i ] -// | PT.MPUInt8(id, i) -> "MPUInt8", [ DInt64(int64 id); DUInt8 i ] -// | PT.MPInt16(id, i) -> "MPInt16", [ DInt64(int64 id); DInt16 i ] -// | PT.MPUInt16(id, i) -> "MPUInt16", [ DInt64(int64 id); DUInt16 i ] -// | PT.MPInt32(id, i) -> "MPInt32", [ DInt64(int64 id); DInt32 i ] -// | PT.MPUInt32(id, i) -> "MPUInt32", [ DInt64(int64 id); DUInt32 i ] -// | PT.MPInt128(id, i) -> "MPInt128", [ DInt64(int64 id); DInt128 i ] -// | PT.MPUInt128(id, i) -> "MPUInt128", [ DInt64(int64 id); DUInt128 i ] -// | PT.MPFloat(id, sign, whole, remainder) -> - -// "MPFloat", -// [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] -// | PT.MPChar(id, c) -> "MPChar", [ DInt64(int64 id); DString c ] -// | PT.MPString(id, s) -> "MPString", [ DInt64(int64 id); DString s ] - -// | PT.MPList(id, inner) -> -// "MPList", -// [ DInt64(int64 id); DList(VT.known knownType, List.map toDT inner) ] -// | PT.MPListCons(id, head, tail) -> -// "MPListCons", [ DInt64(int64 id); toDT head; toDT tail ] -// | PT.MPTuple(id, first, second, theRest) -> -// "MPTuple", -// [ DInt64(int64 id) -// toDT first -// toDT second -// DList(VT.known knownType, List.map toDT theRest) ] -// | PT.MPEnum(id, caseName, fieldPats) -> -// "MPEnum", -// [ DInt64(int64 id) -// DString caseName -// DList(VT.known knownType, List.map toDT fieldPats) ] -// DEnum(typeName, typeName, [], caseName, fields) + let rec fromDT (d : Dval) : PT.LetPattern = + match d with + | DEnum(_, _, [], "LPVariable", [ DInt64 id; DString name ]) -> + PT.LPVariable(uint64 id, name) + | DEnum(_, _, [], "LPUnit", [ DInt64 id ]) -> PT.LPUnit(uint64 id) + | DEnum(_, + _, + [], + "LPTuple", + [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> + PT.LPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + | _ -> Exception.raiseInternal "Invalid LetPattern" [] + + +module MatchPattern = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchPattern + let knownType = KTCustomType(typeName, []) -// let rec fromDT (d : Dval) : PT.MatchPattern = -// match d with -// | DEnum(_, _, [], "MPVariable", [ DInt64 id; DString name ]) -> -// PT.MPVariable(uint64 id, name) - -// | DEnum(_, _, [], "MPUnit", [ DInt64 id ]) -> PT.MPUnit(uint64 id) -// | DEnum(_, _, [], "MPBool", [ DInt64 id; DBool b ]) -> PT.MPBool(uint64 id, b) -// | DEnum(_, _, [], "MPInt64", [ DInt64 id; DInt64 i ]) -> PT.MPInt64(uint64 id, i) -// | DEnum(_, _, [], "MPUInt64", [ DInt64 id; DUInt64 i ]) -> -// PT.MPUInt64(uint64 id, i) -// | DEnum(_, _, [], "MPInt8", [ DInt64 id; DInt8 i ]) -> PT.MPInt8(uint64 id, i) -// | DEnum(_, _, [], "MPUInt8", [ DInt64 id; DUInt8 i ]) -> PT.MPUInt8(uint64 id, i) -// | DEnum(_, _, [], "MPInt16", [ DInt64 id; DInt16 i ]) -> PT.MPInt16(uint64 id, i) -// | DEnum(_, _, [], "MPUInt16", [ DInt64 id; DUInt16 i ]) -> -// PT.MPUInt16(uint64 id, i) -// | DEnum(_, _, [], "MPInt32", [ DInt64 id; DInt32 i ]) -> PT.MPInt32(uint64 id, i) -// | DEnum(_, _, [], "MPUInt32", [ DInt64 id; DUInt32 i ]) -> -// PT.MPUInt32(uint64 id, i) -// | DEnum(_, _, [], "MPInt128", [ DInt64 id; DInt128 i ]) -> -// PT.MPInt128(uint64 id, i) -// | DEnum(_, _, [], "MPUInt128", [ DInt64 id; DUInt128 i ]) -> -// PT.MPUInt128(uint64 id, i) -// | DEnum(_, -// _, -// [], -// "MPFloat", -// [ DInt64 id; sign; DString whole; DString remainder ]) -> -// PT.MPFloat(uint64 id, Sign.fromDT sign, whole, remainder) -// | DEnum(_, _, [], "MPChar", [ DInt64 id; DString c ]) -> PT.MPChar(uint64 id, c) -// | DEnum(_, _, [], "MPString", [ DInt64 id; DString s ]) -> -// PT.MPString(uint64 id, s) - -// | DEnum(_, _, [], "MPList", [ DInt64 id; DList(_vtTODO, inner) ]) -> -// PT.MPList(uint64 id, List.map fromDT inner) -// | DEnum(_, _, [], "MPListCons", [ DInt64 id; head; tail ]) -> -// PT.MPListCons(uint64 id, fromDT head, fromDT tail) -// | DEnum(_, -// _, -// [], -// "MPTuple", -// [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> -// PT.MPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) -// | DEnum(_, -// _, -// [], -// "MPEnum", -// [ DInt64 id; DString caseName; DList(_vtTODO, fieldPats) ]) -> -// PT.MPEnum(uint64 id, caseName, List.map fromDT fieldPats) -// | _ -> Exception.raiseInternal "Invalid MatchPattern" [] + let rec toDT (p : PT.MatchPattern) : Dval = + let (caseName, fields) = + match p with + | PT.MPVariable(id, name) -> "MPVariable", [ DInt64(int64 id); DString name ] + + | PT.MPUnit id -> "MPUnit", [ DInt64(int64 id) ] + | PT.MPBool(id, b) -> "MPBool", [ DInt64(int64 id); DBool b ] + | PT.MPInt64(id, i) -> "MPInt64", [ DInt64(int64 id); DInt64 i ] + | PT.MPUInt64(id, i) -> "MPUInt64", [ DInt64(int64 id); DUInt64 i ] + | PT.MPInt8(id, i) -> "MPInt8", [ DInt64(int64 id); DInt8 i ] + | PT.MPUInt8(id, i) -> "MPUInt8", [ DInt64(int64 id); DUInt8 i ] + | PT.MPInt16(id, i) -> "MPInt16", [ DInt64(int64 id); DInt16 i ] + | PT.MPUInt16(id, i) -> "MPUInt16", [ DInt64(int64 id); DUInt16 i ] + | PT.MPInt32(id, i) -> "MPInt32", [ DInt64(int64 id); DInt32 i ] + | PT.MPUInt32(id, i) -> "MPUInt32", [ DInt64(int64 id); DUInt32 i ] + | PT.MPInt128(id, i) -> "MPInt128", [ DInt64(int64 id); DInt128 i ] + | PT.MPUInt128(id, i) -> "MPUInt128", [ DInt64(int64 id); DUInt128 i ] + | PT.MPFloat(id, sign, whole, remainder) -> + + "MPFloat", + [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] + | PT.MPChar(id, c) -> "MPChar", [ DInt64(int64 id); DString c ] + | PT.MPString(id, s) -> "MPString", [ DInt64(int64 id); DString s ] + + | PT.MPList(id, inner) -> + "MPList", + [ DInt64(int64 id); DList(VT.known knownType, List.map toDT inner) ] + | PT.MPListCons(id, head, tail) -> + "MPListCons", [ DInt64(int64 id); toDT head; toDT tail ] + | PT.MPTuple(id, first, second, theRest) -> + "MPTuple", + [ DInt64(int64 id) + toDT first + toDT second + DList(VT.known knownType, List.map toDT theRest) ] + | PT.MPEnum(id, caseName, fieldPats) -> + "MPEnum", + [ DInt64(int64 id) + DString caseName + DList(VT.known knownType, List.map toDT fieldPats) ] + DEnum(typeName, typeName, [], caseName, fields) -// module BinaryOperation = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.binaryOperation + let rec fromDT (d : Dval) : PT.MatchPattern = + match d with + | DEnum(_, _, [], "MPVariable", [ DInt64 id; DString name ]) -> + PT.MPVariable(uint64 id, name) + + | DEnum(_, _, [], "MPUnit", [ DInt64 id ]) -> PT.MPUnit(uint64 id) + | DEnum(_, _, [], "MPBool", [ DInt64 id; DBool b ]) -> PT.MPBool(uint64 id, b) + | DEnum(_, _, [], "MPInt64", [ DInt64 id; DInt64 i ]) -> PT.MPInt64(uint64 id, i) + | DEnum(_, _, [], "MPUInt64", [ DInt64 id; DUInt64 i ]) -> + PT.MPUInt64(uint64 id, i) + | DEnum(_, _, [], "MPInt8", [ DInt64 id; DInt8 i ]) -> PT.MPInt8(uint64 id, i) + | DEnum(_, _, [], "MPUInt8", [ DInt64 id; DUInt8 i ]) -> PT.MPUInt8(uint64 id, i) + | DEnum(_, _, [], "MPInt16", [ DInt64 id; DInt16 i ]) -> PT.MPInt16(uint64 id, i) + | DEnum(_, _, [], "MPUInt16", [ DInt64 id; DUInt16 i ]) -> + PT.MPUInt16(uint64 id, i) + | DEnum(_, _, [], "MPInt32", [ DInt64 id; DInt32 i ]) -> PT.MPInt32(uint64 id, i) + | DEnum(_, _, [], "MPUInt32", [ DInt64 id; DUInt32 i ]) -> + PT.MPUInt32(uint64 id, i) + | DEnum(_, _, [], "MPInt128", [ DInt64 id; DInt128 i ]) -> + PT.MPInt128(uint64 id, i) + | DEnum(_, _, [], "MPUInt128", [ DInt64 id; DUInt128 i ]) -> + PT.MPUInt128(uint64 id, i) + | DEnum(_, + _, + [], + "MPFloat", + [ DInt64 id; sign; DString whole; DString remainder ]) -> + PT.MPFloat(uint64 id, Sign.fromDT sign, whole, remainder) + | DEnum(_, _, [], "MPChar", [ DInt64 id; DString c ]) -> PT.MPChar(uint64 id, c) + | DEnum(_, _, [], "MPString", [ DInt64 id; DString s ]) -> + PT.MPString(uint64 id, s) + + | DEnum(_, _, [], "MPList", [ DInt64 id; DList(_vtTODO, inner) ]) -> + PT.MPList(uint64 id, List.map fromDT inner) + | DEnum(_, _, [], "MPListCons", [ DInt64 id; head; tail ]) -> + PT.MPListCons(uint64 id, fromDT head, fromDT tail) + | DEnum(_, + _, + [], + "MPTuple", + [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> + PT.MPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + | DEnum(_, + _, + [], + "MPEnum", + [ DInt64 id; DString caseName; DList(_vtTODO, fieldPats) ]) -> + PT.MPEnum(uint64 id, caseName, List.map fromDT fieldPats) + | _ -> Exception.raiseInternal "Invalid MatchPattern" [] + + +module BinaryOperation = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.binaryOperation -// let toDT (b : PT.BinaryOperation) : Dval = -// let (caseName, fields) = -// match b with -// | PT.BinOpAnd -> "BinOpAnd", [] -// | PT.BinOpOr -> "BinOpOr", [] -// DEnum(typeName, typeName, [], caseName, fields) + let toDT (b : PT.BinaryOperation) : Dval = + let (caseName, fields) = + match b with + | PT.BinOpAnd -> "BinOpAnd", [] + | PT.BinOpOr -> "BinOpOr", [] + DEnum(typeName, typeName, [], caseName, fields) -// let fromDT (d : Dval) : PT.BinaryOperation = -// match d with -// | DEnum(_, _, [], "BinOpAnd", []) -> PT.BinOpAnd -// | DEnum(_, _, [], "BinOpOr", []) -> PT.BinOpOr -// | _ -> Exception.raiseInternal "Invalid BinaryOperation" [] + let fromDT (d : Dval) : PT.BinaryOperation = + match d with + | DEnum(_, _, [], "BinOpAnd", []) -> PT.BinOpAnd + | DEnum(_, _, [], "BinOpOr", []) -> PT.BinOpOr + | _ -> Exception.raiseInternal "Invalid BinaryOperation" [] -// module InfixFnName = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infixFnName +module InfixFnName = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infixFnName -// let toDT (i : PT.InfixFnName) : Dval = -// let (caseName, fields) = -// match i with -// | PT.ArithmeticPlus -> "ArithmeticPlus", [] -// | PT.ArithmeticMinus -> "ArithmeticMinus", [] -// | PT.ArithmeticMultiply -> "ArithmeticMultiply", [] -// | PT.ArithmeticDivide -> "ArithmeticDivide", [] -// | PT.ArithmeticModulo -> "ArithmeticModulo", [] -// | PT.ArithmeticPower -> "ArithmeticPower", [] -// | PT.ComparisonGreaterThan -> "ComparisonGreaterThan", [] -// | PT.ComparisonGreaterThanOrEqual -> "ComparisonGreaterThanOrEqual", [] -// | PT.ComparisonLessThan -> "ComparisonLessThan", [] -// | PT.ComparisonLessThanOrEqual -> "ComparisonLessThanOrEqual", [] -// | PT.ComparisonEquals -> "ComparisonEquals", [] -// | PT.ComparisonNotEquals -> "ComparisonNotEquals", [] -// | PT.StringConcat -> "StringConcat", [] + let toDT (i : PT.InfixFnName) : Dval = + let (caseName, fields) = + match i with + | PT.ArithmeticPlus -> "ArithmeticPlus", [] + | PT.ArithmeticMinus -> "ArithmeticMinus", [] + | PT.ArithmeticMultiply -> "ArithmeticMultiply", [] + | PT.ArithmeticDivide -> "ArithmeticDivide", [] + | PT.ArithmeticModulo -> "ArithmeticModulo", [] + | PT.ArithmeticPower -> "ArithmeticPower", [] + | PT.ComparisonGreaterThan -> "ComparisonGreaterThan", [] + | PT.ComparisonGreaterThanOrEqual -> "ComparisonGreaterThanOrEqual", [] + | PT.ComparisonLessThan -> "ComparisonLessThan", [] + | PT.ComparisonLessThanOrEqual -> "ComparisonLessThanOrEqual", [] + | PT.ComparisonEquals -> "ComparisonEquals", [] + | PT.ComparisonNotEquals -> "ComparisonNotEquals", [] + | PT.StringConcat -> "StringConcat", [] -// DEnum(typeName, typeName, [], caseName, fields) + DEnum(typeName, typeName, [], caseName, fields) -// let fromDT (d : Dval) : PT.InfixFnName = -// match d with -// | DEnum(_, _, [], "ArithmeticPlus", []) -> PT.ArithmeticPlus -// | DEnum(_, _, [], "ArithmeticMinus", []) -> PT.ArithmeticMinus -// | DEnum(_, _, [], "ArithmeticMultiply", []) -> PT.ArithmeticMultiply -// | DEnum(_, _, [], "ArithmeticDivide", []) -> PT.ArithmeticDivide -// | DEnum(_, _, [], "ArithmeticModulo", []) -> PT.ArithmeticModulo -// | DEnum(_, _, [], "ArithmeticPower", []) -> PT.ArithmeticPower -// | DEnum(_, _, [], "ComparisonGreaterThan", []) -> PT.ComparisonGreaterThan -// | DEnum(_, _, [], "ComparisonGreaterThanOrEqual", []) -> -// PT.ComparisonGreaterThanOrEqual -// | DEnum(_, _, [], "ComparisonLessThan", []) -> PT.ComparisonLessThan -// | DEnum(_, _, [], "ComparisonLessThanOrEqual", []) -> -// PT.ComparisonLessThanOrEqual -// | DEnum(_, _, [], "ComparisonEquals", []) -> PT.ComparisonEquals -// | DEnum(_, _, [], "ComparisonNotEquals", []) -> PT.ComparisonNotEquals -// | DEnum(_, _, [], "StringConcat", []) -> PT.StringConcat -// | _ -> Exception.raiseInternal "Invalid InfixFnName" [] - - -// module Infix = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infix + let fromDT (d : Dval) : PT.InfixFnName = + match d with + | DEnum(_, _, [], "ArithmeticPlus", []) -> PT.ArithmeticPlus + | DEnum(_, _, [], "ArithmeticMinus", []) -> PT.ArithmeticMinus + | DEnum(_, _, [], "ArithmeticMultiply", []) -> PT.ArithmeticMultiply + | DEnum(_, _, [], "ArithmeticDivide", []) -> PT.ArithmeticDivide + | DEnum(_, _, [], "ArithmeticModulo", []) -> PT.ArithmeticModulo + | DEnum(_, _, [], "ArithmeticPower", []) -> PT.ArithmeticPower + | DEnum(_, _, [], "ComparisonGreaterThan", []) -> PT.ComparisonGreaterThan + | DEnum(_, _, [], "ComparisonGreaterThanOrEqual", []) -> + PT.ComparisonGreaterThanOrEqual + | DEnum(_, _, [], "ComparisonLessThan", []) -> PT.ComparisonLessThan + | DEnum(_, _, [], "ComparisonLessThanOrEqual", []) -> + PT.ComparisonLessThanOrEqual + | DEnum(_, _, [], "ComparisonEquals", []) -> PT.ComparisonEquals + | DEnum(_, _, [], "ComparisonNotEquals", []) -> PT.ComparisonNotEquals + | DEnum(_, _, [], "StringConcat", []) -> PT.StringConcat + | _ -> Exception.raiseInternal "Invalid InfixFnName" [] + + +module Infix = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.infix -// let toDT (i : PT.Infix) : Dval = -// let (caseName, fields) = -// match i with -// | PT.InfixFnCall infixFnName -> "InfixFnCall", [ InfixFnName.toDT infixFnName ] -// | PT.BinOp binOp -> "BinOp", [ BinaryOperation.toDT binOp ] -// DEnum(typeName, typeName, [], caseName, fields) + let toDT (i : PT.Infix) : Dval = + let (caseName, fields) = + match i with + | PT.InfixFnCall infixFnName -> "InfixFnCall", [ InfixFnName.toDT infixFnName ] + | PT.BinOp binOp -> "BinOp", [ BinaryOperation.toDT binOp ] + DEnum(typeName, typeName, [], caseName, fields) -// let fromDT (d : Dval) : PT.Infix = -// match d with -// | DEnum(_, _, [], "InfixFnCall", [ infixFnName ]) -> -// PT.InfixFnCall(InfixFnName.fromDT infixFnName) -// | DEnum(_, _, [], "BinOp", [ binOp ]) -> PT.BinOp(BinaryOperation.fromDT binOp) -// | _ -> Exception.raiseInternal "Invalid Infix" [] + let fromDT (d : Dval) : PT.Infix = + match d with + | DEnum(_, _, [], "InfixFnCall", [ infixFnName ]) -> + PT.InfixFnCall(InfixFnName.fromDT infixFnName) + | DEnum(_, _, [], "BinOp", [ binOp ]) -> PT.BinOp(BinaryOperation.fromDT binOp) + | _ -> Exception.raiseInternal "Invalid Infix" [] -// module StringSegment = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.stringSegment -// let knownType = KTCustomType(typeName, []) +module StringSegment = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.stringSegment + let knownType = KTCustomType(typeName, []) -// let toDT (exprToDT : PT.Expr -> Dval) (s : PT.StringSegment) : Dval = -// let (caseName, fields) = -// match s with -// | PT.StringText text -> "StringText", [ DString text ] -// | PT.StringInterpolation expr -> "StringInterpolation", [ exprToDT expr ] -// DEnum(typeName, typeName, [], caseName, fields) + let toDT (exprToDT : PT.Expr -> Dval) (s : PT.StringSegment) : Dval = + let (caseName, fields) = + match s with + | PT.StringText text -> "StringText", [ DString text ] + | PT.StringInterpolation expr -> "StringInterpolation", [ exprToDT expr ] + DEnum(typeName, typeName, [], caseName, fields) -// let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.StringSegment = -// match d with -// | DEnum(_, _, [], "StringText", [ DString text ]) -> PT.StringText text -// | DEnum(_, _, [], "StringInterpolation", [ expr ]) -> -// PT.StringInterpolation(exprFromDT expr) -// | _ -> Exception.raiseInternal "Invalid StringSegment" [] + let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.StringSegment = + match d with + | DEnum(_, _, [], "StringText", [ DString text ]) -> PT.StringText text + | DEnum(_, _, [], "StringInterpolation", [ expr ]) -> + PT.StringInterpolation(exprFromDT expr) + | _ -> Exception.raiseInternal "Invalid StringSegment" [] // module PipeExpr = @@ -627,601 +627,623 @@ module NameResolution = // | _ -> Exception.raiseInternal "Invalid PipeExpr" [] -// module Expr = -// let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.expr -// let knownType = KTCustomType(typeName, []) - -// let rec toDT (e : PT.Expr) : Dval = -// let (caseName, fields) = -// match e with -// | PT.EUnit id -> "EUnit", [ DInt64(int64 id) ] - -// // simple data -// | PT.EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] -// | PT.EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] -// | PT.EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] -// | PT.EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] -// | PT.EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] -// | PT.EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] -// | PT.EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] -// | PT.EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] -// | PT.EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] -// | PT.EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] -// | PT.EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] -// | PT.EFloat(id, sign, whole, remainder) -> -// "EFloat", -// [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] - -// | PT.EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] -// | PT.EString(id, segments) -> -// "EString", -// [ DInt64(int64 id) -// DList( -// VT.known StringSegment.knownType, -// List.map (StringSegment.toDT toDT) segments -// ) ] - -// // structures of data -// | PT.EList(id, items) -> -// "EList", [ DInt64(int64 id); DList(VT.known knownType, List.map toDT items) ] - -// | PT.EDict(id, pairs) -> -// "EDict", -// [ DInt64(int64 id) -// DList( -// VT.tuple VT.string (VT.known knownType) [], -// pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) -// ) ] - -// | PT.ETuple(id, first, second, theRest) -> -// "ETuple", -// [ DInt64(int64 id) -// toDT first -// toDT second -// DList(VT.known knownType, List.map toDT theRest) ] - -// | PT.ERecord(id, typeName, fields) -> -// let fields = -// DList( -// VT.tuple VT.string (VT.known knownType) [], -// fields -// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) -// ) - -// "ERecord", -// [ DInt64(int64 id) -// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName -// fields ] - -// | PT.EEnum(id, typeName, caseName, fields) -> -// "EEnum", -// [ DInt64(int64 id) -// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName -// DString caseName -// DList(VT.known knownType, List.map toDT fields) ] - -// // declaring and accessing variables -// | PT.ELet(id, lp, expr, body) -> -// "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - -// | PT.ERecordFieldAccess(id, expr, fieldName) -> -// "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] - -// | PT.EVariable(id, varName) -> -// "EVariable", [ DInt64(int64 id); DString varName ] - - -// // control flow -// | PT.EIf(id, cond, thenExpr, elseExpr) -> -// "EIf", -// [ DInt64(int64 id) -// toDT cond -// toDT thenExpr -// elseExpr |> Option.map toDT |> Dval.option knownType ] - -// | PT.EMatch(id, arg, cases) -> -// let matchCaseTypeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchCase -// let cases = -// cases -// |> List.map (fun case -> - -// let pattern = MatchPattern.toDT case.pat -// let whenCondition = -// case.whenCondition |> Option.map toDT |> Dval.option knownType -// let expr = toDT case.rhs -// DRecord( -// matchCaseTypeName, -// matchCaseTypeName, -// [], -// Map -// [ ("pat", pattern) -// ("whenCondition", whenCondition) -// ("rhs", expr) ] -// )) -// |> Dval.list (KTCustomType(matchCaseTypeName, [])) - -// "EMatch", [ DInt64(int64 id); toDT arg; cases ] - -// | PT.EPipe(id, expr, pipeExprs) -> -// "EPipe", -// [ DInt64(int64 id) -// toDT expr -// DList( -// VT.known PipeExpr.knownType, -// List.map (PipeExpr.toDT knownType toDT) pipeExprs -// ) ] - - -// // function calls -// | PT.EInfix(id, infix, lhs, rhs) -> -// "EInfix", [ DInt64(int64 id); Infix.toDT infix; toDT lhs; toDT rhs ] - -// | PT.ELambda(id, pats, body) -> -// let variables = -// DList( -// VT.tuple VT.int64 VT.string [], -// pats |> NEList.toList |> List.map LetPattern.toDT -// ) -// "ELambda", [ DInt64(int64 id); variables; toDT body ] - -// | PT.EConstant(id, name) -> -// "EConstant", -// [ DInt64(int64 id) -// NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] - -// | PT.EApply(id, name, typeArgs, args) -> -// "EApply", -// [ DInt64(int64 id) -// toDT name -// DList( -// VT.known TypeReference.knownType, -// List.map TypeReference.toDT typeArgs -// ) -// DList(VT.known knownType, args |> NEList.toList |> List.map toDT) ] - -// | PT.EFnName(id, name) -> -// "EFnName", -// [ DInt64(int64 id) -// NameResolution.toDT FQFnName.knownType FQFnName.toDT name ] - -// | PT.ERecordUpdate(id, record, updates) -> -// let updates = -// DList( -// VT.tuple VT.string (VT.known knownType) [], -// updates -// |> NEList.toList -// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) -// ) - -// "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] - - -// DEnum(typeName, typeName, [], caseName, fields) - - -// let rec fromDT (d : Dval) : PT.Expr = -// match d with -// | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> PT.EUnit(uint64 id) - -// // simple data -// | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> PT.EBool(uint64 id, b) -// | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> PT.EInt64(uint64 id, i) -// | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> -// PT.EUInt64(uint64 id, i) -// | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> PT.EInt8(uint64 id, i) -// | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> PT.EUInt8(uint64 id, i) -// | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> PT.EInt16(uint64 id, i) -// | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> -// PT.EUInt16(uint64 id, i) -// | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> PT.EInt32(uint64 id, i) -// | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> -// PT.EUInt32(uint64 id, i) -// | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> -// PT.EInt128(uint64 id, i) -// | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> -// PT.EUInt128(uint64 id, i) -// | DEnum(_, _, [], "EFloat", [ DInt64 id; sign; DString whole; DString remainder ]) -> -// PT.EFloat(uint64 id, Sign.fromDT sign, whole, remainder) -// | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> PT.EChar(uint64 id, c) -// | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> -// PT.EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) - - -// // structures of data -// | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> -// PT.EList(uint64 id, List.map fromDT inner) -// | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> -// let pairs = -// pairsList -// |> List.collect (fun pair -> -// match pair with -// | DTuple(DString k, v, _) -> [ (k, fromDT v) ] -// | _ -> []) -// PT.EDict(uint64 id, pairs) - - -// | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> -// PT.ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - -// | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO, fieldsList) ]) -> -// let fields = -// fieldsList -// |> List.collect (fun field -> -// match field with -// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] -// | _ -> []) -// PT.ERecord(uint64 id, NameResolution.fromDT FQTypeName.fromDT typeName, fields) - - -// | DEnum(_, -// _, -// [], -// "EEnum", -// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> -// PT.EEnum( -// uint64 id, -// NameResolution.fromDT FQTypeName.fromDT typeName, -// caseName, -// List.map fromDT fields -// ) - -// // declaring and accessing variables -// | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> -// PT.ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - -// | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> -// PT.ERecordFieldAccess(uint64 id, fromDT expr, fieldName) - -// | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> -// PT.EVariable(uint64 id, varName) - -// // control flow -// | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> -// let elseExpr = -// match elseExpr with -// | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) -// | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None -// | _ -> -// Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] -// PT.EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) - -// | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> -// let (cases : List) = -// cases -// |> List.collect (fun case -> -// match case with -// | DRecord(_, _, _, fields) -> -// let whenCondition = -// match Map.tryFind "whenCondition" fields with -// | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) -// | Some(DEnum(_, _, _, "None", [])) -> None -// | _ -> None -// match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with -// | Some pat, Some rhs -> -// [ { pat = MatchPattern.fromDT pat -// whenCondition = whenCondition -// rhs = fromDT rhs } ] -// | _ -> [] -// | _ -> []) -// PT.EMatch(uint64 id, fromDT arg, cases) - -// | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> -// PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) - -// // function calls -// | DEnum(_, _, [], "EInfix", [ DInt64 id; infix; lhs; rhs ]) -> -// PT.EInfix(uint64 id, Infix.fromDT infix, fromDT lhs, fromDT rhs) - -// | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> -// let pats = -// pats -// |> List.map LetPattern.fromDT -// |> NEList.ofListUnsafe -// "PT2DT.Expr.fromDT expected at least one bound variable in ELambda" -// [] -// PT.ELambda(uint64 id, pats, fromDT body) - - -// | DEnum(_, -// _, -// [], -// "EApply", -// [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> -// PT.EApply( -// uint64 id, -// fromDT name, -// List.map TypeReference.fromDT typeArgs, -// args |> NEList.ofListUnsafe "EApply" [] |> NEList.map fromDT -// ) - -// | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> -// PT.EFnName(uint64 id, NameResolution.fromDT FQFnName.fromDT name) - -// | DEnum(_, -// _, -// [], -// "ERecordUpdate", -// [ DInt64 id; record; DList(_vtTODO, head :: tail) ]) -> -// let updates = -// NEList.ofList head tail -// |> NEList.map (fun update -> -// match update with -// | DTuple(DString name, expr, _) -> (name, fromDT expr) -// | _ -> -// Exception.raiseInternal "Invalid record update" [ "update", update ]) -// PT.ERecordUpdate(uint64 id, fromDT record, updates) - -// | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] - - -// module Const = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.constDef -// let knownType = KTCustomType(typeName, []) - -// let rec toDT (c : PT.Const) : Dval = -// let (caseName, fields) = -// match c with -// | PT.Const.CUnit -> "CUnit", [] -// | PT.Const.CBool b -> "CBool", [ DBool b ] -// | PT.Const.CInt64 i -> "CInt64", [ DInt64 i ] -// | PT.Const.CUInt64 i -> "CUInt64", [ DUInt64 i ] -// | PT.Const.CInt8 i -> "CInt8", [ DInt8 i ] -// | PT.Const.CUInt8 i -> "CUInt8", [ DUInt8 i ] -// | PT.Const.CInt16 i -> "CInt16", [ DInt16 i ] -// | PT.Const.CUInt16 i -> "CUInt16", [ DUInt16 i ] -// | PT.Const.CInt32 i -> "CInt32", [ DInt32 i ] -// | PT.Const.CUInt32 i -> "CUInt32", [ DUInt32 i ] -// | PT.Const.CInt128 i -> "CInt128", [ DInt128 i ] -// | PT.Const.CUInt128 i -> "CUInt128", [ DUInt128 i ] -// | PT.Const.CFloat(sign, w, f) -> -// "CFloat", [ Sign.toDT sign; DString w; DString f ] -// | PT.Const.CChar c -> "CChar", [ DChar c ] -// | PT.Const.CString s -> "CString", [ DString s ] - -// | PT.Const.CTuple(first, second, theRest) -> -// "CTuple", -// [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - -// | PT.Const.CEnum(typeName, caseName, fields) -> -// "CEnum", -// [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName -// DString caseName -// Dval.list knownType (List.map toDT fields) ] - -// | PT.Const.CList inner -> -// "CList", [ DList(VT.known knownType, List.map toDT inner) ] - -// | PT.Const.CDict pairs -> -// "CDict", -// [ DList( -// VT.tuple VT.string VT.string [], -// pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) -// ) ] +module Expr = + let typeName = FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.expr + let knownType = KTCustomType(typeName, []) -// DEnum(typeName, typeName, [], caseName, fields) + let rec toDT (e : PT.Expr) : Dval = + let (caseName, fields) = + match e with + | PT.EUnit id -> "EUnit", [ DInt64(int64 id) ] + + // simple data + | PT.EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] + | PT.EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] + | PT.EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] + | PT.EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] + | PT.EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] + | PT.EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] + | PT.EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] + | PT.EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] + | PT.EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] + | PT.EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] + | PT.EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] + | PT.EFloat(id, sign, whole, remainder) -> + "EFloat", + [ DInt64(int64 id); Sign.toDT sign; DString whole; DString remainder ] + + | PT.EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] + | PT.EString(id, segments) -> + "EString", + [ DInt64(int64 id) + DList( + VT.known StringSegment.knownType, + List.map (StringSegment.toDT toDT) segments + ) ] + + // structures of data + | PT.EList(id, items) -> + "EList", [ DInt64(int64 id); DList(VT.known knownType, List.map toDT items) ] + + | PT.EDict(id, pairs) -> + "EDict", + [ DInt64(int64 id) + DList( + VT.tuple VT.string (VT.known knownType) [], + pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) + ) ] + + | PT.ETuple(id, first, second, theRest) -> + "ETuple", + [ DInt64(int64 id) + toDT first + toDT second + DList(VT.known knownType, List.map toDT theRest) ] + + | PT.ERecord(id, typeName, typeArgs, fields) -> + let fields = + DList( + VT.tuple VT.string (VT.known knownType) [], + fields + |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) + ) + + "ERecord", + [ DInt64(int64 id) + NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + DList( + VT.known TypeReference.knownType, + List.map TypeReference.toDT typeArgs + ) + fields ] + + | PT.EEnum(id, typeName, typeArgs, caseName, fields) -> + "EEnum", + [ DInt64(int64 id) + NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + DList( + VT.known TypeReference.knownType, + List.map TypeReference.toDT typeArgs + ) + DString caseName + DList(VT.known knownType, List.map toDT fields) ] + + // declaring and accessing variables + | PT.ELet(id, lp, expr, body) -> + "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] + + | PT.ERecordFieldAccess(id, expr, fieldName) -> + "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] + + | PT.EVariable(id, varName) -> + "EVariable", [ DInt64(int64 id); DString varName ] + + + // control flow + | PT.EIf(id, cond, thenExpr, elseExpr) -> + "EIf", + [ DInt64(int64 id) + toDT cond + toDT thenExpr + elseExpr |> Option.map toDT |> Dval.option knownType ] + + | PT.EMatch(id, arg, cases) -> + let matchCaseTypeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.matchCase + let cases = + cases + |> List.map (fun case -> + + let pattern = MatchPattern.toDT case.pat + let whenCondition = + case.whenCondition |> Option.map toDT |> Dval.option knownType + let expr = toDT case.rhs + DRecord( + matchCaseTypeName, + matchCaseTypeName, + [], + Map + [ ("pat", pattern) + ("whenCondition", whenCondition) + ("rhs", expr) ] + )) + |> Dval.list (KTCustomType(matchCaseTypeName, [])) + + "EMatch", [ DInt64(int64 id); toDT arg; cases ] + + // | PT.EPipe(id, expr, pipeExprs) -> + // "EPipe", + // [ DInt64(int64 id) + // toDT expr + // DList( + // VT.known PipeExpr.knownType, + // List.map (PipeExpr.toDT knownType toDT) pipeExprs + // ) ] + + + // function calls + | PT.EInfix(id, infix, lhs, rhs) -> + "EInfix", [ DInt64(int64 id); Infix.toDT infix; toDT lhs; toDT rhs ] + + | PT.ELambda(id, pats, body) -> + let variables = + DList( + VT.tuple VT.int64 VT.string [], + pats |> NEList.toList |> List.map LetPattern.toDT + ) + "ELambda", [ DInt64(int64 id); variables; toDT body ] + + // | PT.EConstant(id, name) -> + // "EConstant", + // [ DInt64(int64 id) + // NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] + + | PT.EApply(id, name, typeArgs, args) -> + "EApply", + [ DInt64(int64 id) + toDT name + DList( + VT.known TypeReference.knownType, + List.map TypeReference.toDT typeArgs + ) + DList(VT.known knownType, args |> NEList.toList |> List.map toDT) ] + + | PT.EFnName(id, name) -> + "EFnName", + [ DInt64(int64 id) + NameResolution.toDT FQFnName.knownType FQFnName.toDT name ] + + | PT.ERecordUpdate(id, record, updates) -> + let updates = + DList( + VT.tuple VT.string (VT.known knownType) [], + updates + |> NEList.toList + |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) + ) + + "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] -// let rec fromDT (d : Dval) : PT.Const = -// match d with -// | DEnum(_, _, [], "CInt64", [ DInt64 i ]) -> PT.Const.CInt64 i -// | DEnum(_, _, [], "CUInt64", [ DUInt64 i ]) -> PT.Const.CUInt64 i -// | DEnum(_, _, [], "CInt8", [ DInt8 i ]) -> PT.Const.CInt8 i -// | DEnum(_, _, [], "CUInt8", [ DUInt8 i ]) -> PT.Const.CUInt8 i -// | DEnum(_, _, [], "CInt16", [ DInt16 i ]) -> PT.Const.CInt16 i -// | DEnum(_, _, [], "CUInt16", [ DUInt16 i ]) -> PT.Const.CUInt16 i -// | DEnum(_, _, [], "CInt32", [ DInt32 i ]) -> PT.Const.CInt32 i -// | DEnum(_, _, [], "CUInt32", [ DUInt32 i ]) -> PT.Const.CUInt32 i -// | DEnum(_, _, [], "CInt128", [ DInt128 i ]) -> PT.Const.CInt128 i -// | DEnum(_, _, [], "CUInt128", [ DUInt128 i ]) -> PT.Const.CUInt128 i -// | DEnum(_, _, [], "CBool", [ DBool b ]) -> PT.Const.CBool b -// | DEnum(_, _, [], "CString", [ DString s ]) -> PT.Const.CString s -// | DEnum(_, _, [], "CChar", [ DChar c ]) -> PT.Const.CChar c -// | DEnum(_, _, [], "CFloat", [ sign; DString w; DString f ]) -> -// PT.Const.CFloat(Sign.fromDT sign, w, f) -// | DEnum(_, _, [], "CUnit", []) -> PT.Const.CUnit -// | DEnum(_, _, [], "CTuple", [ first; second; DList(_vtTODO, rest) ]) -> -// PT.Const.CTuple(fromDT first, fromDT second, List.map fromDT rest) -// | DEnum(_, _, [], "CEnum", [ typeName; DString caseName; DList(_vtTODO, fields) ]) -> -// PT.Const.CEnum( -// NameResolution.fromDT FQTypeName.fromDT typeName, -// caseName, -// List.map fromDT fields -// ) -// | DEnum(_, _, [], "CList", [ DList(_vtTODO, inner) ]) -> -// PT.Const.CList(List.map fromDT inner) -// | DEnum(_, _, [], "CDict", [ DList(_vtTODO, pairs) ]) -> -// let pairs = -// pairs -// |> List.map (fun pair -> -// match pair with -// | DTuple(k, v, _) -> (fromDT k, fromDT v) -// | _ -> Exception.raiseInternal "Invalid pair" []) -// PT.Const.CDict( -// List.map -// (fun (k, v) -> -// (match k with -// | PT.Const.CString s -> s -// | _ -> Exception.raiseInternal "Invalid key" []), -// v) -// pairs -// ) + DEnum(typeName, typeName, [], caseName, fields) -// | _ -> Exception.raiseInternal "Invalid Const" [] + let rec fromDT (d : Dval) : PT.Expr = + match d with + | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> PT.EUnit(uint64 id) + + // simple data + | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> PT.EBool(uint64 id, b) + | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> PT.EInt64(uint64 id, i) + | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> + PT.EUInt64(uint64 id, i) + | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> PT.EInt8(uint64 id, i) + | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> PT.EUInt8(uint64 id, i) + | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> PT.EInt16(uint64 id, i) + | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> + PT.EUInt16(uint64 id, i) + | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> PT.EInt32(uint64 id, i) + | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> + PT.EUInt32(uint64 id, i) + | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> + PT.EInt128(uint64 id, i) + | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> + PT.EUInt128(uint64 id, i) + | DEnum(_, _, [], "EFloat", [ DInt64 id; sign; DString whole; DString remainder ]) -> + PT.EFloat(uint64 id, Sign.fromDT sign, whole, remainder) + | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> PT.EChar(uint64 id, c) + | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> + PT.EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) + + + // structures of data + | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> + PT.EList(uint64 id, List.map fromDT inner) + | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> + let pairs = + pairsList + |> List.collect (fun pair -> + match pair with + | DTuple(DString k, v, _) -> [ (k, fromDT v) ] + | _ -> []) + PT.EDict(uint64 id, pairs) + + + | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> + PT.ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + + | DEnum(_, + _, + [], + "ERecord", + [ DInt64 id + typeName + DList(_vtTODOTypeArgs, typeArgs) + DList(_vtTODO, fieldsList) ]) -> + let typeArgs = List.map TypeReference.fromDT typeArgs + let fields = + fieldsList + |> List.collect (fun field -> + match field with + | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] + | _ -> []) + PT.ERecord( + uint64 id, + NameResolution.fromDT FQTypeName.fromDT typeName, + typeArgs, + fields + ) + + + | DEnum(_, + _, + [], + "EEnum", + [ DInt64 id + typeName + DList(_vtTODOTypeArgs, typeArgs) + DString caseName + DList(_vtTODO, fields) ]) -> + let typeArgs = List.map TypeReference.fromDT typeArgs + + PT.EEnum( + uint64 id, + NameResolution.fromDT FQTypeName.fromDT typeName, + typeArgs, + caseName, + List.map fromDT fields + ) + + // declaring and accessing variables + | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> + PT.ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) + + | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> + PT.ERecordFieldAccess(uint64 id, fromDT expr, fieldName) + + | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> + PT.EVariable(uint64 id, varName) + + // control flow + | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> + let elseExpr = + match elseExpr with + | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) + | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None + | _ -> + Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] + PT.EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) + + | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> + let (cases : List) = + cases + |> List.collect (fun case -> + match case with + | DRecord(_, _, _, fields) -> + let whenCondition = + match Map.tryFind "whenCondition" fields with + | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) + | Some(DEnum(_, _, _, "None", [])) -> None + | _ -> None + match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with + | Some pat, Some rhs -> + [ { pat = MatchPattern.fromDT pat + whenCondition = whenCondition + rhs = fromDT rhs } ] + | _ -> [] + | _ -> []) + PT.EMatch(uint64 id, fromDT arg, cases) + + // | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> + // PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) + + // function calls + | DEnum(_, _, [], "EInfix", [ DInt64 id; infix; lhs; rhs ]) -> + PT.EInfix(uint64 id, Infix.fromDT infix, fromDT lhs, fromDT rhs) + + | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> + let pats = + pats + |> List.map LetPattern.fromDT + |> NEList.ofListUnsafe + "PT2DT.Expr.fromDT expected at least one bound variable in ELambda" + [] + PT.ELambda(uint64 id, pats, fromDT body) + + + | DEnum(_, + _, + [], + "EApply", + [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> + PT.EApply( + uint64 id, + fromDT name, + List.map TypeReference.fromDT typeArgs, + args |> NEList.ofListUnsafe "EApply" [] |> NEList.map fromDT + ) + + | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> + PT.EFnName(uint64 id, NameResolution.fromDT FQFnName.fromDT name) + + | DEnum(_, + _, + [], + "ERecordUpdate", + [ DInt64 id; record; DList(_vtTODO, head :: tail) ]) -> + let updates = + NEList.ofList head tail + |> NEList.map (fun update -> + match update with + | DTuple(DString name, expr, _) -> (name, fromDT expr) + | _ -> + Exception.raiseInternal "Invalid record update" [ "update", update ]) + PT.ERecordUpdate(uint64 id, fromDT record, updates) + + | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] + + +module Const = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.constDef + let knownType = KTCustomType(typeName, []) -// module Deprecation = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.deprecation -// let knownType = KTCustomType(typeName, []) + let rec toDT (c : PT.Const) : Dval = + let (caseName, fields) = + match c with + | PT.Const.CUnit -> "CUnit", [] + | PT.Const.CBool b -> "CBool", [ DBool b ] + | PT.Const.CInt64 i -> "CInt64", [ DInt64 i ] + | PT.Const.CUInt64 i -> "CUInt64", [ DUInt64 i ] + | PT.Const.CInt8 i -> "CInt8", [ DInt8 i ] + | PT.Const.CUInt8 i -> "CUInt8", [ DUInt8 i ] + | PT.Const.CInt16 i -> "CInt16", [ DInt16 i ] + | PT.Const.CUInt16 i -> "CUInt16", [ DUInt16 i ] + | PT.Const.CInt32 i -> "CInt32", [ DInt32 i ] + | PT.Const.CUInt32 i -> "CUInt32", [ DUInt32 i ] + | PT.Const.CInt128 i -> "CInt128", [ DInt128 i ] + | PT.Const.CUInt128 i -> "CUInt128", [ DUInt128 i ] + | PT.Const.CFloat(sign, w, f) -> + "CFloat", [ Sign.toDT sign; DString w; DString f ] + | PT.Const.CChar c -> "CChar", [ DChar c ] + | PT.Const.CString s -> "CString", [ DString s ] + + | PT.Const.CTuple(first, second, theRest) -> + "CTuple", + [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] + + | PT.Const.CEnum(typeName, caseName, fields) -> + "CEnum", + [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + DString caseName + Dval.list knownType (List.map toDT fields) ] + + | PT.Const.CList inner -> + "CList", [ DList(VT.known knownType, List.map toDT inner) ] + + | PT.Const.CDict pairs -> + "CDict", + [ DList( + VT.tuple VT.string VT.string [], + pairs |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) + ) ] -// let toDT -// (innerType : KnownType) -// (inner : 'a -> Dval) -// (d : PT.Deprecation<'a>) -// : Dval = -// let (caseName, fields) = -// match d with -// | PT.Deprecation.NotDeprecated -> "NotDeprecated", [] -// | PT.Deprecation.RenamedTo replacement -> "RenamedTo", [ inner replacement ] -// | PT.Deprecation.ReplacedBy replacement -> "ReplacedBy", [ inner replacement ] -// | PT.Deprecation.DeprecatedBecause reason -> -// "DeprecatedBecause", [ DString reason ] -// DEnum( -// typeName, -// typeName, -// [ VT.known innerType ], -// caseName, -// fields -// ) - -// let fromDT (inner : Dval -> 'a) (d : Dval) : PT.Deprecation<'a> = -// match d with -// | DEnum(_, _, _typeArgsDEnumTODO, "NotDeprecated", []) -> -// PT.Deprecation.NotDeprecated -// | DEnum(_, _, _typeArgsDEnumTODO, "RenamedTo", [ replacement ]) -> -// PT.Deprecation.RenamedTo(inner replacement) -// | DEnum(_, _, _typeArgsDEnumTODO, "ReplacedBy", [ replacement ]) -> -// PT.Deprecation.ReplacedBy(inner replacement) -// | DEnum(_, _, _typeArgsDEnumTODO, "DeprecatedBecause", [ DString reason ]) -> -// PT.Deprecation.DeprecatedBecause(reason) -// | _ -> Exception.raiseInternal "Invalid Deprecation" [] - - -// module TypeDeclaration = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.typeDeclaration + DEnum(typeName, typeName, [], caseName, fields) -// module RecordField = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.recordField -// let knownType = KTCustomType(typeName, []) -// let toDT (rf : PT.TypeDeclaration.RecordField) : Dval = -// let fields = -// [ "name", DString rf.name -// "typ", TypeReference.toDT rf.typ -// "description", DString rf.description ] -// DRecord(typeName, typeName, [], Map fields) + let rec fromDT (d : Dval) : PT.Const = + match d with + | DEnum(_, _, [], "CInt64", [ DInt64 i ]) -> PT.Const.CInt64 i + | DEnum(_, _, [], "CUInt64", [ DUInt64 i ]) -> PT.Const.CUInt64 i + | DEnum(_, _, [], "CInt8", [ DInt8 i ]) -> PT.Const.CInt8 i + | DEnum(_, _, [], "CUInt8", [ DUInt8 i ]) -> PT.Const.CUInt8 i + | DEnum(_, _, [], "CInt16", [ DInt16 i ]) -> PT.Const.CInt16 i + | DEnum(_, _, [], "CUInt16", [ DUInt16 i ]) -> PT.Const.CUInt16 i + | DEnum(_, _, [], "CInt32", [ DInt32 i ]) -> PT.Const.CInt32 i + | DEnum(_, _, [], "CUInt32", [ DUInt32 i ]) -> PT.Const.CUInt32 i + | DEnum(_, _, [], "CInt128", [ DInt128 i ]) -> PT.Const.CInt128 i + | DEnum(_, _, [], "CUInt128", [ DUInt128 i ]) -> PT.Const.CUInt128 i + | DEnum(_, _, [], "CBool", [ DBool b ]) -> PT.Const.CBool b + | DEnum(_, _, [], "CString", [ DString s ]) -> PT.Const.CString s + | DEnum(_, _, [], "CChar", [ DChar c ]) -> PT.Const.CChar c + | DEnum(_, _, [], "CFloat", [ sign; DString w; DString f ]) -> + PT.Const.CFloat(Sign.fromDT sign, w, f) + | DEnum(_, _, [], "CUnit", []) -> PT.Const.CUnit + | DEnum(_, _, [], "CTuple", [ first; second; DList(_vtTODO, rest) ]) -> + PT.Const.CTuple(fromDT first, fromDT second, List.map fromDT rest) + | DEnum(_, _, [], "CEnum", [ typeName; DString caseName; DList(_vtTODO, fields) ]) -> + PT.Const.CEnum( + NameResolution.fromDT FQTypeName.fromDT typeName, + caseName, + List.map fromDT fields + ) + | DEnum(_, _, [], "CList", [ DList(_vtTODO, inner) ]) -> + PT.Const.CList(List.map fromDT inner) + | DEnum(_, _, [], "CDict", [ DList(_vtTODO, pairs) ]) -> + let pairs = + pairs + |> List.map (fun pair -> + match pair with + | DTuple(k, v, _) -> (fromDT k, fromDT v) + | _ -> Exception.raiseInternal "Invalid pair" []) + PT.Const.CDict( + List.map + (fun (k, v) -> + (match k with + | PT.Const.CString s -> s + | _ -> Exception.raiseInternal "Invalid key" []), + v) + pairs + ) + + + | _ -> Exception.raiseInternal "Invalid Const" [] + +module Deprecation = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.deprecation + let knownType = KTCustomType(typeName, []) -// let fromDT (d : Dval) : PT.TypeDeclaration.RecordField = -// match d with -// | DRecord(_, _, _, fields) -> -// { name = fields |> D.stringField "name" -// typ = fields |> D.field "typ" |> TypeReference.fromDT -// description = fields |> D.stringField "description" } -// | _ -> Exception.raiseInternal "Invalid RecordField" [] + let toDT + (innerType : KnownType) + (inner : 'a -> Dval) + (d : PT.Deprecation<'a>) + : Dval = + let (caseName, fields) = + match d with + | PT.Deprecation.NotDeprecated -> "NotDeprecated", [] + | PT.Deprecation.RenamedTo replacement -> "RenamedTo", [ inner replacement ] + | PT.Deprecation.ReplacedBy replacement -> "ReplacedBy", [ inner replacement ] + | PT.Deprecation.DeprecatedBecause reason -> + "DeprecatedBecause", [ DString reason ] + DEnum(typeName, typeName, [ VT.known innerType ], caseName, fields) + + let fromDT (inner : Dval -> 'a) (d : Dval) : PT.Deprecation<'a> = + match d with + | DEnum(_, _, _typeArgsDEnumTODO, "NotDeprecated", []) -> + PT.Deprecation.NotDeprecated + | DEnum(_, _, _typeArgsDEnumTODO, "RenamedTo", [ replacement ]) -> + PT.Deprecation.RenamedTo(inner replacement) + | DEnum(_, _, _typeArgsDEnumTODO, "ReplacedBy", [ replacement ]) -> + PT.Deprecation.ReplacedBy(inner replacement) + | DEnum(_, _, _typeArgsDEnumTODO, "DeprecatedBecause", [ DString reason ]) -> + PT.Deprecation.DeprecatedBecause(reason) + | _ -> Exception.raiseInternal "Invalid Deprecation" [] + + +module TypeDeclaration = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.typeDeclaration -// module EnumField = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumField -// let knownType = KTCustomType(typeName, []) + module RecordField = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.recordField + let knownType = KTCustomType(typeName, []) + + let toDT (rf : PT.TypeDeclaration.RecordField) : Dval = + let fields = + [ "name", DString rf.name + "typ", TypeReference.toDT rf.typ + "description", DString rf.description ] + DRecord(typeName, typeName, [], Map fields) -// let toDT (ef : PT.TypeDeclaration.EnumField) : Dval = -// let fields = -// [ "typ", TypeReference.toDT ef.typ -// "label", ef.label |> Option.map DString |> Dval.option KTString -// "description", DString ef.description ] -// DRecord(typeName, typeName, [], Map fields) + let fromDT (d : Dval) : PT.TypeDeclaration.RecordField = + match d with + | DRecord(_, _, _, fields) -> + { name = fields |> D.field "name" |> D.string + typ = fields |> D.field "typ" |> TypeReference.fromDT + description = fields |> D.field "description" |> D.string } + | _ -> Exception.raiseInternal "Invalid RecordField" [] -// let fromDT (d : Dval) : PT.TypeDeclaration.EnumField = -// match d with -// | DRecord(_, _, _, fields) -> -// { typ = fields |> D.field "typ" |> TypeReference.fromDT -// label = -// match Map.get "label" fields with -// | Some(DEnum(_, _, _typeArgsDEnumTODO, "Some", [ DString label ])) -> -// Some label -// | Some(DEnum(_, _, _typeArgsDEnumTODO, "None", [])) -> None -// | _ -> -// Exception.raiseInternal "Expected label to be an option of string" [] -// description = fields |> D.stringField "description" } -// | _ -> Exception.raiseInternal "Invalid EnumField" [] - - -// module EnumCase = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumCase -// let knownType = KTCustomType(typeName, []) - -// let toDT (ec : PT.TypeDeclaration.EnumCase) : Dval = -// let fields = -// [ "name", DString ec.name -// "fields", -// DList(VT.known EnumField.knownType, List.map EnumField.toDT ec.fields) -// "description", DString ec.description ] -// DRecord(typeName, typeName, [], Map fields) - -// let fromDT (d : Dval) : PT.TypeDeclaration.EnumCase = -// match d with -// | DRecord(_, _, _, fields) -> -// { name = fields |> D.stringField "name" -// fields = fields |> D.listField "fields" |> List.map EnumField.fromDT -// description = fields |> D.stringField "description" } + module EnumField = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumField + let knownType = KTCustomType(typeName, []) + + let toDT (ef : PT.TypeDeclaration.EnumField) : Dval = + let fields = + [ "typ", TypeReference.toDT ef.typ + "label", ef.label |> Option.map DString |> Dval.option KTString + "description", DString ef.description ] + DRecord(typeName, typeName, [], Map fields) -// | _ -> Exception.raiseInternal "Invalid EnumCase" [] + let fromDT (d : Dval) : PT.TypeDeclaration.EnumField = + match d with + | DRecord(_, _, _, fields) -> + { typ = fields |> D.field "typ" |> TypeReference.fromDT + label = + match Map.get "label" fields with + | Some(DEnum(_, _, _typeArgsDEnumTODO, "Some", [ DString label ])) -> + Some label + | Some(DEnum(_, _, _typeArgsDEnumTODO, "None", [])) -> None + | _ -> + Exception.raiseInternal "Expected label to be an option of string" [] + description = fields |> D.field "description" |> D.string } + | _ -> Exception.raiseInternal "Invalid EnumField" [] + + + module EnumCase = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.enumCase + let knownType = KTCustomType(typeName, []) + + let toDT (ec : PT.TypeDeclaration.EnumCase) : Dval = + let fields = + [ "name", DString ec.name + "fields", + DList(VT.known EnumField.knownType, List.map EnumField.toDT ec.fields) + "description", DString ec.description ] + DRecord(typeName, typeName, [], Map fields) + let fromDT (d : Dval) : PT.TypeDeclaration.EnumCase = + match d with + | DRecord(_, _, _, fields) -> + { name = fields |> D.field "name" |> D.string + fields = fields |> D.field "fields" |> D.list EnumField.fromDT + description = fields |> D.field "description" |> D.string } -// module Definition = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.definition + | _ -> Exception.raiseInternal "Invalid EnumCase" [] -// let toDT (d : PT.TypeDeclaration.Definition) : Dval = -// let (caseName, fields) = -// match d with -// | PT.TypeDeclaration.Alias typeRef -> "Alias", [ TypeReference.toDT typeRef ] - -// | PT.TypeDeclaration.Record fields -> -// "Record", -// [ DList( -// VT.known RecordField.knownType, -// fields |> NEList.toList |> List.map RecordField.toDT -// ) ] - -// | PT.TypeDeclaration.Enum cases -> -// "Enum", -// [ DList( -// VT.known EnumCase.knownType, -// cases |> NEList.toList |> List.map EnumCase.toDT -// ) ] -// DEnum(typeName, typeName, [], caseName, fields) -// let fromDT (d : Dval) : PT.TypeDeclaration.Definition = -// match d with -// | DEnum(_, _, [], "Alias", [ typeRef ]) -> -// PT.TypeDeclaration.Alias(TypeReference.fromDT typeRef) + module Definition = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.TypeDeclaration.definition + + let toDT (d : PT.TypeDeclaration.Definition) : Dval = + let (caseName, fields) = + match d with + | PT.TypeDeclaration.Alias typeRef -> "Alias", [ TypeReference.toDT typeRef ] + + | PT.TypeDeclaration.Record fields -> + "Record", + [ DList( + VT.known RecordField.knownType, + fields |> NEList.toList |> List.map RecordField.toDT + ) ] + + | PT.TypeDeclaration.Enum cases -> + "Enum", + [ DList( + VT.known EnumCase.knownType, + cases |> NEList.toList |> List.map EnumCase.toDT + ) ] + DEnum(typeName, typeName, [], caseName, fields) + + let fromDT (d : Dval) : PT.TypeDeclaration.Definition = + match d with + | DEnum(_, _, [], "Alias", [ typeRef ]) -> + PT.TypeDeclaration.Alias(TypeReference.fromDT typeRef) -// | DEnum(_, _, [], "Record", [ DList(_vtTODO, firstField :: additionalFields) ]) -> -// PT.TypeDeclaration.Record( -// NEList.ofList firstField additionalFields |> NEList.map RecordField.fromDT -// ) + | DEnum(_, _, [], "Record", [ DList(_vtTODO, firstField :: additionalFields) ]) -> + PT.TypeDeclaration.Record( + NEList.ofList firstField additionalFields |> NEList.map RecordField.fromDT + ) -// | DEnum(_, _, [], "Enum", [ DList(_vtTODO, firstCase :: additionalCases) ]) -> -// PT.TypeDeclaration.Enum( -// NEList.ofList firstCase additionalCases |> NEList.map EnumCase.fromDT -// ) + | DEnum(_, _, [], "Enum", [ DList(_vtTODO, firstCase :: additionalCases) ]) -> + PT.TypeDeclaration.Enum( + NEList.ofList firstCase additionalCases |> NEList.map EnumCase.fromDT + ) -// | _ -> Exception.raiseInternal "Invalid TypeDeclaration.Definition" [] + | _ -> Exception.raiseInternal "Invalid TypeDeclaration.Definition" [] -// let toDT (td : PT.TypeDeclaration.T) : Dval = -// let fields = -// [ "typeParams", DList(VT.string, List.map DString td.typeParams) -// "definition", Definition.toDT td.definition ] -// DRecord(typeName, typeName, [], Map fields) + let toDT (td : PT.TypeDeclaration.T) : Dval = + let fields = + [ "typeParams", DList(VT.string, List.map DString td.typeParams) + "definition", Definition.toDT td.definition ] + DRecord(typeName, typeName, [], Map fields) -// let fromDT (d : Dval) : PT.TypeDeclaration.T = -// match d with -// | DRecord(_, _, _, fields) -> -// { typeParams = fields |> D.stringListField "typeParams" -// definition = fields |> D.field "definition" |> Definition.fromDT } -// | _ -> Exception.raiseInternal "Invalid TypeDeclaration" [] + let fromDT (d : Dval) : PT.TypeDeclaration.T = + match d with + | DRecord(_, _, _, fields) -> + { typeParams = fields |> D.field "typeParams" |> D.list D.string + definition = fields |> D.field "definition" |> Definition.fromDT } + | _ -> Exception.raiseInternal "Invalid TypeDeclaration" [] // module Handler = @@ -1315,7 +1337,7 @@ module NameResolution = // match d with // | DRecord(_, _, _, fields) -> // { tlid = fields |> D.uint64Field "tlid" -// name = fields |> D.stringField "name" +// name = fields |> D.field "name" |> D.string // version = fields |> D.int32Field "version" // typ = fields |> D.field "typ" |> TypeReference.fromDT } // | _ -> Exception.raiseInternal "Invalid DB" [] @@ -1335,190 +1357,190 @@ module NameResolution = // let fromDT (d : Dval) : PT.Secret.T = // match d with // | DRecord(_, _, _, fields) -> -// { name = fields |> D.stringField "name" -// value = fields |> D.stringField "value" +// { name = fields |> D.field "name" |> D.string +// value = fields |> D.field "value" |> D.string // version = fields |> D.int32Field "version" } // | _ -> Exception.raiseInternal "Invalid Secret" [] -// module PackageType = -// module Name = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.name - -// let toDT (n : PT.PackageType.Name) : Dval = -// let fields = -// [ "owner", DString n.owner -// "modules", DList(VT.string, List.map DString n.modules) -// "name", DString n.name ] -// DRecord(typeName, typeName, [], Map fields) - -// let fromDT (d : Dval) : PT.PackageType.Name = -// match d with -// | DRecord(_, _, _, fields) -> -// { owner = fields |> D.stringField "owner" -// modules = fields |> D.stringListField "modules" -// name = fields |> D.stringField "name" } -// | _ -> Exception.raiseInternal "Invalid PackageType.Name" [] - - -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.packageType - -// let toDT (p : PT.PackageType.PackageType) : Dval = -// let fields = -// [ "id", DUuid p.id -// "name", Name.toDT p.name -// "declaration", TypeDeclaration.toDT p.declaration -// "description", DString p.description -// "deprecated", -// Deprecation.toDT FQTypeName.knownType FQTypeName.toDT p.deprecated ] -// DRecord(typeName, typeName, [], Map fields) - - -// let fromDT (d : Dval) : PT.PackageType.PackageType = -// match d with -// | DRecord(_, _, _, fields) -> -// { id = fields |> D.uuidField "id" -// name = fields |> D.field "name" |> Name.fromDT -// declaration = fields |> D.field "declaration" |> TypeDeclaration.fromDT -// description = fields |> D.stringField "description" -// deprecated = -// fields |> D.field "deprecated" |> Deprecation.fromDT FQTypeName.fromDT } -// | _ -> Exception.raiseInternal "Invalid PackageType" [] - - -// module PackageConstant = -// module Name = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.name - -// let toDT (n : PT.PackageConstant.Name) : Dval = -// let fields = -// [ "owner", DString n.owner -// "modules", DList(VT.string, List.map DString n.modules) -// "name", DString n.name ] -// DRecord(typeName, typeName, [], Map fields) +module PackageType = + module Name = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.name -// let fromDT (d : Dval) : PT.PackageConstant.Name = -// match d with -// | DRecord(_, _, _, fields) -> -// { owner = fields |> D.stringField "owner" -// modules = fields |> D.stringListField "modules" -// name = fields |> D.stringField "name" } -// | _ -> Exception.raiseInternal "Invalid PackageConstant.Name" [] + let toDT (n : PT.PackageType.Name) : Dval = + let fields = + [ "owner", DString n.owner + "modules", DList(VT.string, List.map DString n.modules) + "name", DString n.name ] + DRecord(typeName, typeName, [], Map fields) + let fromDT (d : Dval) : PT.PackageType.Name = + match d with + | DRecord(_, _, _, fields) -> + { owner = fields |> D.field "owner" |> D.string + modules = fields |> D.field "modules" |> D.list D.string + name = fields |> D.field "name" |> D.string } + | _ -> Exception.raiseInternal "Invalid PackageType.Name" [] -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.packageConstant -// let toDT (p : PT.PackageConstant.PackageConstant) : Dval = -// let fields = -// [ "id", DUuid p.id -// "name", Name.toDT p.name -// "body", Const.toDT p.body -// "description", DString p.description -// "deprecated", -// Deprecation.toDT FQConstantName.knownType FQConstantName.toDT p.deprecated ] -// DRecord(typeName, typeName, [], Map fields) + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageType.packageType -// let fromDT (d : Dval) : PT.PackageConstant.PackageConstant = -// match d with -// | DRecord(_, _, _, fields) -> -// { id = fields |> D.uuidField "id" -// name = fields |> D.field "name" |> Name.fromDT -// body = fields |> D.field "body" |> Const.fromDT -// description = fields |> D.stringField "description" -// deprecated = -// fields |> D.field "deprecated" |> Deprecation.fromDT FQConstantName.fromDT } -// | _ -> Exception.raiseInternal "Invalid PackageConstant" [] + let toDT (p : PT.PackageType.PackageType) : Dval = + let fields = + [ "id", DUuid p.id + "name", Name.toDT p.name + "declaration", TypeDeclaration.toDT p.declaration + "description", DString p.description + "deprecated", + Deprecation.toDT FQTypeName.knownType FQTypeName.toDT p.deprecated ] + DRecord(typeName, typeName, [], Map fields) -// module PackageFn = -// module Name = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.name + let fromDT (d : Dval) : PT.PackageType.PackageType = + match d with + | DRecord(_, _, _, fields) -> + { id = fields |> D.field "id" |> D.uuid + name = fields |> D.field "name" |> Name.fromDT + declaration = fields |> D.field "declaration" |> TypeDeclaration.fromDT + description = fields |> D.field "description" |> D.string + deprecated = + fields |> D.field "deprecated" |> Deprecation.fromDT FQTypeName.fromDT } + | _ -> Exception.raiseInternal "Invalid PackageType" [] + + +module PackageConstant = + module Name = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.name -// let toDT (n : PT.PackageFn.Name) : Dval = -// let fields = -// [ "owner", DString n.owner -// "modules", DList(VT.string, List.map DString n.modules) -// "name", DString n.name ] -// DRecord(typeName, typeName, [], Map fields) + let toDT (n : PT.PackageConstant.Name) : Dval = + let fields = + [ "owner", DString n.owner + "modules", DList(VT.string, List.map DString n.modules) + "name", DString n.name ] + DRecord(typeName, typeName, [], Map fields) -// let fromDT (d : Dval) : PT.PackageFn.Name = -// match d with -// | DRecord(_, _, _, fields) -> -// { owner = fields |> D.stringField "owner" -// modules = fields |> D.stringListField "modules" -// name = fields |> D.stringField "name" } -// | _ -> Exception.raiseInternal "Invalid PackageFn.Name" [] + let fromDT (d : Dval) : PT.PackageConstant.Name = + match d with + | DRecord(_, _, _, fields) -> + { owner = fields |> D.field "owner" |> D.string + modules = fields |> D.field "modules" |> D.list D.string + name = fields |> D.field "name" |> D.string } + | _ -> Exception.raiseInternal "Invalid PackageConstant.Name" [] -// module Parameter = -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.parameter + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageConstant.packageConstant + + let toDT (p : PT.PackageConstant.PackageConstant) : Dval = + let fields = + [ "id", DUuid p.id + "name", Name.toDT p.name + "body", Const.toDT p.body + "description", DString p.description + "deprecated", + Deprecation.toDT FQConstantName.knownType FQConstantName.toDT p.deprecated ] + DRecord(typeName, typeName, [], Map fields) + + let fromDT (d : Dval) : PT.PackageConstant.PackageConstant = + match d with + | DRecord(_, _, _, fields) -> + { id = fields |> D.field "id" |> D.uuid + name = fields |> D.field "name" |> Name.fromDT + body = fields |> D.field "body" |> Const.fromDT + description = fields |> D.field "description" |> D.string + deprecated = + fields |> D.field "deprecated" |> Deprecation.fromDT FQConstantName.fromDT } + | _ -> Exception.raiseInternal "Invalid PackageConstant" [] + + +module PackageFn = + module Name = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.name -// let knownType = KTCustomType(typeName, []) + let toDT (n : PT.PackageFn.Name) : Dval = + let fields = + [ "owner", DString n.owner + "modules", DList(VT.string, List.map DString n.modules) + "name", DString n.name ] + DRecord(typeName, typeName, [], Map fields) -// let toDT (p : PT.PackageFn.Parameter) : Dval = -// let fields = -// [ "name", DString p.name -// "typ", TypeReference.toDT p.typ -// "description", DString p.description ] -// DRecord(typeName, typeName, [], Map fields) + let fromDT (d : Dval) : PT.PackageFn.Name = + match d with + | DRecord(_, _, _, fields) -> + { owner = fields |> D.field "owner" |> D.string + modules = fields |> D.field "modules" |> D.list D.string + name = fields |> D.field "name" |> D.string } + | _ -> Exception.raiseInternal "Invalid PackageFn.Name" [] -// let fromDT (d : Dval) : PT.PackageFn.Parameter = -// match d with -// | DRecord(_, _, _, fields) -> -// { name = fields |> D.stringField "name" -// typ = fields |> D.field "typ" |> TypeReference.fromDT -// description = fields |> D.stringField "description" } -// | _ -> Exception.raiseInternal "Invalid PackageFn.Parameter" [] + module Parameter = + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.parameter + let knownType = KTCustomType(typeName, []) -// let typeName = -// FQTypeName.fqPackage -// PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.packageFn + let toDT (p : PT.PackageFn.Parameter) : Dval = + let fields = + [ "name", DString p.name + "typ", TypeReference.toDT p.typ + "description", DString p.description ] + DRecord(typeName, typeName, [], Map fields) -// let toDT (p : PT.PackageFn.PackageFn) : Dval = -// let fields = -// [ ("id", DUuid p.id) -// ("name", Name.toDT p.name) -// ("body", Expr.toDT p.body) -// ("typeParams", DList(VT.string, List.map DString p.typeParams)) -// ("parameters", -// DList( -// VT.known Parameter.knownType, -// p.parameters |> NEList.toList |> List.map Parameter.toDT -// )) -// ("returnType", TypeReference.toDT p.returnType) -// ("description", DString p.description) -// ("deprecated", Deprecation.toDT FQFnName.knownType FQFnName.toDT p.deprecated) ] -// DRecord(typeName, typeName, [], Map fields) + let fromDT (d : Dval) : PT.PackageFn.Parameter = + match d with + | DRecord(_, _, _, fields) -> + { name = fields |> D.field "name" |> D.string + typ = fields |> D.field "typ" |> TypeReference.fromDT + description = fields |> D.field "description" |> D.string } + | _ -> Exception.raiseInternal "Invalid PackageFn.Parameter" [] -// let fromDT (d : Dval) : PT.PackageFn.PackageFn = -// match d with -// | DRecord(_, _, _, fields) -> -// { id = fields |> D.uuidField "id" -// name = fields |> D.field "name" |> Name.fromDT -// body = fields |> D.field "body" |> Expr.fromDT -// typeParams = fields |> D.stringListField "typeParams" -// parameters = -// fields -// |> D.listField "parameters" -// |> List.map Parameter.fromDT -// |> NEList.ofListUnsafe "PackageFn.fromDT" [] -// returnType = fields |> D.field "returnType" |> TypeReference.fromDT -// description = fields |> D.stringField "description" -// deprecated = -// fields |> D.field "deprecated" |> Deprecation.fromDT FQFnName.fromDT } -// | _ -> Exception.raiseInternal "Invalid PackageFn" [] + let typeName = + FQTypeName.fqPackage + PackageIDs.Type.LanguageTools.ProgramTypes.PackageFn.packageFn + + let toDT (p : PT.PackageFn.PackageFn) : Dval = + let fields = + [ ("id", DUuid p.id) + ("name", Name.toDT p.name) + ("body", Expr.toDT p.body) + ("typeParams", DList(VT.string, List.map DString p.typeParams)) + ("parameters", + DList( + VT.known Parameter.knownType, + p.parameters |> NEList.toList |> List.map Parameter.toDT + )) + ("returnType", TypeReference.toDT p.returnType) + ("description", DString p.description) + ("deprecated", Deprecation.toDT FQFnName.knownType FQFnName.toDT p.deprecated) ] + + DRecord(typeName, typeName, [], Map fields) + + + let fromDT (d : Dval) : PT.PackageFn.PackageFn = + match d with + | DRecord(_, _, _, fields) -> + { id = fields |> D.field "id" |> D.uuid + name = fields |> D.field "name" |> Name.fromDT + body = fields |> D.field "body" |> Expr.fromDT + typeParams = fields |> D.field "typeParams" |> D.list D.string + parameters = + fields + |> D.field "parameters" + |> D.list Parameter.fromDT + |> NEList.ofListUnsafe "PackageFn.fromDT" [] + returnType = fields |> D.field "returnType" |> TypeReference.fromDT + description = fields |> D.field "description" |> D.string + deprecated = + fields |> D.field "deprecated" |> Deprecation.fromDT FQFnName.fromDT } + | _ -> Exception.raiseInternal "Invalid PackageFn" [] diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 9a44e6b6c8..521b0f62aa 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -222,7 +222,6 @@ module MatchPattern = RT.MPList pats, symbols, rc - | PT.MPListCons(_, head, tail) -> let head, symbols, rc = toRT symbols rc head let tail, symbols, rc = toRT symbols rc tail @@ -241,6 +240,17 @@ module MatchPattern = RT.MPTuple(first, second, theRest), symbols, rc + | PT.MPEnum(_, caseName, fieldPats) -> + let fieldPats, symbols, rc = + fieldPats + |> List.fold + (fun (fieldPats, symbols, rc) fieldPat -> + let pat, symbols, rc = toRT symbols rc fieldPat + (fieldPats @ [ pat ], symbols, rc)) + ([], symbols, rc) + + RT.MPEnum(caseName, fieldPats), symbols, rc + | PT.MPVariable(_, name) -> RT.MPVariable rc, (symbols |> Map.add name rc), rc + 1 @@ -883,13 +893,13 @@ module TypeDeclaration = let toRT (f : PT.TypeDeclaration.RecordField) : RT.TypeDeclaration.RecordField = { name = f.name; typ = TypeReference.toRT f.typ } - // module EnumField = - // let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = - // TypeReference.toRT f.typ + module EnumField = + let toRT (f : PT.TypeDeclaration.EnumField) : RT.TypeReference = + TypeReference.toRT f.typ - // module EnumCase = - // let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = - // { name = c.name; fields = List.map EnumField.toRT c.fields } + module EnumCase = + let toRT (c : PT.TypeDeclaration.EnumCase) : RT.TypeDeclaration.EnumCase = + { name = c.name; fields = List.map EnumField.toRT c.fields } module Definition = let toRT (d : PT.TypeDeclaration.Definition) : RT.TypeDeclaration.Definition = @@ -900,8 +910,8 @@ module TypeDeclaration = | PT.TypeDeclaration.Record fields -> RT.TypeDeclaration.Record(NEList.map RecordField.toRT fields) - // | PT.TypeDeclaration.Enum cases -> - // RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) + | PT.TypeDeclaration.Enum cases -> + RT.TypeDeclaration.Enum(NEList.map EnumCase.toRT cases) let toRT (t : PT.TypeDeclaration.T) : RT.TypeDeclaration.T = { typeParams = t.typeParams; definition = Definition.toRT t.definition } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 872e408e99..6c3b81a58b 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -143,20 +143,20 @@ type KnownType = /// `Unknown`. | KTTuple of ValueType * ValueType * List - // /// let f = (fun x -> x) // KTFn([Unknown], Unknown) - // /// let intF = (fun (x: Int) -> x) // KTFn([Known KTInt64], Unknown) - // /// - // /// Note that we could theoretically know some return types by analyzing the - // /// code or type signatures of functions. We don't do this yet as it's - // /// complicated. When we do decide to do this, some incorrect programs may stop - // /// functioning (see example). Our goal is for correctly typed functions to - // /// stay working so this might be ok. - // /// - // /// For example: - // /// let z1 = (fun x -> 5) - // /// let z2 = (fun x -> "str") - // /// `[z1, z2]` is allowed now but might not be allowed later - // | KTFn of args : NEList * ret : ValueType + /// let f = (fun x -> x) // KTFn([Unknown], Unknown) + /// let intF = (fun (x: Int) -> x) // KTFn([Known KTInt64], Unknown) + /// + /// Note that we could theoretically know some return types by analyzing the + /// code or type signatures of functions. We don't do this yet as it's + /// complicated. When we do decide to do this, some incorrect programs may stop + /// functioning (see example). Our goal is for correctly typed functions to + /// stay working so this might be ok. + /// + /// For example: + /// let z1 = (fun x -> 5) + /// let z2 = (fun x -> "str") + /// `[z1, z2]` is allowed now but might not be allowed later + | KTFn of args : NEList * ret : ValueType // /// At time of writing, all DBs are of a specific type, and DBs may only be // /// referenced directly, but we expect to eventually allow references to DBs @@ -310,6 +310,7 @@ type MatchPattern = first : MatchPattern * second : MatchPattern * theRest : List + | MPEnum of caseName : string * fields : List | MPVariable of Register @@ -680,8 +681,10 @@ module RuntimeError = // | NonIntReturned of actuallyReturned: Dval.Dval - // module Json = - // type Error = UnsupportedType of RuntimeTypes.TypeReference + module Jsons = + type Error = + | UnsupportedType of TypeReference + | CannotSerializeTypeValueCombo of Dval * TypeReference module Ints = @@ -809,7 +812,7 @@ module RuntimeError = | Bool of Bools.Error | Int of Ints.Error - //| Json of Json.Error + | Json of Jsons.Error | String of Strings.Error | List of Lists.Error | Dict of Dicts.Error @@ -963,11 +966,14 @@ module TypeReference = /// The tricky part is that we do want the CallStack around, to report on, /// and to use for debugging, but the way the Interpreter+Execution is set up, /// there's no great single place to `try/with` to supply the call stack. -exception RuntimeErrorException of ThreadID * rte : RuntimeError.Error +exception RuntimeErrorException of Option * rte : RuntimeError.Error let raiseRTE (threadId : ThreadID) (rte : RuntimeError.Error) : 'a = - raise (RuntimeErrorException(threadId, rte)) + raise (RuntimeErrorException(Some threadId, rte)) + +let raiseUntargetedRTE (rte : RuntimeError.Error) : 'a = + raise (RuntimeErrorException(None, rte)) // // (only?) OK in builtins because we "fill in" the callstack in the Interpreter for such failures @@ -1009,12 +1015,12 @@ type Deprecation<'name> = module TypeDeclaration = type RecordField = { name : string; typ : TypeReference } - //type EnumCase = { name : string; fields : List } + type EnumCase = { name : string; fields : List } type Definition = | Alias of TypeReference | Record of NEList - //| Enum of NEList + | Enum of NEList type T = { typeParams : List; definition : Definition } @@ -1498,54 +1504,54 @@ module Types = | FQTypeName.Package pkg -> types.package pkg |> Ply.map (Option.map _.declaration) -// /// Swap concrete types for type parameters -// let rec substitute -// (typeParams : List) -// (typeArguments : List) -// (typ : TypeReference) -// : TypeReference = -// let substitute = substitute typeParams typeArguments -// match typ with -// | TVariable v -> -// if typeParams.Length = typeArguments.Length then -// List.zip typeParams typeArguments -// |> List.find (fun (param, _) -> param = v) -// |> Option.map snd -// |> Exception.unwrapOptionInternal -// "No type argument found for type parameter" -// [] -// else -// Exception.raiseInternal -// $"typeParams and typeArguments have different lengths" -// [ "typeParams", typeParams; "typeArguments", typeArguments ] - - -// | TUnit -// | TBool -// | TInt8 -// | TUInt8 -// | TInt16 -// | TUInt16 -// | TInt32 -// | TUInt32 -// | TInt64 -// | TUInt64 -// | TInt128 -// | TUInt128 -// | TFloat -// | TChar -// | TString -// | TUuid -// | TDateTime -> typ - -// | TList t -> TList(substitute t) -// | TTuple(t1, t2, rest) -> -// TTuple(substitute t1, substitute t2, List.map substitute rest) -// | TFn _ -> typ // TYPESTODO -// | TDB _ -> typ // TYPESTODO -// | TCustomType(typeName, typeArgs) -> -// TCustomType(typeName, List.map substitute typeArgs) -// | TDict t -> TDict(substitute t) + /// Swap concrete types for type parameters + let rec substitute + (typeParams : List) + (typeArguments : List) + (typ : TypeReference) + : TypeReference = + let substitute = substitute typeParams typeArguments + match typ with + | TVariable v -> + if typeParams.Length = typeArguments.Length then + List.zip typeParams typeArguments + |> List.find (fun (param, _) -> param = v) + |> Option.map snd + |> Exception.unwrapOptionInternal + "No type argument found for type parameter" + [] + else + Exception.raiseInternal + $"typeParams and typeArguments have different lengths" + [ "typeParams", typeParams; "typeArguments", typeArguments ] + + + | TUnit + | TBool + | TInt8 + | TUInt8 + | TInt16 + | TUInt16 + | TInt32 + | TUInt32 + | TInt64 + | TUInt64 + | TInt128 + | TUInt128 + | TFloat + | TChar + | TString + | TUuid + | TDateTime -> typ + + | TList t -> TList(substitute t) + | TTuple(t1, t2, rest) -> + TTuple(substitute t1, substitute t2, List.map substitute rest) + | TFn _ -> typ // TYPESTODO + // | TDB _ -> typ // TYPESTODO + | TCustomType(typeName, typeArgs) -> + TCustomType(typeName, List.map substitute typeArgs) + | TDict t -> TDict(substitute t) diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs index 704372648c..fa9ec54f36 100644 --- a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs +++ b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs @@ -10,10 +10,10 @@ module C2DT = LibExecution.CommonToDarkTypes // TODO: should these be elsewhere? -let ownerField m = m |> D.stringField "owner" -let modulesField m = m |> D.stringListField "modules" -let nameField m = m |> D.stringField "name" -let versionField m = m |> D.int32Field "version" +let ownerField m = m |> D.field "owner" |> D.string +let modulesField m = m |> D.field "modules" |> D.list D.string +let nameField m = m |> D.field "name" |> D.string +let versionField m = m |> D.field "version" |> D.int32 module FQTypeName = @@ -138,16 +138,16 @@ module NameResolution = FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeError.NameResolution.error - let toDT - (nameValueType : KnownType) - (f : 'p -> Dval) - (result : NameResolution<'p>) - : Dval = - let errType = KTCustomType(typeName, []) - C2DT.Result.toDT nameValueType errType result f RuntimeError.toDT +// let toDT +// (nameValueType : KnownType) +// (f : 'p -> Dval) +// (result : NameResolution<'p>) +// : Dval = +// let errType = KTCustomType(typeName, []) +// C2DT.Result.toDT nameValueType errType result f RuntimeError.toDT - let fromDT (f : Dval -> 'a) (d : Dval) : NameResolution<'a> = - C2DT.Result.fromDT f d RuntimeError.fromDT +// let fromDT (f : Dval -> 'a) (d : Dval) : NameResolution<'a> = +// C2DT.Result.fromDT f d RuntimeError.fromDT module TypeReference = @@ -186,16 +186,19 @@ module TypeReference = | TDict inner -> "TDict", [ toDT inner ] - | TCustomType(typeName, typeArgs) -> - "TCustomType", - [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName - DList(VT.known knownType, List.map toDT typeArgs) ] + // | TCustomType(typeName, typeArgs) -> + // "TCustomType", + // [ NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + // DList(VT.known knownType, List.map toDT typeArgs) ] - | TDB inner -> "TDB", [ toDT inner ] + // | TDB inner -> "TDB", [ toDT inner ] | TFn(args, ret) -> let args = args |> NEList.toList |> List.map toDT |> Dval.list knownType "TFn", [ args; toDT ret ] + // TODO: remove this + | _ -> Exception.raiseInternal "Invalid TypeReference" [] + DEnum(typeName, typeName, [], caseName, fields) let rec fromDT (d : Dval) : TypeReference = @@ -227,13 +230,13 @@ module TypeReference = | DEnum(_, _, [], "TDict", [ inner ]) -> TDict(fromDT inner) - | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> - TCustomType( - NameResolution.fromDT FQTypeName.fromDT typeName, - List.map fromDT typeArgs - ) + // | DEnum(_, _, [], "TCustomType", [ typeName; DList(_vtTODO, typeArgs) ]) -> + // TCustomType( + // NameResolution.fromDT FQTypeName.fromDT typeName, + // List.map fromDT typeArgs + // ) - | DEnum(_, _, [], "TDB", [ inner ]) -> TDB(fromDT inner) + // | DEnum(_, _, [], "TDB", [ inner ]) -> TDB(fromDT inner) | DEnum(_, _, [], "TFn", [ DList(_vtTODO, firstArg :: otherArgs); ret ]) -> TFn(NEList.ofList (fromDT firstArg) (List.map fromDT otherArgs), fromDT ret) | _ -> Exception.raiseInternal "Invalid TypeReference" [ "typeRef", d ] @@ -255,28 +258,20 @@ module LetPattern = let rec toDT (p : LetPattern) : Dval = let (caseName, fields) = match p with - | LPVariable(id, name) -> "LPVariable", [ DInt64(int64 id); DString name ] - | LPUnit id -> "LPUnit", [ DInt64(int64 id) ] - | LPTuple(id, first, second, theRest) -> + | LPVariable reg -> "LPVariable", [ DInt32 reg ] + | LPUnit -> "LPUnit", [] + | LPTuple(first, second, theRest) -> "LPTuple", - [ DInt64(int64 id) - toDT first - toDT second - DList(VT.known knownType, List.map toDT theRest) ] + [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] DEnum(typeName, typeName, [], caseName, fields) let rec fromDT (d : Dval) : LetPattern = match d with - | DEnum(_, _, [], "LPVariable", [ DInt64 id; DString name ]) -> - LPVariable(uint64 id, name) - | DEnum(_, _, [], "LPUnit", [ DInt64 id ]) -> LPUnit(uint64 id) - | DEnum(_, - _, - [], - "LPTuple", - [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - LPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) + | DEnum(_, _, [], "LPVariable", [ DInt32 reg ]) -> LPVariable(reg) + | DEnum(_, _, [], "LPUnit", []) -> LPUnit + | DEnum(_, _, [], "LPTuple", [ first; second; DList(_vtTODO, theRest) ]) -> + LPTuple(fromDT first, fromDT second, List.map fromDT theRest) | _ -> Exception.raiseInternal "Invalid LetPattern" [] @@ -288,85 +283,67 @@ module MatchPattern = let rec toDT (p : MatchPattern) : Dval = let (caseName, fields) = match p with - | MPVariable(id, name) -> "MPVariable", [ DInt64(int64 id); DString name ] - - | MPUnit id -> "MPUnit", [ DInt64(int64 id) ] - | MPBool(id, b) -> "MPBool", [ DInt64(int64 id); DBool b ] - | MPInt8(id, i) -> "MPInt8", [ DInt64(int64 id); DInt8 i ] - | MPUInt8(id, i) -> "MPUInt8", [ DInt64(int64 id); DUInt8 i ] - | MPInt16(id, i) -> "MPInt16", [ DInt64(int64 id); DInt16 i ] - | MPUInt16(id, i) -> "MPUInt16", [ DInt64(int64 id); DUInt16 i ] - | MPInt32(id, i) -> "MPInt32", [ DInt64(int64 id); DInt32 i ] - | MPUInt32(id, i) -> "MPUInt32", [ DInt64(int64 id); DUInt32 i ] - | MPInt64(id, i) -> "MPInt64", [ DInt64(int64 id); DInt64 i ] - | MPUInt64(id, i) -> "MPUInt64", [ DInt64(int64 id); DUInt64 i ] - | MPInt128(id, i) -> "MPInt128", [ DInt64(int64 id); DInt128 i ] - | MPUInt128(id, i) -> "MPUInt128", [ DInt64(int64 id); DUInt128 i ] - | MPFloat(id, f) -> "MPFloat", [ DInt64(int64 id); DFloat f ] - | MPChar(id, c) -> "MPChar", [ DInt64(int64 id); DString c ] - | MPString(id, s) -> "MPString", [ DInt64(int64 id); DString s ] - - | MPList(id, inner) -> - "MPList", - [ DInt64(int64 id); DList(VT.known knownType, List.map toDT inner) ] - | MPListCons(id, head, tail) -> - "MPListCons", [ DInt64(int64 id); toDT head; toDT tail ] - - | MPTuple(id, first, second, theRest) -> + | MPVariable(reg) -> "MPVariable", [ DInt32 reg ] + + | MPUnit -> "MPUnit", [] + | MPBool b -> "MPBool", [ DBool b ] + | MPInt8 i -> "MPInt8", [ DInt8 i ] + | MPUInt8 i -> "MPUInt8", [ DUInt8 i ] + | MPInt16 i -> "MPInt16", [ DInt16 i ] + | MPUInt16 i -> "MPUInt16", [ DUInt16 i ] + | MPInt32 i -> "MPInt32", [ DInt32 i ] + | MPUInt32 i -> "MPUInt32", [ DUInt32 i ] + | MPInt64 i -> "MPInt64", [ DInt64 i ] + | MPUInt64 i -> "MPUInt64", [ DUInt64 i ] + | MPInt128 i -> "MPInt128", [ DInt128 i ] + | MPUInt128 i -> "MPUInt128", [ DUInt128 i ] + | MPFloat f -> "MPFloat", [ DFloat f ] + | MPChar c -> "MPChar", [ DString c ] + | MPString s -> "MPString", [ DString s ] + + | MPList inner -> "MPList", [ DList(VT.known knownType, List.map toDT inner) ] + | MPListCons(head, tail) -> "MPListCons", [ toDT head; toDT tail ] + + | MPTuple(first, second, theRest) -> "MPTuple", - [ DInt64(int64 id) - toDT first - toDT second - DList(VT.known knownType, List.map toDT theRest) ] + [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - | MPEnum(id, caseName, fieldPats) -> + | MPEnum(caseName, fieldPats) -> "MPEnum", - [ DInt64(int64 id) - DString caseName - DList(VT.known knownType, List.map toDT fieldPats) ] + [ DString caseName; DList(VT.known knownType, List.map toDT fieldPats) ] DEnum(typeName, typeName, [], caseName, fields) let rec fromDT (d : Dval) : MatchPattern = match d with - | DEnum(_, _, [], "MPVariable", [ DInt64 id; DString name ]) -> - MPVariable(uint64 id, name) - - | DEnum(_, _, [], "MPUnit", [ DInt64 id ]) -> MPUnit(uint64 id) - | DEnum(_, _, [], "MPBool", [ DInt64 id; DBool b ]) -> MPBool(uint64 id, b) - | DEnum(_, _, [], "MPInt8", [ DInt64 id; DInt8 i ]) -> MPInt8(uint64 id, i) - | DEnum(_, _, [], "MPUInt8", [ DInt64 id; DUInt8 i ]) -> MPUInt8(uint64 id, i) - | DEnum(_, _, [], "MPInt16", [ DInt64 id; DInt16 i ]) -> MPInt16(uint64 id, i) - | DEnum(_, _, [], "MPUInt16", [ DInt64 id; DUInt16 i ]) -> MPUInt16(uint64 id, i) - | DEnum(_, _, [], "MPInt32", [ DInt64 id; DInt32 i ]) -> MPInt32(uint64 id, i) - | DEnum(_, _, [], "MPUInt32", [ DInt64 id; DUInt32 i ]) -> MPUInt32(uint64 id, i) - | DEnum(_, _, [], "MPInt64", [ DInt64 id; DInt64 i ]) -> MPInt64(uint64 id, i) - | DEnum(_, _, [], "MPUInt64", [ DInt64 id; DUInt64 i ]) -> MPUInt64(uint64 id, i) - | DEnum(_, _, [], "MPInt128", [ DInt64 id; DInt128 i ]) -> MPInt128(uint64 id, i) - | DEnum(_, _, [], "MPUInt128", [ DInt64 id; DUInt128 i ]) -> - MPUInt128(uint64 id, i) - | DEnum(_, _, [], "MPFloat", [ DInt64 id; DFloat f ]) -> MPFloat(uint64 id, f) - | DEnum(_, _, [], "MPChar", [ DInt64 id; DString c ]) -> MPChar(uint64 id, c) - | DEnum(_, _, [], "MPString", [ DInt64 id; DString s ]) -> MPString(uint64 id, s) - - | DEnum(_, _, [], "MPList", [ DInt64 id; DList(_vtTODO, inner) ]) -> - MPList(uint64 id, List.map fromDT inner) - | DEnum(_, _, [], "MPListCons", [ DInt64 id; head; tail ]) -> - MPListCons(uint64 id, fromDT head, fromDT tail) - - | DEnum(_, - _, - [], - "MPTuple", - [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> - MPTuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - - | DEnum(_, - _, - [], - "MPEnum", - [ DInt64 id; DString caseName; DList(_vtTODO, fieldPats) ]) -> - MPEnum(uint64 id, caseName, List.map fromDT fieldPats) + | DEnum(_, _, [], "MPVariable", [ DInt32 reg ]) -> MPVariable(reg) + + | DEnum(_, _, [], "MPUnit", []) -> MPUnit + | DEnum(_, _, [], "MPBool", [ DBool b ]) -> MPBool b + | DEnum(_, _, [], "MPInt8", [ DInt8 i ]) -> MPInt8 i + | DEnum(_, _, [], "MPUInt8", [ DUInt8 i ]) -> MPUInt8 i + | DEnum(_, _, [], "MPInt16", [ DInt16 i ]) -> MPInt16 i + | DEnum(_, _, [], "MPUInt16", [ DUInt16 i ]) -> MPUInt16 i + | DEnum(_, _, [], "MPInt32", [ DInt32 i ]) -> MPInt32 i + | DEnum(_, _, [], "MPUInt32", [ DUInt32 i ]) -> MPUInt32 i + | DEnum(_, _, [], "MPInt64", [ DInt64 i ]) -> MPInt64 i + | DEnum(_, _, [], "MPUInt64", [ DUInt64 i ]) -> MPUInt64 i + | DEnum(_, _, [], "MPInt128", [ DInt128 i ]) -> MPInt128 i + | DEnum(_, _, [], "MPUInt128", [ DUInt128 i ]) -> MPUInt128(i) + | DEnum(_, _, [], "MPFloat", [ DFloat f ]) -> MPFloat f + | DEnum(_, _, [], "MPChar", [ DString c ]) -> MPChar c + | DEnum(_, _, [], "MPString", [ DString s ]) -> MPString s + + | DEnum(_, _, [], "MPList", [ DList(_vtTODO, inner) ]) -> + MPList(List.map fromDT inner) + | DEnum(_, _, [], "MPListCons", [ head; tail ]) -> + MPListCons(fromDT head, fromDT tail) + + | DEnum(_, _, [], "MPTuple", [ first; second; DList(_vtTODO, theRest) ]) -> + MPTuple(fromDT first, fromDT second, List.map fromDT theRest) + + | DEnum(_, _, [], "MPEnum", [ DString caseName; DList(_vtTODO, fieldPats) ]) -> + MPEnum(caseName, List.map fromDT fieldPats) | _ -> Exception.raiseInternal "Invalid MatchPattern" [] @@ -376,344 +353,26 @@ module StringSegment = FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.stringSegment let knownType = KTCustomType(typeName, []) - let toDT (exprToDT : Expr -> Dval) (s : StringSegment) : Dval = + let toDT (regToDT : Register -> Dval) (s : StringSegment) : Dval = let (caseName, fields) = match s with - | StringText text -> "StringText", [ DString text ] - | StringInterpolation expr -> "StringInterpolation", [ exprToDT expr ] + | Text text -> "Text", [ DString text ] + | Interpolated reg -> "Interpolated", [ regToDT reg ] DEnum(typeName, typeName, [], caseName, fields) - let fromDT (exprFromDT : Dval -> Expr) (d : Dval) : StringSegment = + let fromDT (regFromDT : Dval -> Register) (d : Dval) : StringSegment = match d with - | DEnum(_, _, [], "StringText", [ DString text ]) -> StringText text - | DEnum(_, _, [], "StringInterpolation", [ expr ]) -> - StringInterpolation(exprFromDT expr) + | DEnum(_, _, [], "Text", [ DString text ]) -> Text text + | DEnum(_, _, [], "Interpolation", [ reg ]) -> Interpolated(regFromDT reg) | _ -> Exception.raiseInternal "Invalid StringSegment" [] -// module Expr = -// let typeName = FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.expr -// let knownType = KTCustomType(typeName, []) - -// let rec toDT (e : Expr) : Dval = -// let (caseName, fields) = -// match e with -// | EUnit id -> "EUnit", [ DInt64(int64 id) ] - -// | EBool(id, b) -> "EBool", [ DInt64(int64 id); DBool b ] -// | EInt64(id, i) -> "EInt64", [ DInt64(int64 id); DInt64 i ] -// | EUInt64(id, i) -> "EUInt64", [ DInt64(int64 id); DUInt64 i ] -// | EInt8(id, i) -> "EInt8", [ DInt64(int64 id); DInt8 i ] -// | EUInt8(id, i) -> "EUInt8", [ DInt64(int64 id); DUInt8 i ] -// | EInt16(id, i) -> "EInt16", [ DInt64(int64 id); DInt16 i ] -// | EUInt16(id, i) -> "EUInt16", [ DInt64(int64 id); DUInt16 i ] -// | EInt32(id, i) -> "EInt32", [ DInt64(int64 id); DInt32 i ] -// | EUInt32(id, i) -> "EUInt32", [ DInt64(int64 id); DUInt32 i ] -// | EInt128(id, i) -> "EInt128", [ DInt64(int64 id); DInt128 i ] -// | EUInt128(id, i) -> "EUInt128", [ DInt64(int64 id); DUInt128 i ] -// | EFloat(id, f) -> "EFloat", [ DInt64(int64 id); DFloat f ] -// | EChar(id, c) -> "EChar", [ DInt64(int64 id); DString c ] -// | EString(id, segments) -> -// let segments = -// DList( -// VT.known StringSegment.knownType, -// List.map (StringSegment.toDT toDT) segments -// ) -// "EString", [ DInt64(int64 id); segments ] - -// | EList(id, exprs) -> -// "EList", [ DInt64(int64 id); Dval.list knownType (List.map toDT exprs) ] - -// | EDict(id, entries) -> -// let entries = -// entries -// |> List.map (fun (k, v) -> DTuple(DString k, toDT v, [])) -// |> fun entries -> -// DList(VT.tuple VT.string (ValueType.known knownType) [], entries) -// "EDict", [ DInt64(int64 id); entries ] - -// | ETuple(id, first, second, theRest) -> -// "ETuple", -// [ DInt64(int64 id) -// toDT first -// toDT second -// Dval.list knownType (List.map toDT theRest) ] - -// | ERecord(id, typeName, fields) -> -// let fields = -// fields -// |> NEList.toList -// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) -// |> fun fields -> -// DList(VT.tuple VT.string (ValueType.known knownType) [], fields) -// "ERecord", [ DInt64(int64 id); FQTypeName.toDT typeName; fields ] - -// | EEnum(id, typeName, caseName, fields) -> -// "EEnum", -// [ DInt64(int64 id) -// FQTypeName.toDT typeName -// DString caseName -// Dval.list knownType (List.map toDT fields) ] - -// // declaring and accessing variables -// | ELet(id, lp, expr, body) -> -// "ELet", [ DInt64(int64 id); LetPattern.toDT lp; toDT expr; toDT body ] - -// | ERecordFieldAccess(id, expr, fieldName) -> -// "ERecordFieldAccess", [ DInt64(int64 id); toDT expr; DString fieldName ] - -// | EVariable(id, varName) -> "EVariable", [ DInt64(int64 id); DString varName ] - - -// // control flow -// | EIf(id, cond, thenExpr, elseExpr) -> -// "EIf", -// [ DInt64(int64 id) -// toDT cond -// toDT thenExpr -// elseExpr |> Option.map toDT |> Dval.option knownType ] - -// | EMatch(id, arg, cases) -> -// let matchCaseTypeName = -// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.matchCase - -// let cases = -// cases -// |> NEList.toList -// |> List.map (fun case -> -// let pattern = MatchPattern.toDT case.pat -// let whenCondition = -// case.whenCondition |> Option.map toDT |> Dval.option knownType -// let expr = toDT case.rhs -// DRecord( -// matchCaseTypeName, -// matchCaseTypeName, -// [], -// Map -// [ ("pat", pattern) -// ("whenCondition", whenCondition) -// ("rhs", expr) ] -// )) -// |> Dval.list (KTCustomType(matchCaseTypeName, [])) -// "EMatch", [ DInt64(int64 id); toDT arg; cases ] - - -// | ELambda(id, pats, body) -> -// let variables = -// (NEList.toList pats) -// |> List.map LetPattern.toDT -// |> Dval.list (KTTuple(VT.int64, VT.string, [])) -// "ELambda", [ DInt64(int64 id); variables; toDT body ] - -// | EConstant(id, name) -> -// "EConstant", [ DInt64(int64 id); FQConstantName.toDT name ] - -// | EApply(id, expr, typeArgs, args) -> -// let typeArgs = -// typeArgs -// |> List.map TypeReference.toDT -// |> Dval.list TypeReference.knownType -// let args = -// Dval.list TypeReference.knownType (args |> NEList.toList |> List.map toDT) -// "EApply", [ DInt64(int64 id); toDT expr; typeArgs; args ] - -// | EFnName(id, name) -> "EFnName", [ DInt64(int64 id); FQFnName.toDT name ] - -// | ERecordUpdate(id, record, updates) -> -// let updates = -// NEList.toList updates -// |> List.map (fun (name, expr) -> DTuple(DString name, toDT expr, [])) -// |> Dval.list (KTTuple(VT.string, VT.known knownType, [])) -// "ERecordUpdate", [ DInt64(int64 id); toDT record; updates ] - -// | EAnd(id, left, right) -> "EAnd", [ DInt64(int64 id); toDT left; toDT right ] - -// | EOr(id, left, right) -> "EOr", [ DInt64(int64 id); toDT left; toDT right ] - -// // Let the error straight through -// | EError(id, rtError, exprs) -> -// "EError", -// [ DInt64(int64 id) -// RuntimeTypes.RuntimeError.toDT rtError -// Dval.list knownType (List.map toDT exprs) ] - +// module RuntimeError = +// let toDT (e : RuntimeError.Error) : Dval = +// e |> RuntimeTypes.RuntimeError.toDT |> Dval.toDT -// DEnum(typeName, typeName, [], caseName, fields) - -// let rec fromDT (d : Dval) : Expr = -// match d with -// | DEnum(_, _, [], "EUnit", [ DInt64 id ]) -> EUnit(uint64 id) - -// | DEnum(_, _, [], "EBool", [ DInt64 id; DBool b ]) -> EBool(uint64 id, b) -// | DEnum(_, _, [], "EInt64", [ DInt64 id; DInt64 i ]) -> EInt64(uint64 id, i) -// | DEnum(_, _, [], "EUInt64", [ DInt64 id; DUInt64 i ]) -> EUInt64(uint64 id, i) -// | DEnum(_, _, [], "EInt8", [ DInt64 id; DInt8 i ]) -> EInt8(uint64 id, i) -// | DEnum(_, _, [], "EUInt8", [ DInt64 id; DUInt8 i ]) -> EUInt8(uint64 id, i) -// | DEnum(_, _, [], "EInt16", [ DInt64 id; DInt16 i ]) -> EInt16(uint64 id, i) -// | DEnum(_, _, [], "EUInt16", [ DInt64 id; DUInt16 i ]) -> EUInt16(uint64 id, i) -// | DEnum(_, _, [], "EInt32", [ DInt64 id; DInt32 i ]) -> EInt32(uint64 id, i) -// | DEnum(_, _, [], "EUInt32", [ DInt64 id; DUInt32 i ]) -> EUInt32(uint64 id, i) -// | DEnum(_, _, [], "EInt128", [ DInt64 id; DInt128 i ]) -> EInt128(uint64 id, i) -// | DEnum(_, _, [], "EUInt128", [ DInt64 id; DUInt128 i ]) -> -// EUInt128(uint64 id, i) -// | DEnum(_, _, [], "EFloat", [ DInt64 id; DFloat f ]) -> EFloat(uint64 id, f) -// | DEnum(_, _, [], "EChar", [ DInt64 id; DString c ]) -> EChar(uint64 id, c) -// | DEnum(_, _, [], "EString", [ DInt64 id; DList(_vtTODO, segments) ]) -> -// EString(uint64 id, List.map (StringSegment.fromDT fromDT) segments) - - -// | DEnum(_, _, [], "EList", [ DInt64 id; DList(_vtTODO, inner) ]) -> -// EList(uint64 id, List.map fromDT inner) - -// | DEnum(_, _, [], "EDict", [ DInt64 id; DList(_vtTODO, pairsList) ]) -> -// let pairs = -// pairsList -// // TODO: this should be a List.map, and raise an exception -// |> List.collect (fun pair -> -// match pair with -// | DTuple(DString k, v, _) -> [ (k, fromDT v) ] -// | _ -> []) // TODO: raise exception -// EDict(uint64 id, pairs) - - -// | DEnum(_, _, [], "ETuple", [ DInt64 id; first; second; DList(_vtTODO, theRest) ]) -> -// ETuple(uint64 id, fromDT first, fromDT second, List.map fromDT theRest) - -// | DEnum(_, _, [], "ERecord", [ DInt64 id; typeName; DList(_vtTODO1, fieldsList) ]) -> -// let fields = -// fieldsList -// |> List.collect (fun field -> -// match field with -// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] -// | _ -> []) -// ERecord( -// uint64 id, -// FQTypeName.fromDT typeName, -// NEList.ofListUnsafe -// "RT2DT.Expr.fromDT expected at least one field in ERecord" -// [] -// fields -// ) - -// | DEnum(_, -// _, -// [], -// "EEnum", -// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> -// EEnum(uint64 id, FQTypeName.fromDT typeName, caseName, List.map fromDT fields) - -// | DEnum(_, _, [], "ELet", [ DInt64 id; lp; expr; body ]) -> -// ELet(uint64 id, LetPattern.fromDT lp, fromDT expr, fromDT body) - -// | DEnum(_, _, [], "ERecordFieldAccess", [ DInt64 id; expr; DString fieldName ]) -> -// ERecordFieldAccess(uint64 id, fromDT expr, fieldName) - -// | DEnum(_, _, [], "EVariable", [ DInt64 id; DString varName ]) -> -// EVariable(uint64 id, varName) - -// | DEnum(_, _, [], "EIf", [ DInt64 id; cond; thenExpr; elseExpr ]) -> -// let elseExpr = -// match elseExpr with -// | DEnum(_, _, _typeArgsDEnumTODO, "Some", [ dv ]) -> Some(fromDT dv) -// | DEnum(_, _, _typeArgsDEnumTODO, "None", []) -> None -// | _ -> -// Exception.raiseInternal "Invalid else expression" [ "elseExpr", elseExpr ] -// EIf(uint64 id, fromDT cond, fromDT thenExpr, elseExpr) - -// | DEnum(_, _, [], "EMatch", [ DInt64 id; arg; DList(_vtTODO, cases) ]) -> -// let cases = -// cases -// |> List.collect (fun case -> -// match case with -// | DRecord(_, _, _, fields) -> -// let whenCondition = -// match Map.tryFind "whenCondition" fields with -// | Some(DEnum(_, _, _, "Some", [ value ])) -> Some(fromDT value) -// | Some(DEnum(_, _, _, "None", [])) -> None -// | _ -> None -// match Map.tryFind "pat" fields, Map.tryFind "rhs" fields with -// | Some pat, Some rhs -> -// [ { pat = MatchPattern.fromDT pat -// whenCondition = whenCondition -// rhs = fromDT rhs } ] -// | _ -> [] -// | _ -> []) -// EMatch( -// uint64 id, -// fromDT arg, -// NEList.ofListUnsafe -// "RT2DT.Expr.fromDT expected at least one case in EMatch" -// [] -// cases -// ) - -// | DEnum(_, _, [], "ELambda", [ DInt64 id; DList(_vtTODO, pats); body ]) -> -// let pats = -// pats -// |> List.map LetPattern.fromDT -// |> NEList.ofListUnsafe -// "RT2DT.Expr.fromDT expected at least one bound variable in ELambda" -// [] -// ELambda(uint64 id, pats, fromDT body) - - -// | DEnum(_, -// _, -// [], -// "EApply", -// [ DInt64 id; name; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> -// let args = -// NEList.ofListUnsafe -// "RT2DT.Expr.fromDT expected at least one argument in EApply" -// [] -// args - -// EApply( -// uint64 id, -// fromDT name, -// List.map TypeReference.fromDT typeArgs, -// NEList.map fromDT args -// ) - -// | DEnum(_, _, [], "EFnName", [ DInt64 id; name ]) -> -// EFnName(uint64 id, FQFnName.fromDT name) - -// | DEnum(_, _, [], "ERecordUpdate", [ DInt64 id; record; DList(_vtTODO, updates) ]) -> -// let updates = -// updates -// |> List.collect (fun update -> -// match update with -// | DTuple(DString name, expr, _) -> [ (name, fromDT expr) ] -// | _ -> []) -// ERecordUpdate( -// uint64 id, -// fromDT record, -// NEList.ofListUnsafe -// "RT2DT.Expr.fromDT expected at least one field update in ERecordUpdate" -// [] -// updates -// ) - -// // now for EAnd, EOr and EError -// | DEnum(_, _, [], "EAnd", [ DInt64 id; left; right ]) -> -// EAnd(uint64 id, fromDT left, fromDT right) - -// | DEnum(_, _, [], "EOr", [ DInt64 id; left; right ]) -> -// EOr(uint64 id, fromDT left, fromDT right) - -// | DEnum(_, _, [], "EError", [ DInt64 id; rtError; DList(_vtTODO, exprs) ]) -> -// EError(uint64 id, RuntimeError.fromDT rtError, List.map fromDT exprs) - - -// | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ] - - -module RuntimeError = - let toDT (e : RuntimeError) : Dval = - e |> RuntimeTypes.RuntimeError.toDT |> Dval.toDT - - let fromDT (d : Dval) : RuntimeError = - d |> Dval.fromDT |> RuntimeTypes.RuntimeError.fromDT +// let fromDT (d : Dval) : RuntimeError.Error = +// d |> Dval.fromDT |> RuntimeTypes.RuntimeError.fromDT module KnownType = @@ -762,7 +421,7 @@ module KnownType = |> Dval.list ValueType.knownType "KTFn", [ args; ValueType.toDT ret ] - | KTDB d -> "KTDB", [ ValueType.toDT d ] + // | KTDB d -> "KTDB", [ ValueType.toDT d ] DEnum(typeName, typeName, [], caseName, fields) @@ -805,7 +464,7 @@ module KnownType = (List.map ValueType.fromDT otherArgs), ValueType.fromDT ret ) - | DEnum(_, _, [], "KTDB", [ inner ]) -> KTDB(ValueType.fromDT inner) + // | DEnum(_, _, [], "KTDB", [ inner ]) -> KTDB(ValueType.fromDT inner) | _ -> Exception.raiseInternal "Invalid KnownType" [] @@ -831,64 +490,70 @@ module ValueType = | _ -> Exception.raiseInternal "Invalid ValueType" [] -module LambdaImpl = - let typeName = - FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.lambdaImpl - - let toDT (l : LambdaImpl) : Dval = - let parameters = - l.parameters - |> NEList.toList - |> List.map LetPattern.toDT - |> fun p -> DList(VT.tuple VT.int64 VT.string [], p) - let fields = - [ ("typeSymbolTable", - DDict( - VT.known TypeReference.knownType, - Map.map TypeReference.toDT l.typeSymbolTable - )) - ("symtable", DDict(VT.known Dval.knownType, Map.map Dval.toDT l.symtable)) - ("parameters", parameters) - ("body", Expr.toDT l.body) ] - - DRecord(typeName, typeName, [], Map fields) +// module LambdaImpl = +// let typeName = +// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.lambdaImpl + +// let toDT (l : LambdaImpl) : Dval = +// let parameters = +// l.parameters +// |> NEList.toList +// |> List.map LetPattern.toDT +// |> fun p -> DList(VT.tuple VT.int64 VT.string [], p) +// let fields = +// [ ("typeSymbolTable", +// DDict( +// VT.known TypeReference.knownType, +// Map.map TypeReference.toDT l.typeSymbolTable +// )) +// ("symtable", DDict(VT.known Dval.knownType, Map.map Dval.toDT l.symtable)) +// ("parameters", parameters) +// ("body", Expr.toDT l.body) ] + +// DRecord(typeName, typeName, [], Map fields) + +// let fromDT (d : Dval) : LambdaImpl = +// match d with +// | DRecord(_, _, _, fields) -> +// { typeSymbolTable = +// fields |> D.mapField "typeSymbolTable" |> Map.map TypeReference.fromDT - let fromDT (d : Dval) : LambdaImpl = - match d with - | DRecord(_, _, _, fields) -> - { typeSymbolTable = - fields |> D.mapField "typeSymbolTable" |> Map.map TypeReference.fromDT +// symtable = fields |> D.mapField "symtable" |> Map.map Dval.fromDT - symtable = fields |> D.mapField "symtable" |> Map.map Dval.fromDT +// parameters = +// fields +// |> D.listField "parameters" +// |> List.map LetPattern.fromDT +// |> NEList.ofListUnsafe +// "RT2DT.Dval.fromDT expected at least one parameter in LambdaImpl" +// [] - parameters = - fields - |> D.listField "parameters" - |> List.map LetPattern.fromDT - |> NEList.ofListUnsafe - "RT2DT.Dval.fromDT expected at least one parameter in LambdaImpl" - [] +// body = fields |> D.field "body" |> Expr.fromDT } - body = fields |> D.field "body" |> Expr.fromDT } +// | _ -> Exception.raiseInternal "Invalid LambdaImpl" [] - | _ -> Exception.raiseInternal "Invalid LambdaImpl" [] +// module FnValImpl = +// let typeName = +// FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.fnValImpl -module FnValImpl = - let typeName = - FQTypeName.Package PackageIDs.Type.LanguageTools.RuntimeTypes.fnValImpl +// let toDT (fnValImpl : FnValImpl) : Dval = +// let (caseName, fields) = +// match fnValImpl with +// //| Lambda lambda -> "Lambda", [ LambdaImpl.toDT lambda ] +// | NamedFn fnName -> "NamedFn", [ FQFnName.toDT fnName ] +// DEnum(typeName, typeName, [], caseName, fields) - let toDT (fnValImpl : FnValImpl) : Dval = - let (caseName, fields) = - match fnValImpl with - //| Lambda lambda -> "Lambda", [ LambdaImpl.toDT lambda ] - | NamedFn fnName -> "NamedFn", [ FQFnName.toDT fnName ] - DEnum(typeName, typeName, [], caseName, fields) +// let fromDT (d : Dval) : FnValImpl = +// match d with +// //| DEnum(_, _, [], "Lambda", [ lambda ]) -> Lambda(LambdaImpl.fromDT lambda) +// | DEnum(_, _, [], "NamedFn", [ fnName ]) -> NamedFn(FQFnName.fromDT fnName) +// | _ -> Exception.raiseInternal "Invalid FnValImpl" [] - let fromDT (d : Dval) : FnValImpl = - match d with - //| DEnum(_, _, [], "Lambda", [ lambda ]) -> Lambda(LambdaImpl.fromDT lambda) - | DEnum(_, _, [], "NamedFn", [ fnName ]) -> NamedFn(FQFnName.fromDT fnName) - | _ -> Exception.raiseInternal "Invalid FnValImpl" [] +module Applicable = + let toDT (applicable : Applicable) : Dval = + match applicable with + | AppLambda _lambda -> DUnit // TODO + | AppNamedFn fnName -> FQFnName.toDT fnName.name @@ -925,9 +590,9 @@ module Dval = "DTuple", [ toDT first; toDT second; DList(VT.known knownType, List.map toDT theRest) ] - | DFnVal fnImpl -> "DFnVal", [ FnValImpl.toDT fnImpl ] + // | DDB name -> "DDB", [ DString name ] - | DDB name -> "DDB", [ DString name ] + | DApplicable applicable -> "DApplicable", [ Applicable.toDT applicable ] | DDict(vt, entries) -> "DDict", @@ -974,9 +639,9 @@ module Dval = | DEnum(_, _, [], "DTuple", [ first; second; DList(_vtTODO, theRest) ]) -> DTuple(fromDT first, fromDT second, List.map fromDT theRest) - | DEnum(_, _, [], "DFnVal", [ fnImpl ]) -> DFnVal(FnValImpl.fromDT fnImpl) + // | DEnum(_, _, [], "DDB", [ DString name ]) -> DDB name - | DEnum(_, _, [], "DDB", [ DString name ]) -> DDB name + // | DEnum(_, _, [], "DApplicable", [ applicable ]) -> DApplicable(Applicable.fromDT applicable) | DEnum(_, _, [], "DDateTime", [ DDateTime d ]) -> DDateTime d | DEnum(_, _, [], "DUuid", [ DUuid u ]) -> DUuid u @@ -1013,3 +678,26 @@ module Dval = ) | _ -> Exception.raiseInternal "Invalid Dval" [] + + + +// module RuntimeError = +// module RT2DT = LibExecution.RuntimeTypesToDarkTypes + +// type Error = +// /// In the future, we will add a trait to indicate types which can be serialized. For +// /// now, we'll raise a RuntimeError instead if any of those types are present. +// /// Helpfully, this allows us keep `serialize` from having to return an Error. +// | UnsupportedType of TypeReference + +// let toRuntimeError (e : Error) : RuntimeError = +// let (caseName, fields) = +// match e with +// | UnsupportedType typ -> "UnsupportedType", [ RT2DT.TypeReference.toDT typ ] + +// let typeName = +// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.RuntimeError.Json.error +// DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.jsonError + +// let raiseUnsupportedType (callStack : CallStack) (typ : TypeReference) : 'a = +// UnsupportedType(typ) |> toRuntimeError |> raiseRTE callStack diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index ce16208497..34c7e57838 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -437,7 +437,6 @@ module DvalCreator = List.fold (fun (typ, entries) (k, v) -> if Map.containsKey k entries then - // should we warn here instead? CLEANUP RTE.Dicts.Error.TriedToAddKeyAfterAlreadyPresent k |> RTE.Error.Dict |> raiseRTE threadID @@ -487,47 +486,42 @@ module DvalCreator = | None -> optionNone expectedType - // module Result = - // let typeName = Dval.resultType - - // let ok - // (threadID: ThreadID) - // (okType : ValueType) - // (errorType : ValueType) - // (dvOk : Dval) - // : Dval = - // let dvalType = Dval.toValueType dvOk - // match VT.merge okType dvalType with - // | Ok typ -> - // DEnum(typeName, typeName, [ typ; errorType ], "Ok", [ dvOk ]) - // | Error() -> - // // RuntimeError.oldError - // // $"Could not merge types {ValueType.toString (VT.customType typeName [ okType; errorType ])} and {ValueType.toString (VT.customType typeName [ dvalType; errorType ])}" - // |> raiseRTE callStack - - // let error - // (threadID: ThreadID) - // (okType : ValueType) - // (errorType : ValueType) - // (dvError : Dval) - // : Dval = - // let dvalType = Dval.toValueType dvError - // match VT.merge errorType dvalType with - // | Ok typ -> DEnum(typeName, typeName, [ okType; typ ], "Error", [ dvError ]) - // | Error() -> - // RuntimeError.oldError - // $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" - // |> raiseRTE callStack - - // let result - // (threadID: ThreadID) - // (okType : ValueType) - // (errorType : ValueType) - // (dv : Result) - // : Dval = - // match dv with - // | Ok dv -> ok callStack okType errorType dv - // | Error dv -> error callStack okType errorType dv + module Result = + let typeName = Dval.resultType + + let ok + (threadID : ThreadID) + (okType : ValueType) + (errorType : ValueType) + (dvOk : Dval) + : Dval = + let dvalType = Dval.toValueType dvOk + match VT.merge okType dvalType with + | Ok typ -> DEnum(typeName, typeName, [ typ; errorType ], "Ok", [ dvOk ]) + | Error() -> + RuntimeError.CannotMergeValues(okType, dvalType) |> raiseRTE threadID + + let error + (threadID : ThreadID) + (okType : ValueType) + (errorType : ValueType) + (dvError : Dval) + : Dval = + let dvalType = Dval.toValueType dvError + match VT.merge errorType dvalType with + | Ok typ -> DEnum(typeName, typeName, [ okType; typ ], "Error", [ dvError ]) + | Error() -> + RuntimeError.CannotMergeValues(errorType, dvalType) |> raiseRTE threadID + + let result + (threadID : ThreadID) + (okType : ValueType) + (errorType : ValueType) + (dv : Result) + : Dval = + match dv with + | Ok dv -> ok threadID okType errorType dv + | Error dv -> error threadID okType errorType dv /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape @@ -578,16 +572,17 @@ module DvalCreator = DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply -// let enum -// (resolvedTypeName : FQTypeName.FQTypeName) // todo: remove -// (sourceTypeName : FQTypeName.FQTypeName) -// (caseName : string) -// (fields : List) -// : Ply = -// // TODO: -// // - use passed-in Types to determine type args of resultant Dval -// // - ensure fields match the expected shape (defined by type args and field defs) -// // - this process should also effect the type args of the resultant Dval + let enum + (_threadID : ThreadID) + (_types : Types) + (typeName : FQTypeName.FQTypeName) + (_typeArgs : List) + (caseName : string) + (fields : List) + : Ply = + // TODO: + // - use passed-in Types to determine type args of resultant Dval + // - ensure fields match the expected shape (defined by type args and field defs) + // - this process should also effect the type args of the resultant Dval -// DEnum(resolvedTypeName, sourceTypeName, VT.typeArgsTODO, caseName, fields) -// |> Ply + DEnum(typeName, typeName, VT.typeArgsTODO, caseName, fields) |> Ply diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 86fc706270..ec9a57e087 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -117,11 +117,11 @@ let nameToTestDomain (name : string) : string = let builtins (httpConfig : BuiltinExecution.Libs.HttpClient.Configuration) - (_pm : PT.PackageManager) + (pm : PT.PackageManager) : RT.Builtins = LibExecution.Builtin.combine [ LibTest.builtins - BuiltinExecution.Builtin.builtins httpConfig // pm + BuiltinExecution.Builtin.builtins httpConfig pm // BuiltinCloudExecution.Builtin.builtins // BuiltinDarkInternal.Builtin.builtins // BuiltinCli.Builtin.builtins diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index bb6b87b907..6baaa468bd 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -143,7 +143,7 @@ module Expressions = (eBool true) [ eTuple (eBool true) (eBool false) [] ] - + // TODO: test MPEnum module Match = /// match true with /// | false -> "first branch" From 292c2e4d5d4bdf426058c926a50d394790efa43d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 17 Sep 2024 12:19:23 -0400 Subject: [PATCH 33/60] constants work --- backend/src/BuiltinExecution/Libs/Json.fs | 7 +- backend/src/BuiltinExecution/Libs/List.fs | 6 +- backend/src/LibExecution/Interpreter.fs | 66 +++++++++++++++++-- backend/src/LibExecution/ProgramTypes.fs | 12 ++-- backend/src/LibExecution/ProgramTypesAst.fs | 2 + .../LibExecution/ProgramTypesToDarkTypes.fs | 8 +-- .../ProgramTypesToRuntimeTypes.fs | 46 ++++++++----- backend/src/LibExecution/RuntimeTypes.fs | 7 +- backend/tests/TestUtils/PTShortcuts.fs | 25 ++----- backend/tests/Tests/Interpreter.Tests.fs | 12 ++++ backend/tests/Tests/PT2RT.Tests.fs | 17 +++++ backend/tests/Tests/TestValues.fs | 19 +++++- 12 files changed, 172 insertions(+), 55 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index 363f3b5f52..576744ac8b 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -230,7 +230,8 @@ let rec serialize RTE.MatchUnmatched |> raiseRTE threadId - | TCustomType(Error err, _typeArgs), _dval -> raiseRTE threadId (RTE.NameResolution err) + | TCustomType(Error err, _typeArgs), _dval -> + raiseRTE threadId (RTE.NameResolution err) // Not supported @@ -264,7 +265,9 @@ let rec serialize | TCustomType _, _ | TDict _, _ -> // Internal error as this shouldn't get past the typechecker - RTE.Jsons.CannotSerializeTypeValueCombo(dv,typ) |> RTE.Json |> raiseRTE threadId + RTE.Jsons.CannotSerializeTypeValueCombo(dv, typ) + |> RTE.Json + |> raiseRTE threadId } module ParseError = diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index 6297239c14..9f819b8445 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -103,7 +103,11 @@ module DvalComparator = | DApplicable _, _ -> //| DDB _, _ // TODO: Feels like this should hook into typechecker and ValueTypes somehow - RuntimeError.Error.EqualityCheckOnIncompatibleTypes (Dval.toValueType dv1, Dval.toValueType dv2) |> raiseUntargetedRTE + RuntimeError.Error.EqualityCheckOnIncompatibleTypes( + Dval.toValueType dv1, + Dval.toValueType dv2 + ) + |> raiseUntargetedRTE // // and compareLetPatternsLists (l1 : List) (l2 : List) : int = diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 75aba57f4b..67b54ff441 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -128,6 +128,44 @@ let rec checkAndExtractMatchPattern | MPEnum _, _ -> false, [] + +let rec evalConst (threadID : ThreadID) (c : Const) : Dval = + let r = evalConst threadID + + match c with + | CUnit -> DUnit + | CBool b -> DBool b + + | CInt8 i -> DInt8 i + | CUInt8 i -> DUInt8 i + | CInt16 i -> DInt16 i + | CUInt16 i -> DUInt16 i + | CInt32 i -> DInt32 i + | CUInt32 i -> DUInt32 i + | CInt64 i -> DInt64 i + | CUInt64 i -> DUInt64 i + | CInt128 i -> DInt128 i + | CUInt128 i -> DUInt128 i + + | CFloat(sign, w, f) -> DFloat(makeFloat sign w f) + + | CChar c -> DChar c + | CString s -> DString s + + | CList items -> DList(ValueType.Unknown, (List.map r items)) + | CTuple(first, second, rest) -> DTuple(r first, r second, List.map r rest) + | CDict items -> + DDict(ValueType.Unknown, (List.map (Tuple2.mapSecond r) items) |> Map.ofList) + + | CEnum(Ok typeName, caseName, fields) -> + // TYPESTODO: this uses the original type name, so if it's an alias, it won't be equal to the + DEnum(typeName, typeName, VT.typeArgsTODO, caseName, List.map r fields) + + | CEnum(Error nre, _caseName, _fields) -> + // TODO: ConstNotFound or something + raiseRTE threadID (RuntimeError.NameResolution nre) + + let execute (exeState : ExecutionState) (vm : VMState) : Ply = uply { let raiseRTE rte = raiseRTE vm.threadID rte @@ -185,17 +223,17 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = match registers[left], registers[right] with | DBool l, DBool r -> registers[createTo] <- DBool(l || r) | l, r -> - let lvt = Dval.toValueType l - let rvt = Dval.toValueType r - raiseRTE (RTE.Bool(RTE.Bools.OrOnlySupportsBooleans(lvt, rvt))) + RTE.Bools.OrOnlySupportsBooleans(Dval.toValueType l, Dval.toValueType r) + |> RTE.Bool + |> raiseRTE | And(createTo, left, right) -> match registers[left], registers[right] with | DBool l, DBool r -> registers[createTo] <- DBool(l && r) | l, r -> - let lvt = Dval.toValueType l - let rvt = Dval.toValueType r - raiseRTE (RTE.Bool(RTE.Bools.AndOnlySupportsBooleans(lvt, rvt))) + RTE.Bools.AndOnlySupportsBooleans(Dval.toValueType l, Dval.toValueType r) + |> RTE.Bool + |> raiseRTE // == Working with Variables == @@ -297,6 +335,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | CloneRecordWithUpdates(targetReg, originalRecordReg, updates) -> let originalRecord = registers[originalRecordReg] + match originalRecord with | DRecord(_, typeName, typeArgs, originalFields) -> // TODO: type-saftety @@ -344,6 +383,20 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = fields registers[enumReg] <- enum + + | LoadConstant(createTo, name) -> + match name with + | FQConstantName.Builtin builtin -> + match Map.find builtin exeState.constants.builtIn with + | Some c -> registers[createTo] <- c.body + | None -> raiseRTE (RTE.ConstNotFound(FQConstantName.Builtin builtin)) + + | FQConstantName.Package pkg -> + match! exeState.constants.package pkg with + | Some c -> registers[createTo] <- evalConst vm.threadID c.body + | None -> raiseRTE (RTE.ConstNotFound(FQConstantName.Package pkg)) + + | CreateLambda(lambdaReg, impl) -> vm.lambdas <- Map.add (currentFrame.context, impl.exprId) impl vm.lambdas registers[lambdaReg] <- @@ -357,6 +410,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = |> DApplicable + // == Working with things that Apply (fns, lambdas) == // `add (increment 1L) (3L)` and store results in `putResultIn` | Apply(putResultIn, thingToCallReg, typeArgs, newArgRegs) -> diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 27c4ded3f2..d20fef7242 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -65,6 +65,8 @@ module FQConstantName = let package (id : uuid) : Package = id + let fqPackage (id : uuid) : FQConstantName = Package id + @@ -379,10 +381,10 @@ type Expr = caseName : string * fields : List -// | EConstant of -// id * -// // TODO: this reference should be by-hash -// NameResolution + | EConstant of + id * + // TODO: this reference should be by-hash + NameResolution and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } @@ -425,7 +427,7 @@ module Expr = | EChar(id, _) | EString(id, _) | EFloat(id, _, _, _) - // | EConstant(id, _) + | EConstant(id, _) | ELet(id, _, _, _) | EIf(id, _, _, _) | EInfix(id, _, _, _) diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 1433e600a2..5d9a09ca93 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -83,6 +83,8 @@ let rec symbolsUsedIn (expr : Expr) : Set = (r expr) (updates |> NEList.toList |> List.map (fun (_, e) -> r e) |> Set.unionMany) + | EConstant(_, _) -> Set.empty + // things that can be applied | EInfix(_, _, left, right) -> Set.union (r left) (r right) | EFnName(_, _) -> Set.empty diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index 81dc8b7da6..1b042c80ce 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -773,10 +773,10 @@ module Expr = ) "ELambda", [ DInt64(int64 id); variables; toDT body ] - // | PT.EConstant(id, name) -> - // "EConstant", - // [ DInt64(int64 id) - // NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] + | PT.EConstant(id, name) -> + "EConstant", + [ DInt64(int64 id) + NameResolution.toDT FQConstantName.knownType FQConstantName.toDT name ] | PT.EApply(id, name, typeArgs, args) -> "EApply", diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 521b0f62aa..e5ab50dfef 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -23,25 +23,25 @@ module FQTypeName = // | RT.FQTypeName.Package p -> PT.FQTypeName.Package(Package.fromRT p) |> Some -// module FQConstantName = -// module Builtin = -// let toRT (c : PT.FQConstantName.Builtin) : RT.FQConstantName.Builtin = -// { name = c.name; version = c.version } +module FQConstantName = + module Builtin = + let toRT (c : PT.FQConstantName.Builtin) : RT.FQConstantName.Builtin = + { name = c.name; version = c.version } -// let fromRT (c : RT.FQConstantName.Builtin) : PT.FQConstantName.Builtin = -// { name = c.name; version = c.version } + // let fromRT (c : RT.FQConstantName.Builtin) : PT.FQConstantName.Builtin = + // { name = c.name; version = c.version } -// module Package = -// let toRT (c : PT.FQConstantName.Package) : RT.FQConstantName.Package = c + module Package = + let toRT (c : PT.FQConstantName.Package) : RT.FQConstantName.Package = c -// let fromRT (c : RT.FQConstantName.Package) : PT.FQConstantName.Package = c + // let fromRT (c : RT.FQConstantName.Package) : PT.FQConstantName.Package = c -// let toRT -// (name : PT.FQConstantName.FQConstantName) -// : RT.FQConstantName.FQConstantName = -// match name with -// | PT.FQConstantName.Builtin s -> RT.FQConstantName.Builtin(Builtin.toRT s) -// | PT.FQConstantName.Package p -> RT.FQConstantName.Package(Package.toRT p) + let toRT + (name : PT.FQConstantName.FQConstantName) + : RT.FQConstantName.FQConstantName = + match name with + | PT.FQConstantName.Builtin s -> RT.FQConstantName.Builtin(Builtin.toRT s) + | PT.FQConstantName.Package p -> RT.FQConstantName.Package(Package.toRT p) module FQFnName = @@ -125,6 +125,7 @@ module TypeReference = module InfixFnName = let toFnName (name : PT.InfixFnName) : RT.FQFnName.Builtin = let make = RT.FQFnName.builtin + match name with | PT.ArithmeticPlus -> make "int64Add" 0 | PT.ArithmeticMinus -> make "int64Subtract" 0 @@ -534,6 +535,7 @@ module Expr = | PT.EInfix(_, PT.InfixFnCall infix, left, right) -> let left = toRT symbols rc left let right = toRT symbols left.registerCount right + let infixInstr, infixRc, rcAfterInfix = RT.LoadVal( right.registerCount, @@ -562,7 +564,20 @@ module Expr = + // constants + | PT.EConstant(_, Ok name) -> + { registerCount = rc + 1 + instructions = [ RT.LoadConstant(rc, FQConstantName.toRT name) ] + resultIn = rc } + + | PT.EConstant(_, Error nre) -> + // TODO improve (see notes for EFnName) + { registerCount = rc + instructions = [ RT.RaiseNRE(NameResolutionError.toRT nre) ] + resultIn = rc } + + // functions | PT.EFnName(_, Ok name) -> let namedFn : RT.ApplicableNamedFn = { name = FQFnName.toRT name; argsSoFar = [] } @@ -745,6 +760,7 @@ module Expr = ) ] resultIn = recordReg } + | PT.ERecordUpdate(_id, expr, updates) -> let expr = toRT symbols rc expr diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 6c3b81a58b..af32e8ed68 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -409,6 +409,8 @@ type Instruction = fields : List + | LoadConstant of createTo : Register * FQConstantName.FQConstantName + // == Working with things that Apply == | CreateLambda of createTo : Register * lambda : LambdaImpl @@ -882,9 +884,12 @@ module RuntimeError = /// $"Function {FQFnName.toString fnName} is not found" | FnNotFound of fnName : FQFnName.FQFnName + /// $"Invalid const name: {msg}" + | ConstNotFound of constName : FQConstantName.FQConstantName + // backend/src/LibExecution/Interpreter.Old.fs: // - "TODO" - // - $"Invalid const name: {msg}" + // - $"Expected {expectedLength} arguments, got {actualLength}" // - $"Function {FQFnName.toString fnToCall} is not found") // - "Unknown error" diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index c238d5bbb2..28925f9701 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -80,36 +80,21 @@ let eRecordUpdate (expr : Expr) (updates : List) : Expr = let eInfix (op : Infix) (left : Expr) (right : Expr) : Expr = EInfix(gid (), op, left, right) +let eBuiltinConstant (name : string) (version : int) : Expr = + EConstant(gid (), Ok(FQConstantName.fqBuiltIn name version)) + +let ePackageConstant (id : uuid) : Expr = + EConstant(gid (), Ok(FQConstantName.fqPackage id)) let eBuiltinFn (name : string) (version : int) : Expr = EFnName(gid (), Ok(FQFnName.fqBuiltIn name version)) let ePackageFn (id : uuid) : Expr = EFnName(gid (), Ok(FQFnName.fqPackage id)) - let eLambda id (pats : List) (body : Expr) : Expr = let pats = NEList.ofListUnsafe "eLambda" [] pats ELambda(id, pats, body) - -// let eFn' -// (function_ : string) -// (version : int) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eFn'" [] args -// EApply(gid (), (eBuiltinFnName function_ version), typeArgs, args) - -// let eFn -// (function_ : string) -// (version : int) -// (typeArgs : List) -// (args : List) -// : Expr = -// eFn' function_ version typeArgs args - - let eApply (target : Expr) (typeArgs : List) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index f6e4712682..75ba5da5bf 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -342,6 +342,17 @@ module RecordUpdate = let tests = testList "RecordUpdate" [ simple; notRecord ] // fieldThatShouldNotExist; fieldWithWrongType ] +module Constants = + module Package = + let mySpecialNumber = + t + "Test.mySpecialNumber" + E.Constants.Package.MySpecialNumber.usage + (RT.DInt64 17L) + let tests = testList "Package" [ mySpecialNumber ] + let tests = testList "Constants" [ Package.tests ] + + module Infix = module And = let mixed = t "true && false" E.Infix.And.mixed (RT.DBool false) @@ -542,6 +553,7 @@ let tests = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Constants.tests Infix.tests Lambdas.tests Fns.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 1c3e3840ae..028c103491 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -681,6 +681,22 @@ module Expr = eInfix (PT.Infix.InfixFnCall PT.ArithmeticMinus) (eInt64 1) (eInt64 2)*) + module Constants = + module Package = + let mySpecialNumber = + t + "Test.mySpecialNumber" + E.Constants.Package.MySpecialNumber.usage + (1, + [ RT.LoadConstant( + 0, + RT.FQConstantName.Package E.Constants.Package.MySpecialNumber.id + ) ], + 0) + let tests = testList "Package" [ mySpecialNumber ] + let tests = testList "Constants" [ Package.tests ] + + module Infix = module And = let mixed = @@ -1092,6 +1108,7 @@ module Expr = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Constants.tests Infix.tests Lambda.tests Fns.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 6baaa468bd..61c7a747c5 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -246,6 +246,19 @@ module Expressions = eRecordUpdate Records.simple [ "bonus", eBool false ] let fieldWithWrongType = eRecordUpdate Records.simple [ "key", eInt64 1 ] + + module Constants = + // CLEANUP we don't really have builtin constants, so not bothering to test for now + // module Builtin = + // let infinity = eBuiltinConstant "infinity" 0 + + module Package = + module MySpecialNumber = + // 17 + let id = System.Guid.Parse "1823ae7e-cc59-4843-a884-18591398abb0" + let usage = ePackageConstant id + + module Infix = module And = let mixed = eInfix (PT.Infix.BinOp PT.BinOpAnd) (eBool true) (eBool false) @@ -348,7 +361,11 @@ let pm : PT.PackageManager = PT.PackageManager.empty |> PT.PackageManager.withExtras [] - [] + [ { id = Expressions.Constants.Package.MySpecialNumber.id + name = PT.PackageConstant.name "Test" [] "seventeen" + description = "TODO" + deprecated = PT.NotDeprecated + body = PT.CInt64 17 } ] [ { id = Expressions.Fns.Package.MyAdd.id name = PT.PackageFn.name "Test" [] "add" typeParams = [] From 43573888f75b059e9bfd2ec7d28e2d303817c04a Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 17 Sep 2024 18:12:41 -0400 Subject: [PATCH 34/60] pipes work --- backend/src/LibExecution/ProgramTypes.fs | 49 ++-- backend/src/LibExecution/ProgramTypesAst.fs | 18 +- .../LibExecution/ProgramTypesToDarkTypes.fs | 214 +++++++++--------- .../ProgramTypesToRuntimeTypes.fs | 32 ++- backend/tests/TestUtils/PTShortcuts.fs | 36 ++- backend/tests/Tests/Interpreter.Tests.fs | 13 ++ backend/tests/Tests/PT2RT.Tests.fs | 38 +++- backend/tests/Tests/TestValues.fs | 51 +++++ 8 files changed, 314 insertions(+), 137 deletions(-) diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index d20fef7242..9e7a3766b5 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -290,8 +290,8 @@ type Expr = /// `if cond then thenExpr else elseExpr` | EIf of id * cond : Expr * thenExpr : Expr * elseExpr : Option - // /// `(1 + 2) |> fnName |> (+) 3` - // | EPipe of id * Expr * List + /// `(1 + 2) |> fnName |> (+) 3` + | EPipe of id * Expr * List /// Supports `match` expressions /// ```fsharp @@ -393,21 +393,34 @@ and StringSegment = | StringText of string | StringInterpolation of Expr -// and PipeExpr = -// | EPipeVariable of id * string * List // value is an fn taking one or more arguments -// | EPipeLambda of id * pats : NEList * body : Expr -// | EPipeInfix of id * Infix * Expr -// | EPipeFnCall of -// id * -// NameResolution * -// typeArgs : List * -// args : List -// | EPipeEnum of -// id * -// // TODO: this reference should be by-hash -// typeName : NameResolution * -// caseName : string * -// fields : List +and PipeExpr = + /// `1 |> fun x -> x + 1` + | EPipeLambda of id * pats : NEList * body : Expr + + /// `1 |> (+) 1` + | EPipeInfix of id * Infix * Expr + + /// `1 |> Json.serialize` + | EPipeFnCall of + id * + NameResolution * + typeArgs : List * + args : List + + /// `1 |> Option.Some` + | EPipeEnum of + id * + // TODO: this reference should be by-hash + typeName : NameResolution * + caseName : string * + fields : List + + /// ```fsharp + /// let myLambda = fun x -> x + 1 + /// 1 |> myLambda + /// ``` + | EPipeVariable of id * varContainingPipeable : string * args : List + module Expr = let toID (expr : Expr) : id = @@ -438,7 +451,7 @@ module Expr = | EList(id, _) | EDict(id, _) | ETuple(id, _, _, _) - // | EPipe(id, _, _) + | EPipe(id, _, _) | ERecord(id, _, _, _) | ERecordUpdate(id, _, _) | ERecordFieldAccess(id, _, _) diff --git a/backend/src/LibExecution/ProgramTypesAst.fs b/backend/src/LibExecution/ProgramTypesAst.fs index 5d9a09ca93..13cdfe79e2 100644 --- a/backend/src/LibExecution/ProgramTypesAst.fs +++ b/backend/src/LibExecution/ProgramTypesAst.fs @@ -5,8 +5,8 @@ open ProgramTypes /// TODO type symbols, too /// TODO I'm not sure if this is useful any more - wrote this when doing some Lambda work but idk -let rec symbolsUsedIn (expr : Expr) : Set = - let r = symbolsUsedIn +let rec symbolsUsedInExpr (expr : Expr) : Set = + let r = symbolsUsedInExpr match expr with // simple values @@ -69,6 +69,11 @@ let rec symbolsUsedIn (expr : Expr) : Set = let rhsVars = cases |> List.map _.rhs |> List.map r |> Set.unionMany Set.unionMany [ targetVars; whenVars; rhsVars ] + | EPipe(_, expr, parts) -> + Set.union + (r expr) + (parts |> List.map (fun p -> symbolsUsedInPipeExpr p) |> Set.unionMany) + // custom data | EEnum(_, _, _, _, fields) -> fields |> List.map r |> Set.unionMany @@ -92,3 +97,12 @@ let rec symbolsUsedIn (expr : Expr) : Set = | EApply(_, thingToApply, _, args) -> Set.unionMany [ r thingToApply; args |> NEList.toList |> List.map r |> Set.unionMany ] +and symbolsUsedInPipeExpr (pipeExpr : PipeExpr) : Set = + let r = symbolsUsedInExpr + + match pipeExpr with + | EPipeLambda(_, _, body) -> r body + | EPipeInfix(_, _, expr) -> r expr + | EPipeFnCall(_, _, _, args) -> args |> List.map r |> Set.unionMany + | EPipeEnum(_, _, _, fields) -> fields |> List.map r |> Set.unionMany + | EPipeVariable(_, _, args) -> args |> List.map r |> Set.unionMany diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index 1b042c80ce..7dd6ccbbf3 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -526,105 +526,105 @@ module StringSegment = | _ -> Exception.raiseInternal "Invalid StringSegment" [] -// module PipeExpr = -// let typeName = -// FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.pipeExpr -// let knownType = KTCustomType(typeName, []) - -// let toDT -// (exprKT : KnownType) -// (exprToDT : PT.Expr -> Dval) -// (s : PT.PipeExpr) -// : Dval = -// let (caseName, fields) = -// match s with -// | PT.EPipeVariable(id, varName, exprs) -> -// "EPipeVariable", -// [ DInt64(int64 id) -// DString varName -// DList(VT.known exprKT, List.map exprToDT exprs) ] - -// | PT.EPipeLambda(id, args, body) -> -// let variables = -// args -// |> NEList.toList -// |> List.map LetPattern.toDT -// |> Dval.list (KTTuple(VT.int64, VT.string, [])) -// "EPipeLambda", [ DInt64(int64 id); variables; exprToDT body ] - -// | PT.EPipeInfix(id, infix, expr) -> -// "EPipeInfix", [ DInt64(int64 id); Infix.toDT infix; exprToDT expr ] - -// | PT.EPipeFnCall(id, fnName, typeArgs, args) -> -// "EPipeFnCall", -// [ DInt64(int64 id) -// NameResolution.toDT FQFnName.knownType FQFnName.toDT fnName -// DList( -// VT.known TypeReference.knownType, -// List.map TypeReference.toDT typeArgs -// ) -// DList(VT.known exprKT, List.map exprToDT args) ] - -// | PT.EPipeEnum(id, typeName, caseName, fields) -> -// "EPipeEnum", -// [ DInt64(int64 id) -// NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName -// DString caseName -// DList(VT.known exprKT, List.map exprToDT fields) ] - -// DEnum(typeName, typeName, [], caseName, fields) - - -// let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.PipeExpr = -// match d with -// | DEnum(_, -// _, -// [], -// "EPipeVariable", -// [ DInt64 id; DString varName; DList(_vtTODO, args) ]) -> -// PT.EPipeVariable(uint64 id, varName, args |> List.map exprFromDT) - -// | DEnum(_, _, [], "EPipeLambda", [ DInt64 id; variables; body ]) -> -// let variables = -// match variables with -// | DList(_vtTODO, pats) -> -// pats -// |> List.map LetPattern.fromDT -// |> NEList.ofListUnsafe -// "PT2DT.PipeExpr.fromDT expected at least one bound variable in EPipeLambda" -// [] -// | _ -> Exception.raiseInternal "Invalid variables" [] - -// PT.EPipeLambda(uint64 id, variables, exprFromDT body) - -// | DEnum(_, _, [], "EPipeInfix", [ DInt64 id; infix; expr ]) -> -// PT.EPipeInfix(uint64 id, Infix.fromDT infix, exprFromDT expr) - -// | DEnum(_, -// _, -// [], -// "EPipeFnCall", -// [ DInt64 id; fnName; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> -// PT.EPipeFnCall( -// uint64 id, -// NameResolution.fromDT FQFnName.fromDT fnName, -// List.map TypeReference.fromDT typeArgs, -// List.map exprFromDT args -// ) - -// | DEnum(_, -// _, -// [], -// "EPipeEnum", -// [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> -// PT.EPipeEnum( -// uint64 id, -// NameResolution.fromDT FQTypeName.fromDT typeName, -// caseName, -// List.map exprFromDT fields -// ) - -// | _ -> Exception.raiseInternal "Invalid PipeExpr" [] +module PipeExpr = + let typeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.ProgramTypes.pipeExpr + let knownType = KTCustomType(typeName, []) + + let toDT + (exprKT : KnownType) + (exprToDT : PT.Expr -> Dval) + (s : PT.PipeExpr) + : Dval = + let (caseName, fields) = + match s with + | PT.EPipeVariable(id, varName, exprs) -> + "EPipeVariable", + [ DInt64(int64 id) + DString varName + DList(VT.known exprKT, List.map exprToDT exprs) ] + + | PT.EPipeLambda(id, args, body) -> + let variables = + args + |> NEList.toList + |> List.map LetPattern.toDT + |> Dval.list (KTTuple(VT.int64, VT.string, [])) + "EPipeLambda", [ DInt64(int64 id); variables; exprToDT body ] + + | PT.EPipeInfix(id, infix, expr) -> + "EPipeInfix", [ DInt64(int64 id); Infix.toDT infix; exprToDT expr ] + + | PT.EPipeFnCall(id, fnName, typeArgs, args) -> + "EPipeFnCall", + [ DInt64(int64 id) + NameResolution.toDT FQFnName.knownType FQFnName.toDT fnName + DList( + VT.known TypeReference.knownType, + List.map TypeReference.toDT typeArgs + ) + DList(VT.known exprKT, List.map exprToDT args) ] + + | PT.EPipeEnum(id, typeName, caseName, fields) -> + "EPipeEnum", + [ DInt64(int64 id) + NameResolution.toDT FQTypeName.knownType FQTypeName.toDT typeName + DString caseName + DList(VT.known exprKT, List.map exprToDT fields) ] + + DEnum(typeName, typeName, [], caseName, fields) + + + let fromDT (exprFromDT : Dval -> PT.Expr) (d : Dval) : PT.PipeExpr = + match d with + | DEnum(_, + _, + [], + "EPipeVariable", + [ DInt64 id; DString varName; DList(_vtTODO, args) ]) -> + PT.EPipeVariable(uint64 id, varName, args |> List.map exprFromDT) + + | DEnum(_, _, [], "EPipeLambda", [ DInt64 id; variables; body ]) -> + let variables = + match variables with + | DList(_vtTODO, pats) -> + pats + |> List.map LetPattern.fromDT + |> NEList.ofListUnsafe + "PT2DT.PipeExpr.fromDT expected at least one bound variable in EPipeLambda" + [] + | _ -> Exception.raiseInternal "Invalid variables" [] + + PT.EPipeLambda(uint64 id, variables, exprFromDT body) + + | DEnum(_, _, [], "EPipeInfix", [ DInt64 id; infix; expr ]) -> + PT.EPipeInfix(uint64 id, Infix.fromDT infix, exprFromDT expr) + + | DEnum(_, + _, + [], + "EPipeFnCall", + [ DInt64 id; fnName; DList(_vtTODO1, typeArgs); DList(_vtTODO2, args) ]) -> + PT.EPipeFnCall( + uint64 id, + NameResolution.fromDT FQFnName.fromDT fnName, + List.map TypeReference.fromDT typeArgs, + List.map exprFromDT args + ) + + | DEnum(_, + _, + [], + "EPipeEnum", + [ DInt64 id; typeName; DString caseName; DList(_vtTODO, fields) ]) -> + PT.EPipeEnum( + uint64 id, + NameResolution.fromDT FQTypeName.fromDT typeName, + caseName, + List.map exprFromDT fields + ) + + | _ -> Exception.raiseInternal "Invalid PipeExpr" [] module Expr = @@ -751,14 +751,14 @@ module Expr = "EMatch", [ DInt64(int64 id); toDT arg; cases ] - // | PT.EPipe(id, expr, pipeExprs) -> - // "EPipe", - // [ DInt64(int64 id) - // toDT expr - // DList( - // VT.known PipeExpr.knownType, - // List.map (PipeExpr.toDT knownType toDT) pipeExprs - // ) ] + | PT.EPipe(id, expr, pipeExprs) -> + "EPipe", + [ DInt64(int64 id) + toDT expr + DList( + VT.known PipeExpr.knownType, + List.map (PipeExpr.toDT knownType toDT) pipeExprs + ) ] // function calls diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index e5ab50dfef..b9e8f62501 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -514,6 +514,34 @@ module Expr = instructions = instrs resultIn = resultReg } + | PT.EPipe(id, lhs, parts) -> + // unwrap the first 'part' of the pipeline, + // and punt the other work for later + match parts with + | [] -> toRT symbols rc lhs + | first :: parts -> + let newLHS = + match first with + | PT.EPipeLambda(id, pats, body) -> + PT.EApply(id, PT.ELambda(id, pats, body), [], NEList.ofList lhs []) + + // `1 |> (+) 1` + | PT.EPipeInfix(id, infix, rhs) -> PT.EInfix(id, infix, lhs, rhs) + + // `1 |> Json.serialize` + | PT.EPipeFnCall(id, fnName, typeArgs, args) -> + PT.EApply(id, PT.EFnName(id, fnName), typeArgs, NEList.ofList lhs args) + + // `1 |> Option.Some` + | PT.EPipeEnum(id, typeName, caseName, fields) -> + let typeArgs = [] // TODO + PT.EEnum(id, typeName, typeArgs, caseName, [ lhs ] @ fields) + + // `1 |> myLambda` + | PT.EPipeVariable(id, varName, args) -> + PT.EApply(id, PT.EVariable(id, varName), [], NEList.ofList lhs args) + + toRT symbols rc (PT.EPipe(id, newLHS, parts)) | PT.EInfix(_, PT.BinOp op, left, right) -> let left = toRT symbols rc left @@ -600,9 +628,7 @@ module Expr = | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> let thingToApply = toRT symbols rc thingToApplyExpr - // TODO: maybe one or both of these lists should be an `NEList`? - // CLEANUP find a way to get rid of silly NEList stuff let (regCounter, argInstrs, argRegs) = let init = (thingToApply.registerCount, [], []) @@ -828,7 +854,7 @@ module Expr = | PT.ELambda(id, pats, body) -> - let symbolsUsedInBody = ProgramTypesAst.symbolsUsedIn body + let symbolsUsedInBody = ProgramTypesAst.symbolsUsedInExpr body let symbolsUsedInPats = pats |> NEList.toList |> List.map PT.LetPattern.symbolsUsed |> Set.unionMany let symbolsUsedInBodyNotDefinedInPats = diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 28925f9701..2f08e6d9ba 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -69,12 +69,13 @@ let eFieldAccess (expr : Expr) (fieldName : string) : Expr = let eRecordUpdate (expr : Expr) (updates : List) : Expr = ERecordUpdate(gid (), expr, NEList.ofListUnsafe "" [] updates) -// let eEnum -// (typeName : FQTypeName.FQTypeName) -// (name : string) -// (args : Expr list) -// : Expr = -// EEnum(gid (), typeName, name, args) +let eEnum + (typeName : FQTypeName.FQTypeName) + (typeArgs : List) + (caseName : string) + (args : Expr list) + : Expr = + EEnum(gid (), Ok typeName, typeArgs, caseName, args) let eInfix (op : Infix) (left : Expr) (right : Expr) : Expr = @@ -104,6 +105,29 @@ let eApply EApply(gid (), target, typeArgs, args) +let pLambda (pats : List) (body : Expr) : PipeExpr = + EPipeLambda(gid (), NEList.ofListUnsafe "pLambda" [] pats, body) + +let pInfix (op : Infix) (expr : Expr) : PipeExpr = EPipeInfix(gid (), op, expr) + +let pFnCall + (fn : FQFnName.FQFnName) + (typeArgs : List) + (args : List) + : PipeExpr = + EPipeFnCall(gid (), Ok fn, typeArgs, args) + +let pEnum + (typeName : FQTypeName.FQTypeName) + (caseName : string) + (fields : List) + : PipeExpr = + EPipeEnum(gid (), Ok typeName, caseName, fields) + +let pVariable (varName : string) (args : List) : PipeExpr = + EPipeVariable(gid (), varName, args) + +let ePipe (expr : Expr) (parts : List) : Expr = EPipe(gid (), expr, parts) // let customTypeRecord (fields : List) : TypeDeclaration.T = diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 75ba5da5bf..ecc6fa983c 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -252,6 +252,18 @@ module Match = listCons tuple ] +module Pipes = + let lambda = t "1 |> fun x -> x" E.Pipes.lambda (RT.DInt64 1L) + let infix = t "1 |> (+) 2" E.Pipes.infix (RT.DInt64 3L) + let fnCall = t "1 |> Builtin.int64Add 2" E.Pipes.fnCall (RT.DInt64 3L) + let variable = + t "let myLambda = fun x -> x + 1\n1 |> myLambda" E.Pipes.variable (RT.DInt64 2L) + let multiple = + t + "let incr = fun x -> x + 1\n2 |> incr |> fun x -> x * 2 |> Builtin.int64Add 3 |> (+) 4" + E.Pipes.multiple + (RT.DInt64 13L) + let tests = testList "Pipes" [ lambda; infix; fnCall; variable; multiple ] module Records = let simple = @@ -550,6 +562,7 @@ let tests = If.tests Tuples.tests Match.tests + Pipes.tests Records.tests RecordFieldAccess.tests RecordUpdate.tests diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 028c103491..2a82af1b79 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -485,8 +485,43 @@ module Expr = listCons tuple ] + module Pipes = + let lambda = + t + "1 |> fun x -> x" + E.Pipes.lambda + (4, + [ RT.CreateLambda( + 0, + { exprId = E.Lambdas.Identity.id + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = { registerCount = 1; instructions = []; resultIn = 0 } } + ) + RT.Apply(2, 0, [], NEList.ofList 1 []) ], + 0) + + let infix = t "1 |> (+) 2" E.Pipes.infix (5, [], 0) + + let fnCall = t "1 |> Builtin.int64Add 2" E.Pipes.fnCall (5, [], 0) + + let variable = + t "let myLambda = fun x -> x + 1\n1 |> myLambda" E.Pipes.variable (7, [], 0) + + let multiple = + t + "let incr = fun x -> x + 1\n2 |> incr |> fun x -> x * 2 |> Builtin.int64Add 3 |> (+) 4" + E.Pipes.multiple + (19, [], 0) + + // TODO lazy + let tests = testList "Pipes" [] //[ lambda ]//; infix; fnCall; variable; multiple ] + + + module Enums = + // TODO + let tests = testList "Enums" [] - // TODO: add tests for Enums module Records = let simple = @@ -1105,6 +1140,7 @@ module Expr = If.tests Tuples.tests Match.tests + Pipes.tests Records.tests RecordFieldAccess.tests RecordUpdate.tests diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 61c7a747c5..311cb676da 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -226,6 +226,57 @@ module Expressions = rhs = eStr [ strText "first branch" ] } ] + module Pipes = + /// `1 |> fun x -> x` + let lambda = ePipe (eInt64 1) [ pLambda [ lpVar "x" ] (eVar "x") ] + + /// `1 |> (+) 2` + let infix = + ePipe (eInt64 1) [ pInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 2) ] + + /// `1 |> Builtin.int64Add 2` + let fnCall = + ePipe + (eInt64 1) + [ pFnCall (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 2 ] ] + + //let enum = ePipe (eInt64 1) [ pEnum (PT.FQEnumName.fqPackage (System.Guid.NewGuid())) "variant" [] ] + + /// let myLambda = fun x -> x + 1 + /// 1 |> myLambda + let variable = + eLet + (lpVar "myLambda") + (eLambda + (gid ()) + [ lpVar "x" ] + (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 1))) + (ePipe (eInt64 1) [ pVariable "myLambda" [] ]) + + /// ```fsharp + /// let incr = fun x -> x + 1 + /// 2 |> incr |> fun x -> x * 2 |> Builtin.int64Add 3 |> (+) 4 + /// ``` + let multiple = + eLet + (lpVar "incr") + (eLambda + (gid ()) + [ lpVar "x" ] + (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 1))) + (ePipe + (eInt64 2) + [ pVariable "incr" [] + pLambda + [ lpVar "x" ] + (eInfix + (PT.Infix.InfixFnCall PT.ArithmeticMultiply) + (eVar "x") + (eInt64 2)) + pFnCall (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 3 ] + pInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 4) ]) + + module Records = let simple = eRecord (typeNamePkg PM.Types.Records.singleField) [] [ "key", eBool true ] From 32f97aa484ce2cfafbd6d0a178ac98e891a2329d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 17 Sep 2024 18:26:21 -0400 Subject: [PATCH 35/60] uncomment some of LibParser --- backend/src/LibParser/Canvas.fs | 10 +- backend/src/LibParser/Parser.fs | 20 +-- backend/src/LibParser/TestModule.fs | 81 ++++----- .../LibParser/WrittenTypesToProgramTypes.fs | 156 +++++++++--------- backend/tests/Tests/Tests.fsproj | 6 +- 5 files changed, 138 insertions(+), 135 deletions(-) diff --git a/backend/src/LibParser/Canvas.fs b/backend/src/LibParser/Canvas.fs index d010ea0f63..9986ca37aa 100644 --- a/backend/src/LibParser/Canvas.fs +++ b/backend/src/LibParser/Canvas.fs @@ -319,11 +319,11 @@ let parse let! initialResult = toPT builtins pm onMissing moduleWT let pm = - PT.PackageManager.withExtras - pm - initialResult.types - initialResult.constants - initialResult.fns + pm + |> PT.PackageManager.withExtras + initialResult.types + initialResult.constants + initialResult.fns // Now, parse again, but with the names in context (so fewer are marked as unresolved) let! result = toPT builtins pm onMissing moduleWT diff --git a/backend/src/LibParser/Parser.fs b/backend/src/LibParser/Parser.fs index c0c19670ed..17793764dd 100644 --- a/backend/src/LibParser/Parser.fs +++ b/backend/src/LibParser/Parser.fs @@ -40,16 +40,16 @@ let parseSimple parsePTExpr builtins pm onMissing filename code -let parseRTExpr - (builtins : RT.Builtins) - (pm : PT.PackageManager) - (onMissing : NR.OnMissing) - (filename : string) - (code : string) - : Ply = - code - |> parsePTExpr builtins pm onMissing filename - |> Ply.map LibExecution.ProgramTypesToRuntimeTypes.Expr.toRT +// let parseRTExpr +// (builtins : RT.Builtins) +// (pm : PT.PackageManager) +// (onMissing : NR.OnMissing) +// (filename : string) +// (code : string) +// : Ply = +// code +// |> parsePTExpr builtins pm onMissing filename +// |> Ply.map LibExecution.ProgramTypesToRuntimeTypes.Expr.toRT let parsePackageFile diff --git a/backend/src/LibParser/TestModule.fs b/backend/src/LibParser/TestModule.fs index 7a51c56248..9c99dc5723 100644 --- a/backend/src/LibParser/TestModule.fs +++ b/backend/src/LibParser/TestModule.fs @@ -42,20 +42,20 @@ type PTModule = let emptyPTModule = { name = []; types = []; fns = []; constants = []; dbs = []; tests = [] } -type RTTest = - { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } +// type RTTest = +// { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } -type RTModule = - { name : List - types : List - fns : List - constants : List - dbs : List - tests : List } +// type RTModule = +// { name : List +// types : List +// fns : List +// constants : List +// dbs : List +// tests : List } -let emptyRTModule = - { name = []; types = []; fns = []; constants = []; dbs = []; tests = [] } +// let emptyRTModule = +// { name = []; types = []; fns = []; constants = []; dbs = []; tests = [] } module UserDB = @@ -273,11 +273,12 @@ let parseTestFile // Now, parse again, but with the names in context (so fewer are marked as unresolved) let pm = - PT.PackageManager.withExtras - pm - (afterFirstPass |> List.collect _.types) - (afterFirstPass |> List.collect _.constants) - (afterFirstPass |> List.collect _.fns) + pm + |> PT.PackageManager.withExtras + (afterFirstPass |> List.collect _.types) + (afterFirstPass |> List.collect _.constants) + (afterFirstPass |> List.collect _.fns) + let! (afterSecondPass : List) = modulesWT |> Ply.List.mapSequentially (toPT owner builtins pm onMissing) @@ -322,27 +323,27 @@ let parseTestFile return adjusted } -let parseSingleTestFromFile - (builtins : RT.Builtins) - (pm : PT.PackageManager) - (onMissing : NR.OnMissing) - (filename : string) - (testSource : string) - : Ply = - uply { - let wtTest = - testSource - |> parseAsFSharpSourceFile filename - |> singleExprFromImplFile - |> parseTest - - let mapExpr = WT2PT.Expr.toPT builtins pm onMissing [] - - let! actual = wtTest.actual |> mapExpr |> Ply.map PT2RT.Expr.toRT - let! expected = wtTest.expected |> mapExpr |> Ply.map PT2RT.Expr.toRT - return - { actual = actual - expected = expected - lineNumber = wtTest.lineNumber - name = wtTest.name } - } +// let parseSingleTestFromFile +// (builtins : RT.Builtins) +// (pm : PT.PackageManager) +// (onMissing : NR.OnMissing) +// (filename : string) +// (testSource : string) +// : Ply = +// uply { +// let wtTest = +// testSource +// |> parseAsFSharpSourceFile filename +// |> singleExprFromImplFile +// |> parseTest + +// let mapExpr = WT2PT.Expr.toPT builtins pm onMissing [] + +// let! actual = wtTest.actual |> mapExpr |> Ply.map PT2RT.Expr.toRT +// let! expected = wtTest.expected |> mapExpr |> Ply.map PT2RT.Expr.toRT +// return +// { actual = actual +// expected = expected +// lineNumber = wtTest.lineNumber +// name = wtTest.name } +// } diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index 92ebc38280..b38cb6a8ad 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -185,9 +185,9 @@ module Expr = // | Ok _ as name -> return PT.EConstant(id, name) // | Error _ -> return PT.EVariable(id, var) - // | WT.ERecordFieldAccess(id, obj, fieldname) -> - // let! obj = toPT obj - // return PT.ERecordFieldAccess(id, obj, fieldname) + | WT.ERecordFieldAccess(id, obj, fieldname) -> + let! obj = toPT obj + return PT.ERecordFieldAccess(id, obj, fieldname) | WT.EApply(id, (WT.EFnName(_, name)), [], { head = WT.EPlaceHolder }) -> // There are no arguments, so this could be a function name or a constant let! fnName = @@ -270,7 +270,8 @@ module Expr = return (fieldName, fieldExpr) }) fields - return PT.ERecord(id, typeName, fields) + let typeArgs = []// TODO + return PT.ERecord(id, typeName, typeArgs, fields) | WT.ERecordUpdate(id, record, updates) -> let! record = toPT record let! updates = @@ -291,7 +292,8 @@ module Expr = | WT.EEnum(id, typeName, caseName, exprs) -> let! typeName = resolveTypeName pm onMissing currentModule typeName caseName let! exprs = Ply.List.mapSequentially toPT exprs - return PT.EEnum(id, typeName, caseName, exprs) + let typeArgs = [] // TODO + return PT.EEnum(id, typeName, typeArgs, caseName, exprs) | WT.EMatch(id, mexpr, cases) -> let! mexpr = toPT mexpr let! cases = @@ -346,78 +348,78 @@ module Expr = toPT builtins pm onMissing currentModule expr |> Ply.map (fun interpolated -> PT.StringInterpolation interpolated) -// and pipeExprToPT -// (builtins : RT.Builtins) -// (pm : PT.PackageManager) -// (onMissing : NR.OnMissing) -// (currentModule : List) -// (pipeExpr : WT.PipeExpr) -// : Ply = -// let toPT = toPT builtins pm onMissing currentModule - -// uply { -// match pipeExpr with -// | WT.EPipeVariableOrFnCall(id, name) -> -// let! resolved = -// let asUserFnName = WT.Name.Unresolved(NEList.singleton name) -// NR.resolveFnName -// (builtins.fns |> Map.keys |> Set) -// pm -// NR.OnMissing.Allow -// currentModule -// asUserFnName - -// return -// match resolved with -// | Ok name -> PT.EPipeFnCall(id, Ok name, [], []) -// | Error _ -> PT.EPipeVariable(id, name, []) - -// | WT.EPipeLambda(id, pats, body) -> -// let! body = toPT body -// return PT.EPipeLambda(id, NEList.map LetPattern.toPT pats, body) - -// | WT.EPipeInfix(id, infix, first) -> -// let! first = toPT first -// return PT.EPipeInfix(id, Infix.toPT infix, first) - -// | WT.EPipeFnCall(id, -// (WT.Unresolved { head = varName; tail = [] } as name), -// [], -// args) -> -// // Special case for variables with arguments. Since it could be a userfn, we -// // need to check that first. We do a similar thing converting EFnNames. -// let! fnName = -// NR.resolveFnName -// (builtins.fns |> Map.keys |> Set) -// pm -// NR.OnMissing.Allow -// currentModule -// name -// let! args = Ply.List.mapSequentially toPT args -// match fnName with -// | Ok name -> return PT.EPipeFnCall(id, Ok name, [], args) -// | Error _ -> return PT.EPipeVariable(id, varName, args) - -// | WT.EPipeFnCall(id, name, typeArgs, args) -> -// let! fnName = -// NR.resolveFnName -// (builtins.fns |> Map.keys |> Set) -// pm -// onMissing -// currentModule -// name -// let! typeArgs = -// Ply.List.mapSequentially -// (TypeReference.toPT pm onMissing currentModule) -// typeArgs -// let! args = Ply.List.mapSequentially toPT 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 fields -// return PT.EPipeEnum(id, typeName, caseName, fields) -// } + and pipeExprToPT + (builtins : RT.Builtins) + (pm : PT.PackageManager) + (onMissing : NR.OnMissing) + (currentModule : List) + (pipeExpr : WT.PipeExpr) + : Ply = + let toPT = toPT builtins pm onMissing currentModule + + uply { + match pipeExpr with + | WT.EPipeVariableOrFnCall(id, name) -> + let! resolved = + let asUserFnName = WT.Name.Unresolved(NEList.singleton name) + NR.resolveFnName + (builtins.fns |> Map.keys |> Set) + pm + NR.OnMissing.Allow + currentModule + asUserFnName + + return + match resolved with + | Ok name -> PT.EPipeFnCall(id, Ok name, [], []) + | Error _ -> PT.EPipeVariable(id, name, []) + + | WT.EPipeLambda(id, pats, body) -> + let! body = toPT body + return PT.EPipeLambda(id, NEList.map LetPattern.toPT pats, body) + + | WT.EPipeInfix(id, infix, first) -> + let! first = toPT first + return PT.EPipeInfix(id, Infix.toPT infix, first) + + | WT.EPipeFnCall(id, + (WT.Unresolved { head = varName; tail = [] } as name), + [], + args) -> + // Special case for variables with arguments. Since it could be a userfn, we + // need to check that first. We do a similar thing converting EFnNames. + let! fnName = + NR.resolveFnName + (builtins.fns |> Map.keys |> Set) + pm + NR.OnMissing.Allow + currentModule + name + let! args = Ply.List.mapSequentially toPT args + match fnName with + | Ok name -> return PT.EPipeFnCall(id, Ok name, [], args) + | Error _ -> return PT.EPipeVariable(id, varName, args) + + | WT.EPipeFnCall(id, name, typeArgs, args) -> + let! fnName = + NR.resolveFnName + (builtins.fns |> Map.keys |> Set) + pm + onMissing + currentModule + name + let! typeArgs = + Ply.List.mapSequentially + (TypeReference.toPT pm onMissing currentModule) + typeArgs + let! args = Ply.List.mapSequentially toPT 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 fields + return PT.EPipeEnum(id, typeName, caseName, fields) + } module Const = let rec toPT diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 8795b7bcdf..2b54b61f9d 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -12,10 +12,10 @@ - + - - + + From 38be0c9a453c4557e2988b1d060cfb389a01f10f Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Tue, 17 Sep 2024 22:34:28 -0400 Subject: [PATCH 36/60] uncomment PT2ST --- backend/fsdark.sln | 14 +-- .../ProgramTypesToSerializedTypes.fs | 94 +++++-------------- .../LibBinarySerialization/SerializedTypes.fs | 31 ++---- backend/src/LibParser/Canvas.fs | 6 +- backend/src/LibParser/TestModule.fs | 6 +- .../LibParser/WrittenTypesToProgramTypes.fs | 8 +- backend/tests/Tests/Tests.fsproj | 2 +- 7 files changed, 50 insertions(+), 111 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index eabb776a4c..a1eb820e46 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -33,8 +33,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinExecution", "src\Bui EndProject # Cloud stuff -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "src\LibBinarySerialization\LibBinarySerialization.fsproj", "{5830D9BF-CA28-47B0-964F-343FAB28751B}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "src\LibBinarySerialization\LibBinarySerialization.fsproj", "{5830D9BF-CA28-47B0-964F-343FAB28751B}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" @@ -145,10 +145,10 @@ Global #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.Build.0 = Release|Any CPU - #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.Build.0 = Release|Any CPU + {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.Build.0 = Debug|Any CPU + {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.ActiveCfg = Release|Any CPU + {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.Build.0 = Release|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|Any CPU.Build.0 = Debug|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -206,7 +206,7 @@ Global #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs b/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs index 483191a7a1..0d8d357bc1 100644 --- a/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs +++ b/backend/src/LibBinarySerialization/ProgramTypesToSerializedTypes.fs @@ -16,80 +16,30 @@ module NEList = module NameResolutionError = - module NameType = - let toST - (nameType : LibExecution.NameResolutionError.NameType) - : ST.NameResolutionError.NameType = - match nameType with - | LibExecution.NameResolutionError.Type -> ST.NameResolutionError.Type - | LibExecution.NameResolutionError.Function -> ST.NameResolutionError.Function - | LibExecution.NameResolutionError.Constant -> ST.NameResolutionError.Constant - - let toPT - (nameType : ST.NameResolutionError.NameType) - : LibExecution.NameResolutionError.NameType = - match nameType with - | ST.NameResolutionError.Type -> LibExecution.NameResolutionError.Type - | ST.NameResolutionError.Function -> LibExecution.NameResolutionError.Function - | ST.NameResolutionError.Constant -> LibExecution.NameResolutionError.Constant - - - module ErrorType = - let toST - (err : LibExecution.NameResolutionError.ErrorType) - : ST.NameResolutionError.ErrorType = - match err with - | LibExecution.NameResolutionError.NotFound names -> - ST.NameResolutionError.NotFound names - | LibExecution.NameResolutionError.MissingEnumModuleName caseName -> - ST.NameResolutionError.MissingEnumModuleName caseName - | LibExecution.NameResolutionError.InvalidPackageName names -> - ST.NameResolutionError.InvalidPackageName names - | LibExecution.NameResolutionError.ExpectedEnumButNot packageTypeID -> - ST.NameResolutionError.ExpectedEnumButNot packageTypeID - | LibExecution.NameResolutionError.ExpectedRecordButNot packageTypeID -> - ST.NameResolutionError.ExpectedRecordButNot packageTypeID - - - let toPT - (err : ST.NameResolutionError.ErrorType) - : LibExecution.NameResolutionError.ErrorType = - match err with - | ST.NameResolutionError.ErrorType.NotFound names -> - LibExecution.NameResolutionError.NotFound names - | ST.NameResolutionError.MissingEnumModuleName caseName -> - LibExecution.NameResolutionError.MissingEnumModuleName caseName - | ST.NameResolutionError.InvalidPackageName names -> - LibExecution.NameResolutionError.InvalidPackageName names - | ST.NameResolutionError.ExpectedEnumButNot packageTypeID -> - LibExecution.NameResolutionError.ExpectedEnumButNot packageTypeID - | ST.NameResolutionError.ExpectedRecordButNot packageTypeID -> - LibExecution.NameResolutionError.ExpectedRecordButNot packageTypeID - - module Error = - let toST - (err : LibExecution.NameResolutionError.Error) - : ST.NameResolutionError.Error = - { nameType = NameType.toST err.nameType - errorType = ErrorType.toST err.errorType } - - let toPT - (err : ST.NameResolutionError.Error) - : LibExecution.NameResolutionError.Error = - { errorType = ErrorType.toPT err.errorType - nameType = NameType.toPT err.nameType } + let toST (err : PT.NameResolutionError) : ST.NameResolutionError = + match err with + | PT.NameResolutionError.NotFound names -> ST.NameResolutionError.NotFound names + | PT.NameResolutionError.InvalidName names -> + ST.NameResolutionError.InvalidName names + + + let toPT (err : ST.NameResolutionError) : PT.NameResolutionError = + match err with + | ST.NameResolutionError.NotFound names -> PT.NameResolutionError.NotFound names + | ST.NameResolutionError.InvalidName names -> + PT.NameResolutionError.InvalidName names module NameResolution = let toST (f : 'p -> 's) (result : PT.NameResolution<'p>) : ST.NameResolution<'s> = match result with | Ok name -> Ok(f name) - | Error err -> Error(NameResolutionError.Error.toST err) + | Error err -> Error(NameResolutionError.toST err) let toPT (f : 's -> 'p) (result : ST.NameResolution<'s>) : PT.NameResolution<'p> = match result with | Ok name -> Ok(f name) - | Error err -> Error(NameResolutionError.Error.toPT err) + | Error err -> Error(NameResolutionError.toPT err) module FQTypeName = @@ -213,7 +163,7 @@ module TypeReference = | PT.TTuple(first, second, theRest) -> ST.TTuple(toST first, toST second, List.map toST theRest) | PT.TDict typ -> ST.TDict(toST typ) - | PT.TDB typ -> ST.TDB(toST typ) + //| PT.TDB typ -> ST.TDB(toST typ) | PT.TDateTime -> ST.TDateTime | PT.TChar -> ST.TChar | PT.TUuid -> ST.TUuid @@ -243,7 +193,7 @@ module TypeReference = | ST.TTuple(firstType, secondType, otherTypes) -> PT.TTuple(toPT firstType, toPT secondType, List.map toPT otherTypes) | ST.TDict typ -> PT.TDict(toPT typ) - | ST.TDB typ -> PT.TDB(toPT typ) + //| ST.TDB typ -> PT.TDB(toPT typ) | ST.TDateTime -> PT.TDateTime | ST.TChar -> PT.TChar | ST.TUuid -> PT.TUuid @@ -385,10 +335,11 @@ module Expr = | PT.EList(id, exprs) -> ST.EList(id, List.map toST exprs) | PT.ETuple(id, first, second, theRest) -> ST.ETuple(id, toST first, toST second, List.map toST theRest) - | PT.ERecord(id, typeName, fields) -> + | PT.ERecord(id, typeName, typeArgs, fields) -> ST.ERecord( id, NameResolution.toST FQTypeName.toST typeName, + List.map TypeReference.toST typeArgs, List.map (Tuple2.mapSecond toST) fields ) | PT.ERecordUpdate(id, record, updates) -> @@ -399,10 +350,11 @@ module Expr = ) | PT.EPipe(pipeID, expr1, rest) -> ST.EPipe(pipeID, toST expr1, List.map pipeExprToST rest) - | PT.EEnum(id, typeName, caseName, fields) -> + | PT.EEnum(id, typeName, typeArgs, caseName, fields) -> ST.EEnum( id, NameResolution.toST FQTypeName.toST typeName, + List.map TypeReference.toST typeArgs, caseName, List.map toST fields ) @@ -486,10 +438,11 @@ module Expr = | ST.EList(id, exprs) -> PT.EList(id, List.map toPT exprs) | ST.ETuple(id, first, second, theRest) -> PT.ETuple(id, toPT first, toPT second, List.map toPT theRest) - | ST.ERecord(id, typeName, fields) -> + | ST.ERecord(id, typeName, typeArgs, fields) -> PT.ERecord( id, NameResolution.toPT FQTypeName.toPT typeName, + List.map TypeReference.toPT typeArgs, List.map (Tuple2.mapSecond toPT) fields ) | ST.ERecordUpdate(id, record, updates) -> @@ -500,10 +453,11 @@ module Expr = ) | ST.EPipe(pipeID, expr1, rest) -> PT.EPipe(pipeID, toPT expr1, List.map pipeExprToPT rest) - | ST.EEnum(id, typeName, caseName, exprs) -> + | ST.EEnum(id, typeName, typeArgs, caseName, exprs) -> PT.EEnum( id, NameResolution.toPT FQTypeName.toPT typeName, + List.map TypeReference.toPT typeArgs, caseName, List.map toPT exprs ) diff --git a/backend/src/LibBinarySerialization/SerializedTypes.fs b/backend/src/LibBinarySerialization/SerializedTypes.fs index c863afc572..6da3e76ad1 100644 --- a/backend/src/LibBinarySerialization/SerializedTypes.fs +++ b/backend/src/LibBinarySerialization/SerializedTypes.fs @@ -96,30 +96,13 @@ module FQFnName = | Package of Package -module NameResolutionError = - [] - type ErrorType = - | NotFound of names : List - | ExpectedEnumButNot of packageTypeID : uuid - | ExpectedRecordButNot of packageTypeID : uuid - | MissingEnumModuleName of caseName : string - | InvalidPackageName of names : List - - [] - type NameType = - | Function - | Type - | Constant - - [] - type Error = - { [] - errorType : ErrorType - [] - nameType : NameType } +[] +type NameResolutionError = + | NotFound of List + | InvalidName of List [] -type NameResolution<'a> = Result<'a, NameResolutionError.Error> +type NameResolution<'a> = Result<'a, NameResolutionError> @@ -141,7 +124,7 @@ type TypeReference = | TString | TList of TypeReference | TDict of TypeReference - | TDB of TypeReference + //| TDB of TypeReference | TDateTime | TChar | TUuid @@ -245,12 +228,14 @@ type Expr = | ERecord of id * typeName : NameResolution * + typeArgs : List * fields : List | ERecordUpdate of id * record : Expr * updates : NEList | EPipe of id * Expr * List | EEnum of id * typeName : NameResolution * + typeArgs : List * caseName : string * fields : List | EMatch of id * Expr * List diff --git a/backend/src/LibParser/Canvas.fs b/backend/src/LibParser/Canvas.fs index 9986ca37aa..7311499d19 100644 --- a/backend/src/LibParser/Canvas.fs +++ b/backend/src/LibParser/Canvas.fs @@ -321,9 +321,9 @@ let parse let pm = pm |> PT.PackageManager.withExtras - initialResult.types - initialResult.constants - initialResult.fns + initialResult.types + initialResult.constants + initialResult.fns // Now, parse again, but with the names in context (so fewer are marked as unresolved) let! result = toPT builtins pm onMissing moduleWT diff --git a/backend/src/LibParser/TestModule.fs b/backend/src/LibParser/TestModule.fs index 9c99dc5723..21b23b3f8d 100644 --- a/backend/src/LibParser/TestModule.fs +++ b/backend/src/LibParser/TestModule.fs @@ -275,9 +275,9 @@ let parseTestFile let pm = pm |> PT.PackageManager.withExtras - (afterFirstPass |> List.collect _.types) - (afterFirstPass |> List.collect _.constants) - (afterFirstPass |> List.collect _.fns) + (afterFirstPass |> List.collect _.types) + (afterFirstPass |> List.collect _.constants) + (afterFirstPass |> List.collect _.fns) let! (afterSecondPass : List) = modulesWT |> Ply.List.mapSequentially (toPT owner builtins pm onMissing) diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index b38cb6a8ad..c136a57cf2 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -270,7 +270,7 @@ module Expr = return (fieldName, fieldExpr) }) fields - let typeArgs = []// TODO + let typeArgs = [] // TODO return PT.ERecord(id, typeName, typeArgs, fields) | WT.ERecordUpdate(id, record, updates) -> let! record = toPT record @@ -383,9 +383,9 @@ module Expr = return PT.EPipeInfix(id, Infix.toPT infix, first) | WT.EPipeFnCall(id, - (WT.Unresolved { head = varName; tail = [] } as name), - [], - args) -> + (WT.Unresolved { head = varName; tail = [] } as name), + [], + args) -> // Special case for variables with arguments. Since it could be a userfn, we // need to check that first. We do a similar thing converting EFnNames. let! fnName = diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 2b54b61f9d..808a723143 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -19,7 +19,7 @@ - + From 4d1e23d6c2ec9609489325bde862be0e5547c052 Mon Sep 17 00:00:00 2001 From: Ocean Date: Wed, 18 Sep 2024 13:47:21 +0000 Subject: [PATCH 37/60] Add more interpreter and PT2RT tests --- .../ProgramTypesToRuntimeTypes.fs | 1 + backend/tests/TestUtils/PTShortcuts.fs | 16 +- backend/tests/Tests/Interpreter.Tests.fs | 28 ++- backend/tests/Tests/PT2RT.Tests.fs | 174 ++++++++++++++++-- backend/tests/Tests/TestValues.fs | 92 ++++++++- 5 files changed, 282 insertions(+), 29 deletions(-) diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index b9e8f62501..37842262e2 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -522,6 +522,7 @@ module Expr = | first :: parts -> let newLHS = match first with + // `1 |> fun x -> x + 1` | PT.EPipeLambda(id, pats, body) -> PT.EApply(id, PT.ELambda(id, pats, body), [], NEList.ofList lhs []) diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 2f08e6d9ba..4a00d86436 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -105,27 +105,29 @@ let eApply EApply(gid (), target, typeArgs, args) -let pLambda (pats : List) (body : Expr) : PipeExpr = - EPipeLambda(gid (), NEList.ofListUnsafe "pLambda" [] pats, body) +let pLambda id (pats : List) (body : Expr) : PipeExpr = + EPipeLambda(id, NEList.ofListUnsafe "pLambda" [] pats, body) -let pInfix (op : Infix) (expr : Expr) : PipeExpr = EPipeInfix(gid (), op, expr) +let pInfix id (op : Infix) (expr : Expr) : PipeExpr = EPipeInfix(id, op, expr) let pFnCall + id (fn : FQFnName.FQFnName) (typeArgs : List) (args : List) : PipeExpr = - EPipeFnCall(gid (), Ok fn, typeArgs, args) + EPipeFnCall(id, Ok fn, typeArgs, args) let pEnum + id (typeName : FQTypeName.FQTypeName) (caseName : string) (fields : List) : PipeExpr = - EPipeEnum(gid (), Ok typeName, caseName, fields) + EPipeEnum(id, Ok typeName, caseName, fields) -let pVariable (varName : string) (args : List) : PipeExpr = - EPipeVariable(gid (), varName, args) +let pVariable id (varName : string) (args : List) : PipeExpr = + EPipeVariable(id, varName, args) let ePipe (expr : Expr) (parts : List) : Expr = EPipe(gid (), expr, parts) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index ecc6fa983c..1f3c2cb6a0 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -353,6 +353,24 @@ module RecordUpdate = let tests = testList "RecordUpdate" [ simple; notRecord ] // fieldThatShouldNotExist; fieldWithWrongType ] +// TODO: add more tests +module Enum = + let simple = + let typeName = RT.FQTypeName.fqPackage PM.Types.Enums.withoutFields + t + "Test.ColorEnum.Blue" + E.Enums.simple + (RT.DEnum(typeName, typeName, [], "Blue", [])) + + let withFields = + let typeName = RT.FQTypeName.fqPackage PM.Types.Enums.withFields + t + "Test.MyOption.Some 1" + E.Enums.withFields + (RT.DEnum(typeName, typeName, [], "Some", [ RT.DInt64 1L ])) + + let tests = testList "Enum" [ simple; withFields ] + module Constants = module Package = @@ -540,7 +558,14 @@ module Fns = let tests = testList "Fact" [ unapplied; appliedWith2; appliedWith20 ] - let tests = testList "Package" [ MyAdd.tests; Fact.tests ] + module Recusrsion = + let addUpTo = + t "Test.addUpTo 300000" E.Fns.Package.Recursion.applied (RT.DInt64 300000L) + + let tests = testList "Recursion" [ addUpTo ] + + + let tests = testList "Package" [ MyAdd.tests; Fact.tests; Recusrsion.tests ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] @@ -566,6 +591,7 @@ let tests = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Enum.tests Constants.tests Infix.tests Lambdas.tests diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 2a82af1b79..69a8b3d846 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -490,37 +490,188 @@ module Expr = t "1 |> fun x -> x" E.Pipes.lambda - (4, + (3, [ RT.CreateLambda( 0, - { exprId = E.Lambdas.Identity.id + { exprId = E.Pipes.pipeID patterns = NEList.ofList (RT.LPVariable 0) [] registersToClose = [] instructions = { registerCount = 1; instructions = []; resultIn = 0 } } ) + RT.LoadVal(1, RT.DInt64 1L) RT.Apply(2, 0, [], NEList.ofList 1 []) ], - 0) + 2) - let infix = t "1 |> (+) 2" E.Pipes.infix (5, [], 0) + let infix = + t + "1 |> (+) 2" + E.Pipes.infix + (4, + [ RT.LoadVal(0, RT.DInt64 1L) + RT.LoadVal(1, RT.DInt64 2L) + RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ], + 3) - let fnCall = t "1 |> Builtin.int64Add 2" E.Pipes.fnCall (5, [], 0) + let fnCall = + // why are we loading the fn first? + t + "1 |> Builtin.int64Add 2" + E.Pipes.fnCall + (4, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], NEList.ofList 1 [ 2 ]) ], + 3) let variable = - t "let myLambda = fun x -> x + 1\n1 |> myLambda" E.Pipes.variable (7, [], 0) + t + "let myLambda = fun x -> x + 1\n1 |> myLambda" + E.Pipes.variable + (4, + [ RT.CreateLambda( + 0, + { exprId = E.Pipes.lambdaID + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.Apply(3, 1, [], NEList.ofList 2 []) ], + 3) let multiple = t "let incr = fun x -> x + 1\n2 |> incr |> fun x -> x * 2 |> Builtin.int64Add 3 |> (+) 4" E.Pipes.multiple - (19, [], 0) + (12, + [ RT.CreateLambda( + 0, + { exprId = E.Pipes.lambdaID + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal( + 2, + (RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + )) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) + RT.CheckLetPatternAndExtractVars(0, RT.LPVariable 1) + RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.CreateLambda( + 3, + { exprId = E.Pipes.pipeID + patterns = NEList.ofList (RT.LPVariable 0) [] + registersToClose = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal(1, RT.DInt64 2L) + RT.LoadVal( + 2, + (RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Multiply" 0 + argsSoFar = [] } + )) + ) + RT.Apply(3, 2, [], NEList.ofList 0 [ 1 ]) ] + resultIn = 3 } } + ) + RT.LoadVal(4, RT.DInt64 2L) + RT.Apply(5, 1, [], NEList.ofList 4 []) + RT.Apply(6, 3, [], NEList.ofList 5 []) + RT.LoadVal(7, RT.DInt64 3L) + RT.Apply(8, 2, [], NEList.ofList 6 [ 7 ]) + RT.LoadVal(9, RT.DInt64 4L) + RT.LoadVal( + 10, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0; argsSoFar = [] } + ) + ) + RT.Apply(11, 10, [], NEList.ofList 8 [ 9 ]) ], + 11) + + - // TODO lazy - let tests = testList "Pipes" [] //[ lambda ]//; infix; fnCall; variable; multiple ] + let tests = testList "Pipes" [ lambda; infix; fnCall; variable; multiple ] module Enums = - // TODO - let tests = testList "Enums" [] + let simple = + t + "Test.Color.Blue" + E.Enums.simple + (1, + [ RT.CreateEnum( + 0, + RT.FQTypeName.fqPackage PM.Types.Enums.withoutFields, + [], + "Blue", + [] + ) ], + 0) + + let withFields = + t + "Test.MyOption.Some 1" + E.Enums.withFields + (2, + [ RT.LoadVal(1, RT.DInt64 1L) + RT.CreateEnum( + 0, + RT.FQTypeName.fqPackage PM.Types.Enums.withFields, + [], + "Some", + [ 1 ] + ) ], + 0) + + let tests = testList "Enums" [ simple; withFields ] module Records = @@ -1144,6 +1295,7 @@ module Expr = Records.tests RecordFieldAccess.tests RecordUpdate.tests + Enums.tests Constants.tests Infix.tests Lambda.tests diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 311cb676da..053aa73099 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -42,7 +42,30 @@ module PM = description = "TODO" } ] ] module Enums = - let all = [] + let withoutFields = guuid () + let withFields = guuid () + let make id name cases = + make id name (PT.TypeDeclaration.Enum(NEList.ofListUnsafe "" [] cases)) + + let colorEnum = + make + withoutFields + (PT.PackageType.name "Test" [] "ColorEnum") + [ { name = "Red"; fields = []; description = "TODO" } + { name = "Green"; fields = []; description = "TODO" } + { name = "Blue"; fields = []; description = "TODO" } ] + + let MyOption = + make + withFields + (PT.PackageType.name "Test" [] "MyOption") + [ { name = "None"; fields = []; description = "TODO" } + { name = "Some" + fields = [ { typ = PT.TInt64; label = None; description = "TODO" } ] + description = "TODO" } ] + + let all : List = [ colorEnum; MyOption ] + let all = Records.all @ Enums.all @@ -227,18 +250,22 @@ module Expressions = module Pipes = + let lambdaID = gid () + let pipeID = gid () /// `1 |> fun x -> x` - let lambda = ePipe (eInt64 1) [ pLambda [ lpVar "x" ] (eVar "x") ] + let lambda = ePipe (eInt64 1) [ pLambda pipeID [ lpVar "x" ] (eVar "x") ] /// `1 |> (+) 2` let infix = - ePipe (eInt64 1) [ pInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 2) ] + ePipe + (eInt64 1) + [ pInfix pipeID (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 2) ] /// `1 |> Builtin.int64Add 2` let fnCall = ePipe (eInt64 1) - [ pFnCall (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 2 ] ] + [ pFnCall pipeID (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 2 ] ] //let enum = ePipe (eInt64 1) [ pEnum (PT.FQEnumName.fqPackage (System.Guid.NewGuid())) "variant" [] ] @@ -248,10 +275,10 @@ module Expressions = eLet (lpVar "myLambda") (eLambda - (gid ()) + lambdaID [ lpVar "x" ] (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 1))) - (ePipe (eInt64 1) [ pVariable "myLambda" [] ]) + (ePipe (eInt64 1) [ pVariable pipeID "myLambda" [] ]) /// ```fsharp /// let incr = fun x -> x + 1 @@ -261,20 +288,21 @@ module Expressions = eLet (lpVar "incr") (eLambda - (gid ()) + lambdaID [ lpVar "x" ] (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 1))) (ePipe (eInt64 2) - [ pVariable "incr" [] + [ pVariable pipeID "incr" [] pLambda + pipeID [ lpVar "x" ] (eInfix (PT.Infix.InfixFnCall PT.ArithmeticMultiply) (eVar "x") (eInt64 2)) - pFnCall (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 3 ] - pInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 4) ]) + pFnCall pipeID (PT.FQFnName.fqBuiltIn "int64Add" 0) [] [ eInt64 3 ] + pInfix pipeID (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eInt64 4) ]) module Records = @@ -298,6 +326,11 @@ module Expressions = let fieldWithWrongType = eRecordUpdate Records.simple [ "key", eInt64 1 ] + module Enums = + let simple = eEnum (typeNamePkg PM.Types.Enums.withoutFields) [] "Blue" [] + let withFields = + eEnum (typeNamePkg PM.Types.Enums.withFields) [] "Some" [ eInt64 1 ] + module Constants = // CLEANUP we don't really have builtin constants, so not bothering to test for now // module Builtin = @@ -405,9 +438,16 @@ module Expressions = let appliedWith2 = eApply unapplied [] [ eInt64 2 ] let appliedWith20 = eApply unapplied [] [ eInt64 20 ] + module Recursion = + let id = System.Guid.Parse "02036aff-7ae5-4e7c-8f95-f42936044542" + let unapplied = ePackageFn id + let applied = eApply unapplied [] [ eInt64 300000 ] + module PT2RT = LibExecution.ProgramTypesToRuntimeTypes + +//CLEANUP: Migrate this to the top let pm : PT.PackageManager = PT.PackageManager.empty |> PT.PackageManager.withExtras @@ -451,4 +491,36 @@ let pm : PT.PackageManager = )) description = "TODO" + deprecated = PT.NotDeprecated } + + // let addUpTO (n : Int64) : Int64 = + // if n <= 0 then 0 + // else 1 + addUpTo (n - 1) + { id = Expressions.Fns.Package.Recursion.id + name = PT.PackageFn.name "Test" [] "addUpTo" + typeParams = [] + parameters = + NEList.ofList { name = "n"; typ = PT.TInt64; description = "TODO" } [] + returnType = PT.TInt64 + body = + eIf + (eApply + (eBuiltinFn "int64LessThanOrEqualTo" 0) + [] + [ eVar "n"; eInt64 0L ]) + (eInt64 0L) + (Some( + eApply + (eBuiltinFn "int64Add" 0) + [] + [ eInt64 1L + (eApply + (ePackageFn Expressions.Fns.Package.Recursion.id) + [] + [ eApply + (eBuiltinFn "int64Subtract" 0) + [] + [ eVar "n"; eInt64 1L ] ]) ] + )) + description = "TODO" deprecated = PT.NotDeprecated } ] From 6c78a108d231a6d9f6f44662ce3974a87a8a2a81 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 09:59:08 -0400 Subject: [PATCH 38/60] uncomment more builtins --- backend/fsdark.sln | 42 +++++++++---------- backend/src/BuiltinCloudExecution/Builtin.fs | 7 +++- .../BuiltinCloudExecution.fsproj | 4 +- backend/src/BuiltinDarkInternal/Builtin.fs | 26 ++++++------ .../BuiltinDarkInternal.fsproj | 16 +++---- .../src/BuiltinDarkInternal/Libs/Canvases.fs | 4 +- backend/tests/Tests/Tests.fsproj | 10 ++--- 7 files changed, 58 insertions(+), 51 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index a1eb820e46..361a08f5f0 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -25,8 +25,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Prelude", "src\Prelude\Prel EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibExecution", "src\LibExecution\LibExecution.fsproj", "{D8ECA989-4383-47D3-B443-4D7BFF1F05E7}" EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibParser", "src\LibParser\LibParser.fsproj", "{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibTreeSitter", "src\LibTreeSitter\LibTreeSitter.fsproj", "{625B113A-D5DC-40A5-B833-4BA342AB4936}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinExecution", "src\BuiltinExecution\BuiltinExecution.fsproj", "{BBFC824F-A0DE-4A28-B82F-49C04EBA7475}" @@ -37,12 +37,12 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibBinarySerialization", "s EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibService\LibService.fsproj", "{824DD2A5-7F01-4A8A-9ABD-9F91F52582AD}" EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" @@ -129,10 +129,10 @@ Global #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.Build.0 = Release|Any CPU - #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.Build.0 = Release|Any CPU + {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU + {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU + {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.Build.0 = Release|Any CPU #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -153,10 +153,10 @@ Global {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Debug|Any CPU.Build.0 = Debug|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|Any CPU.ActiveCfg = Release|Any CPU {EDAB6E2C-A0C9-4C66-A9AB-D07FB64EA4A8}.Release|Any CPU.Build.0 = Release|Any CPU - #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.Build.0 = Release|Any CPU + {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.Build.0 = Release|Any CPU #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.Build.0 = Debug|Any CPU #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -173,10 +173,10 @@ Global #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.Build.0 = Release|Any CPU - #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.Build.0 = Release|Any CPU + {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU + {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU + {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.Build.0 = Release|Any CPU #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.Build.0 = Debug|Any CPU #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -202,16 +202,16 @@ Global {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {DB61305F-4CA9-4D92-82A5-503495F515E8} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} diff --git a/backend/src/BuiltinCloudExecution/Builtin.fs b/backend/src/BuiltinCloudExecution/Builtin.fs index e90afaebd0..ec6b0b94f9 100644 --- a/backend/src/BuiltinCloudExecution/Builtin.fs +++ b/backend/src/BuiltinCloudExecution/Builtin.fs @@ -10,4 +10,9 @@ let fnRenames : Builtin.FnRenames = // eg: fn "Http" "respond" 0, fn "Http" "response" 0 [] -let builtins = Builtin.combine [ Libs.DB.builtins; Libs.Event.builtins ] fnRenames +let builtins = + Builtin.combine + [ + //Libs.DB.builtins; + //Libs.Event.builtins + ] fnRenames diff --git a/backend/src/BuiltinCloudExecution/BuiltinCloudExecution.fsproj b/backend/src/BuiltinCloudExecution/BuiltinCloudExecution.fsproj index ba3a0a4270..72888b36f2 100644 --- a/backend/src/BuiltinCloudExecution/BuiltinCloudExecution.fsproj +++ b/backend/src/BuiltinCloudExecution/BuiltinCloudExecution.fsproj @@ -15,8 +15,8 @@ - - + + diff --git a/backend/src/BuiltinDarkInternal/Builtin.fs b/backend/src/BuiltinDarkInternal/Builtin.fs index fdca679c9f..64bcc3bd87 100644 --- a/backend/src/BuiltinDarkInternal/Builtin.fs +++ b/backend/src/BuiltinDarkInternal/Builtin.fs @@ -18,29 +18,31 @@ let fnRenames : Builtin.FnRenames = // only accessible to the LibCloud.Config.allowedDarkInternalCanvasID canvas let internalFn (f : BuiltInFnSig) : BuiltInFnSig = - (fun (state, typeArgs, args) -> + (fun (exeState, vmState, typeArgs, args) -> uply { - if state.program.internalFnsAllowed then - return! f (state, typeArgs, args) + if exeState.program.internalFnsAllowed then + return! f (exeState, vmState, typeArgs, args) else return Exception.raiseInternal "internal function attempted to be used in another canvas" - [ "canavasId", state.program.canvasID ] + [ "canavasId", exeState.program.canvasID ] }) let builtins : Builtins = let builtins = Builtin.combine - [ Libs.Canvases.builtins - Libs.DBs.builtins - Libs.Domains.builtins - Libs.F404.builtins - Libs.Infra.builtins - Libs.Secrets.builtins - Libs.Users.builtins - Libs.Workers.builtins ] + [ + // Libs.Canvases.builtins + // Libs.DBs.builtins + // Libs.Domains.builtins + // Libs.F404.builtins + // Libs.Infra.builtins + // Libs.Secrets.builtins + // Libs.Users.builtins + // Libs.Workers.builtins + ] fnRenames { builtins with diff --git a/backend/src/BuiltinDarkInternal/BuiltinDarkInternal.fsproj b/backend/src/BuiltinDarkInternal/BuiltinDarkInternal.fsproj index b573e5cd76..7a6fd4fd50 100644 --- a/backend/src/BuiltinDarkInternal/BuiltinDarkInternal.fsproj +++ b/backend/src/BuiltinDarkInternal/BuiltinDarkInternal.fsproj @@ -17,14 +17,14 @@ - - - - - - - - + + + + + + + + diff --git a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs index f897ce444a..77a5dfe6c1 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs @@ -8,7 +8,7 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module Canvas = LibCloud.Canvas @@ -24,7 +24,7 @@ let fns : List = description = "Get a list of all canvas IDs" fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> uply { let! hosts = Canvas.allCanvasIDs () return DList(VT.uuid, List.map DUuid hosts) diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 808a723143..86b663a6cc 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -18,16 +18,16 @@ - + + - - + + - + - From 2d17efb303de48a30500faf70461e05ed5dd9577 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 11:13:26 -0400 Subject: [PATCH 39/60] make test faster --- backend/tests/Tests/Interpreter.Tests.fs | 2 +- backend/tests/Tests/TestValues.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 1f3c2cb6a0..9a4422e3ad 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -560,7 +560,7 @@ module Fns = module Recusrsion = let addUpTo = - t "Test.addUpTo 300000" E.Fns.Package.Recursion.applied (RT.DInt64 300000L) + t "Test.addUpTo 30000" E.Fns.Package.Recursion.applied (RT.DInt64 30000L) let tests = testList "Recursion" [ addUpTo ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 053aa73099..72335c1c60 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -441,7 +441,7 @@ module Expressions = module Recursion = let id = System.Guid.Parse "02036aff-7ae5-4e7c-8f95-f42936044542" let unapplied = ePackageFn id - let applied = eApply unapplied [] [ eInt64 300000 ] + let applied = eApply unapplied [] [ eInt64 30000 ] module PT2RT = LibExecution.ProgramTypesToRuntimeTypes From c210b5b66c5856eef2fc3239aee44181a4a8ca5c Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 11:54:18 -0400 Subject: [PATCH 40/60] uncommented LibPackageManager --- backend/fsdark.sln | 14 ++--- backend/src/BuiltinCloudExecution/Builtin.fs | 7 ++- backend/src/BuiltinDarkInternal/Builtin.fs | 18 +++--- .../ExternalTypesToProgramTypes.fs | 47 ++++------------ .../LibPackageManager/JsonDeserialization.fs | 55 +++++-------------- backend/src/LibPackageManager/SimpleJson.fs | 27 +++++++++ backend/src/LibPackageManager/Types.fs | 28 ++++------ backend/tests/Tests/Tests.fsproj | 4 +- 8 files changed, 86 insertions(+), 114 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index 361a08f5f0..cfd0c8d0b6 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -63,8 +63,8 @@ EndProject #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibPackageManager", "src\LibPackageManager\LibPackageManager.fsproj", "{A74049E0-AD31-407B-9918-6A6A76C945C9}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibPackageManager", "src\LibPackageManager\LibPackageManager.fsproj", "{A74049E0-AD31-407B-9918-6A6A76C945C9}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCliHost", "src\BuiltinCliHost\BuiltinCliHost.fsproj", "{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}" #EndProject @@ -177,10 +177,10 @@ Global {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.Build.0 = Release|Any CPU - #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.Build.0 = Release|Any CPU + {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A74049E0-AD31-407B-9918-6A6A76C945C9}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A74049E0-AD31-407B-9918-6A6A76C945C9}.Release|Any CPU.Build.0 = Release|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -212,7 +212,7 @@ Global #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {DB61305F-4CA9-4D92-82A5-503495F515E8} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} {839A1EF7-18F5-491E-B40B-2BAA57378B40} = {3820D9E8-1B4E-486E-9C46-D52E3784D222} diff --git a/backend/src/BuiltinCloudExecution/Builtin.fs b/backend/src/BuiltinCloudExecution/Builtin.fs index ec6b0b94f9..c31a7f0c1a 100644 --- a/backend/src/BuiltinCloudExecution/Builtin.fs +++ b/backend/src/BuiltinCloudExecution/Builtin.fs @@ -13,6 +13,7 @@ let fnRenames : Builtin.FnRenames = let builtins = Builtin.combine [ - //Libs.DB.builtins; - //Libs.Event.builtins - ] fnRenames + //Libs.DB.builtins; + //Libs.Event.builtins + ] + fnRenames diff --git a/backend/src/BuiltinDarkInternal/Builtin.fs b/backend/src/BuiltinDarkInternal/Builtin.fs index 64bcc3bd87..0e708f4549 100644 --- a/backend/src/BuiltinDarkInternal/Builtin.fs +++ b/backend/src/BuiltinDarkInternal/Builtin.fs @@ -34,15 +34,15 @@ let builtins : Builtins = let builtins = Builtin.combine [ - // Libs.Canvases.builtins - // Libs.DBs.builtins - // Libs.Domains.builtins - // Libs.F404.builtins - // Libs.Infra.builtins - // Libs.Secrets.builtins - // Libs.Users.builtins - // Libs.Workers.builtins - ] + // Libs.Canvases.builtins + // Libs.DBs.builtins + // Libs.Domains.builtins + // Libs.F404.builtins + // Libs.Infra.builtins + // Libs.Secrets.builtins + // Libs.Users.builtins + // Libs.Workers.builtins + ] fnRenames { builtins with diff --git a/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs b/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs index d72ef2aacf..29fb639d6b 100644 --- a/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs +++ b/backend/src/LibPackageManager/ExternalTypesToProgramTypes.fs @@ -16,43 +16,18 @@ open Types module EPT = ProgramTypes module NameResolutionError = - module NameType = - let toPT - (nameType : NameResolutionError.NameType) - : LibExecution.NameResolutionError.NameType = - match nameType with - | NameResolutionError.Type -> LibExecution.NameResolutionError.Type - | NameResolutionError.Function -> LibExecution.NameResolutionError.Function - | NameResolutionError.Constant -> LibExecution.NameResolutionError.Constant - - module ErrorType = - let toPT - (err : NameResolutionError.ErrorType) - : LibExecution.NameResolutionError.ErrorType = - match err with - | NameResolutionError.ErrorType.NotFound names -> - LibExecution.NameResolutionError.NotFound names - | NameResolutionError.MissingEnumModuleName caseName -> - LibExecution.NameResolutionError.MissingEnumModuleName caseName - | NameResolutionError.InvalidPackageName names -> - LibExecution.NameResolutionError.InvalidPackageName names - | NameResolutionError.ExpectedEnumButNot packageTypeID -> - LibExecution.NameResolutionError.ExpectedEnumButNot packageTypeID - | NameResolutionError.ExpectedRecordButNot packageTypeID -> - LibExecution.NameResolutionError.ExpectedRecordButNot packageTypeID - - module Error = - let toPT - (err : NameResolutionError.Error) - : LibExecution.NameResolutionError.Error = - { errorType = ErrorType.toPT err.errorType - nameType = NameType.toPT err.nameType } + let toPT (err : NameResolutionError) : PT.NameResolutionError = + match err with + | NotFound names -> PT.NameResolutionError.NotFound names + | InvalidName names -> PT.NameResolutionError.InvalidName names + + module NameResolution = let toPT (f : 's -> 'p) (result : EPT.NameResolution<'s>) : PT.NameResolution<'p> = match result with | Ok name -> Ok(f name) - | Error err -> Error(NameResolutionError.Error.toPT err) + | Error err -> Error(NameResolutionError.toPT err) module Sign = @@ -138,7 +113,7 @@ module TypeReference = | EPT.TTuple(firstType, secondType, otherTypes) -> PT.TTuple(toPT firstType, toPT secondType, List.map toPT otherTypes) | EPT.TDict typ -> PT.TDict(toPT typ) - | EPT.TDB typ -> PT.TDB(toPT typ) + //| EPT.TDB typ -> PT.TDB(toPT typ) | EPT.TDateTime -> PT.TDateTime | EPT.TChar -> PT.TChar | EPT.TUuid -> PT.TUuid @@ -234,10 +209,11 @@ module Expr = | EPT.EList(id, exprs) -> PT.EList(id, List.map toPT exprs) | EPT.ETuple(id, first, second, theRest) -> PT.ETuple(id, toPT first, toPT second, List.map toPT theRest) - | EPT.ERecord(id, typeName, fields) -> + | EPT.ERecord(id, typeName, typeArgs, fields) -> PT.ERecord( id, NameResolution.toPT TypeName.toPT typeName, + List.map TypeReference.toPT typeArgs, List.map (Tuple2.mapSecond toPT) fields ) | EPT.ERecordUpdate(id, record, updates) -> @@ -248,10 +224,11 @@ module Expr = ) | EPT.EPipe(pipeID, expr1, rest) -> PT.EPipe(pipeID, toPT expr1, List.map pipeExprToPT rest) - | EPT.EEnum(id, typeName, caseName, exprs) -> + | EPT.EEnum(id, typeName, typeArgs, caseName, exprs) -> PT.EEnum( id, NameResolution.toPT TypeName.toPT typeName, + List.map TypeReference.toPT typeArgs, caseName, List.map toPT exprs ) diff --git a/backend/src/LibPackageManager/JsonDeserialization.fs b/backend/src/LibPackageManager/JsonDeserialization.fs index b1cbfce43b..5d7ab767cd 100644 --- a/backend/src/LibPackageManager/JsonDeserialization.fs +++ b/backend/src/LibPackageManager/JsonDeserialization.fs @@ -21,41 +21,12 @@ module Sign = module NameResolutionError = - module ErrorType = - type DU = NameResolutionError.ErrorType - - let decoder : JsonDecoder = - [ ("NotFound", Decoders.enum1Field (Decoders.list Decoders.string) DU.NotFound) - ("ExpectedEnumButNot", - Decoders.enum1Field Decoders.uuid DU.ExpectedEnumButNot) - ("ExpectedRecordButNot", - Decoders.enum1Field Decoders.uuid DU.ExpectedRecordButNot) - ("MissingEnumModuleName", - Decoders.enum1Field Decoders.string DU.MissingEnumModuleName) - ("InvalidPackageName", - Decoders.enum1Field (Decoders.list Decoders.string) DU.InvalidPackageName) ] - |> Map.ofList - |> Decoders.du - - - module NameType = - type DU = NameResolutionError.NameType - - let decoder : JsonDecoder = - [ ("Type", Decoders.enum0Fields DU.Type) - ("Constant", Decoders.enum0Fields DU.Constant) - ("Function", Decoders.enum0Fields DU.Function) ] - |> Map.ofList - |> Decoders.du - + let decoder : JsonDecoder = + [ ("NotFound", Decoders.enum1Field (Decoders.list Decoders.string) NotFound) + ("InvalidName", Decoders.enum1Field (Decoders.list Decoders.string) InvalidName) ] + |> Map.ofList + |> Decoders.du - module Error = - let decoder : JsonDecoder = - Decoders.obj2Fields - "NameResolution" - ("errorType", ErrorType.decoder) - ("nameType", NameType.decoder) - (fun errType nameType -> { errorType = errType; nameType = nameType }) module ProgramTypes = @@ -64,7 +35,7 @@ module ProgramTypes = (inner : JsonDecoder<'TInner>) : JsonDecoder> = [ ("Ok", Decoders.enum1Field inner Ok) - ("Error", Decoders.enum1Field NameResolutionError.Error.decoder Error) ] + ("Error", Decoders.enum1Field NameResolutionError.decoder Error) ] |> Map.ofList |> Decoders.du @@ -160,7 +131,7 @@ module ProgramTypes = (NameResolution.decoder FQTypeName.FQTypeName.decoder) (Decoders.list (fun ctx -> decoder ctx)) (fun name typeArgs -> DU.TCustomType(name, typeArgs))) - ("TDB", Decoders.enum1Field (fun ctx -> decoder ctx) DU.TDB) + //("TDB", Decoders.enum1Field (fun ctx -> decoder ctx) DU.TDB) ("TFn", Decoders.enum2Fields (Decoders.list (fun ctx -> decoder ctx)) @@ -455,19 +426,21 @@ module ProgramTypes = (Decoders.list (fun ctx -> decoder ctx)) (fun id first second rest -> DU.ETuple(id, first, second, rest))) ("ERecord", - Decoders.enum3Fields + Decoders.enum4Fields ID.decoder (NameResolution.decoder FQTypeName.FQTypeName.decoder) + (Decoders.list TypeReference.decoder) (Decoders.list (Decoders.pair Decoders.string (fun ctx -> decoder ctx))) - (fun id name fields -> DU.ERecord(id, name, fields))) + (fun id name typeArgs fields -> DU.ERecord(id, name, typeArgs, fields))) ("EEnum", - Decoders.enum4Fields + Decoders.enum5Fields ID.decoder (NameResolution.decoder FQTypeName.FQTypeName.decoder) + (Decoders.list TypeReference.decoder) Decoders.string (Decoders.list (fun ctx -> decoder ctx)) - (fun id typeName caseName fields -> - DU.EEnum(id, typeName, caseName, fields))) + (fun id typeName typeArgs caseName fields -> + DU.EEnum(id, typeName, typeArgs, caseName, fields))) ("ELet", Decoders.enum4Fields ID.decoder diff --git a/backend/src/LibPackageManager/SimpleJson.fs b/backend/src/LibPackageManager/SimpleJson.fs index e2ea0bac6f..a834453b3c 100644 --- a/backend/src/LibPackageManager/SimpleJson.fs +++ b/backend/src/LibPackageManager/SimpleJson.fs @@ -283,6 +283,33 @@ module Decoders = | _, _, _, Error err -> Error err | _ -> Error(ctx, "Expected four fields") + let enum5Fields + (d1 : JsonDecoder<'T1>) + (d2 : JsonDecoder<'T2>) + (d3 : JsonDecoder<'T3>) + (d4 : JsonDecoder<'T4>) + (d5 : JsonDecoder<'T5>) + (ctor : 'T1 -> 'T2 -> 'T3 -> 'T4 -> 'T5 -> 'T) + (fields : List) + : JsonDecoder<'T> = + fun ctx -> + match fields with + | [ f1; f2; f3; f4; f5 ] -> + match + d1 (ctx.Index 1 f1), + d2 (ctx.Index 2 f2), + d3 (ctx.Index 3 f3), + d4 (ctx.Index 4 f4), + d5 (ctx.Index 5 f5) + with + | Ok f1, Ok f2, Ok f3, Ok f4, Ok f5 -> Ok(ctor f1 f2 f3 f4 f5) + | Error err, _, _, _, _ + | _, Error err, _, _, _ + | _, _, Error err, _, _ + | _, _, _, Error err, _ + | _, _, _, _, Error err -> Error err + | _ -> Error(ctx, "Expected four fields") + let du (cases : Map -> JsonDecoder<'T>>) : JsonDecoder<'T> = fun ctx -> diff --git a/backend/src/LibPackageManager/Types.fs b/backend/src/LibPackageManager/Types.fs index cb9eda4937..5db90bb82c 100644 --- a/backend/src/LibPackageManager/Types.fs +++ b/backend/src/LibPackageManager/Types.fs @@ -17,24 +17,13 @@ type Sign = | Negative -module NameResolutionError = - type ErrorType = - | NotFound of names : List - | ExpectedEnumButNot of packageTypeID : uuid - | ExpectedRecordButNot of packageTypeID : uuid - | MissingEnumModuleName of caseName : string - | InvalidPackageName of names : List - - type NameType = - | Function - | Type - | Constant - - type Error = { errorType : ErrorType; nameType : NameType } +type NameResolutionError = + | NotFound of names : List + | InvalidName of names : List module ProgramTypes = - type NameResolution<'a> = Result<'a, NameResolutionError.Error> + type NameResolution<'a> = Result<'a, NameResolutionError> module FQTypeName = type Package = uuid @@ -84,7 +73,7 @@ module ProgramTypes = | TCustomType of NameResolution * typeArgs : List - | TDB of TypeReference + //| TDB of TypeReference | TFn of NEList * TypeReference type LetPattern = @@ -179,10 +168,15 @@ module ProgramTypes = | EList of ID * List | EDict of ID * List | ETuple of ID * Expr * Expr * List - | ERecord of ID * NameResolution * List + | ERecord of + ID * + NameResolution * + List * + List | EEnum of ID * typeName : NameResolution * + List * caseName : string * fields : List diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 86b663a6cc..3eca156419 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -18,7 +18,7 @@ - + @@ -46,11 +46,11 @@ + - From cecacd1e30edd5d5e0f07f1b314d2b2d6773db5d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 11:55:40 -0400 Subject: [PATCH 41/60] PM Tests running --- backend/tests/Tests/Tests.fs | 2 +- backend/tests/Tests/Tests.fsproj | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 189e797e4e..9fdb226897 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -43,7 +43,7 @@ let main (args : string array) : int = // Tests.Execution.tests Tests.Builtin.tests // Tests.DvalRepr.tests -- maybe this gets deleted TODO - // Tests.PackageManager.tests + Tests.PackageManager.tests //Tests.LibParser.tests // Tests.NewParser.tests // Tests.HttpClient.tests diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 3eca156419..c735bb26d3 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -46,7 +46,7 @@ - + From b5e66227928130f3ddb6ad624eb555de8919e636 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 12:34:56 -0400 Subject: [PATCH 42/60] some LibParser tests are uncommented and working --- backend/src/LibCloud/LibCloud.fsproj | 4 +- backend/src/LibExecution/ProgramTypes.fs | 8 +- backend/tests/TestUtils/TestUtils.fs | 957 +++++++++++++---------- backend/tests/Tests/LibParser.Tests.fs | 48 +- backend/tests/Tests/Tests.fs | 2 +- backend/tests/Tests/Tests.fsproj | 2 +- 6 files changed, 571 insertions(+), 450 deletions(-) diff --git a/backend/src/LibCloud/LibCloud.fsproj b/backend/src/LibCloud/LibCloud.fsproj index 948afea83e..ddf2be86a9 100644 --- a/backend/src/LibCloud/LibCloud.fsproj +++ b/backend/src/LibCloud/LibCloud.fsproj @@ -14,7 +14,7 @@ - + @@ -31,7 +31,7 @@ - + diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 9e7a3766b5..02277c84d8 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -155,6 +155,12 @@ module LetPattern = rest |> List.map symbolsUsed |> Set.unionMany ] | LPUnit _ -> Set.empty + let toID (pattern : LetPattern) : id = + match pattern with + | LPVariable(id, _) + | LPTuple(id, _, _, _) + | LPUnit id -> id + /// Used for pattern matching in a match statement type MatchPattern = @@ -278,7 +284,7 @@ type Expr = // Allow the user to have arbitrarily big numbers, even if they don't make sense as // floats. The float is split as we want to preserve what the user entered. // Strings are used as numbers lose the leading zeros (eg 7.00007) - | EFloat of id * Sign * string * string + | EFloat of id * Sign * whole: string * part: string /// A character is an Extended Grapheme Cluster (hence why we use a string). This /// is equivalent to one screen-visible "character" in Unicode. diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index ec9a57e087..14e4d2c28b 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -399,46 +399,10 @@ module Expect = let path = path @ [ "value" ] |> List.reverse |> String.concat "." $" `{path}` of" - // let rec letPatternEqualityBaseFn - // (checkIDs : bool) - // (path : Path) - // (actual : LetPattern) - // (expected : LetPattern) - // (errorFn : Path -> string -> string -> unit) - // : unit = - // let check path (a : 'a) (e : 'a) = - // if a <> e then errorFn path (string actual) (string expected) - // if checkIDs then check path (LetPattern.toID actual) (LetPattern.toID expected) - // match actual, expected with - // | LPVariable(_, name), LPVariable(_, name') -> check path name name' - // | LPUnit(_), LPUnit(_) -> () - // | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> - // let all = first :: second :: theRest - // let all' = first' :: second' :: theRest' - // let zipped = List.zip all all' - // List.iter - // (fun (a, e) -> - // letPatternEqualityBaseFn checkIDs (path @ [ "tuple" ]) a e errorFn) - // zipped - - // // exhaustive match - // | LPVariable _, _ - // | LPUnit _, _ - // | LPTuple _, _ -> errorFn path (string actual) (string expected) - - - let rec userTypeNameEqualityBaseFn - (path : Path) - (actual : FQTypeName.FQTypeName) - (expected : FQTypeName.FQTypeName) - (errorFn : Path -> string -> string -> unit) - : unit = - let err () = errorFn path (string actual) (string expected) - - match actual, expected with - | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () + + // let rec matchPatternEqualityBaseFn // (checkIDs : bool) @@ -507,391 +471,546 @@ module Expect = // | MPListCons _, _ // | MPList _, _ -> check path actual expected + let formatMsg (initialMsg : string) (path : Path) (actual : 'a) : string = + let initial = if initialMsg = "" then "" else $"{initialMsg}\n\n" + $"{initial}Error was found in{pathToString path}:\nError was:\n{actual})\n\n" + module RT = + // CLEANUP remove if unused + let dTypeEqualityBaseFn + (path : Path) + (actual : TypeReference) + (expected : TypeReference) + (errorFn : Path -> string -> string -> unit) + : unit = + // as long as TypeReferences don't get IDs, depending on structural equality is OK + if actual <> expected then errorFn path (string actual) (string expected) + + let rec typeNameEqualityBaseFn + (path : Path) + (actual : FQTypeName.FQTypeName) + (expected : FQTypeName.FQTypeName) + (errorFn : Path -> string -> string -> unit) + : unit = + let err () = errorFn path (string actual) (string expected) + + match actual, expected with + | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () + + // If the dvals are not the same, call errorFn. This is in this form to allow + // both an equality function and a test expectation function + let rec dvalEqualityBaseFn + (path : Path) + (actual : Dval) + (expected : Dval) + (errorFn : Path -> string -> string -> unit) + : unit = + let de p a e = dvalEqualityBaseFn p a e errorFn + let error path = errorFn path (string actual) (string expected) + + let check (path : Path) (a : 'a) (e : 'a) : unit = + if a <> e then errorFn path (debugDval actual) (debugDval expected) + + let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = + match VT.merge a e with + | Ok _merged -> () + | Error() -> errorFn path (debugDval actual) (debugDval expected) + + match actual, expected with + | DFloat l, DFloat r -> + if System.Double.IsNaN l && System.Double.IsNaN r then + // This isn't "true" equality, it's just for tests + () + else if + System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r + then + () + else if + System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r + then + () + else if + System.Double.IsNaN l + || System.Double.IsNaN r + || System.Double.IsPositiveInfinity l + || System.Double.IsPositiveInfinity r + || System.Double.IsNegativeInfinity l + || System.Double.IsNegativeInfinity r + then + error path + else if not (Accuracy.areClose Accuracy.veryHigh l r) then + error path + + | DDateTime l, DDateTime r -> + // Two dates can be the same millisecond and not be equal if they don't + // have the same number of ticks. For testing, we shall consider them + // equal if they print the same string. + check path (string l) (string r) + + | DList(lType, ls), DList(rType, rs) -> + checkValueType ("Type" :: path) lType rType + + check ("Length" :: path) (List.length ls) (List.length rs) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs + + | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> + de path firstL firstR + + de path secondL secondR + + check ("Length" :: path) (List.length theRestL) (List.length theRestR) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR + + | DDict(lType, ls), DDict(rType, rs) -> + check ("Length" :: path) (Map.count ls) (Map.count rs) + + checkValueType ("Type" :: path) lType rType + + // check keys from ls are in both, check matching values + Map.iterWithIndex + (fun key v1 -> + match Map.find key rs with + | Some v2 -> de (key :: path) v1 v2 + | None -> check (key :: path) ls rs) + ls + + // check keys from rs are in both + Map.iterWithIndex + (fun key _ -> + match Map.find key rs with + | Some _ -> () // already checked + | None -> check (key :: path) ls rs) + rs + + + | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> + // check type name + typeNameEqualityBaseFn path ltn rtn errorFn + + // check type args + check + ("TypeArgsLength" :: path) + (List.length ltypeArgs) + (List.length rtypeArgs) + List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs + + check ("Length" :: path) (Map.count ls) (Map.count rs) + + // check keys + // -- keys from ls are in both, check matching values + Map.iterWithIndex + (fun key v1 -> + match Map.find key rs with + | Some v2 -> de (key :: path) v1 v2 + | None -> check (key :: path) ls rs) + ls + + // -- keys from rs are in both + Map.iterWithIndex + (fun key _ -> + match Map.find key rs with + | Some _ -> () // already checked + | None -> check (key :: path) ls rs) + rs + + + | DEnum(_, typeName, typeArgs, caseName, fields), + DEnum(_, typeName', typeArgs', caseName', fields') -> + typeNameEqualityBaseFn path typeName typeName' errorFn + check ("caseName" :: path) caseName caseName' + + check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') + List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' + + check ("fields.Length" :: path) (List.length fields) (List.length fields) + List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' + () - let dTypeEqualityBaseFn - (path : Path) - (actual : TypeReference) - (expected : TypeReference) - (errorFn : Path -> string -> string -> unit) - : unit = - // as long as TypeReferences don't get IDs, depending on structural equality is OK - if actual <> expected then errorFn path (string actual) (string expected) - - - - // let rec exprEqualityBaseFn - // (checkIDs : bool) - // (path : Path) - // (actual : Expr) - // (expected : Expr) - // (errorFn : Path -> string -> string -> unit) - // : unit = - // let eq path a e = exprEqualityBaseFn checkIDs path a e errorFn - - // let check path (a : 'a) (e : 'a) = - // if a <> e then errorFn path (string actual) (string expected) - - // let eqList path (l1 : List) (l2 : List) = - // List.iteri2 (fun i -> eq (string i :: path)) l1 l2 - // check path (List.length l1) (List.length l2) + // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> + // NEList.iter2 + // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) + // l1.parameters + // l2.parameters + // check ("symbtable" :: path) l1.symtable l2.symtable // TODO: use dvalEquality + // exprEqualityBaseFn false path l1.body l2.body errorFn + + | DString _, DString _ -> check path (debugDval actual) (debugDval expected) + + // Keep for exhaustiveness checking + | DUnit, _ + | DBool _, _ + | DInt8 _, _ + | DUInt8 _, _ + | DInt16 _, _ + | DUInt16 _, _ + | DInt32 _, _ + | DUInt32 _, _ + | DInt64 _, _ + | DUInt64 _, _ + | DInt128 _, _ + | DUInt128 _, _ + | DFloat _, _ + | DChar _, _ + | DString _, _ + | DDateTime _, _ + | DUuid _, _ + | DList _, _ + | DTuple _, _ + | DDict _, _ + | DRecord _, _ + | DEnum _, _ + | DApplicable _, _ + // | DDB _, _ + -> check path actual expected + + + let dvalEquality (left : Dval) (right : Dval) : bool = + let mutable success = true + dvalEqualityBaseFn [] left right (fun _ _ _ -> success <- false) + success + + let rec equalDval (actual : Dval) (expected : Dval) (msg : string) : unit = + dvalEqualityBaseFn [] actual expected (fun path a e -> + Expect.equal a e (formatMsg msg path actual)) + + module PT = + open LibExecution.ProgramTypes + + let dTypeEqualityBaseFn + (path : Path) + (actual : TypeReference) + (expected : TypeReference) + (errorFn : Path -> string -> string -> unit) + : unit = + // as long as TypeReferences don't get IDs, depending on structural equality is OK + if actual <> expected then errorFn path (string actual) (string expected) + + let typeNameEqualityBaseFn + (path : Path) + (actual : FQTypeName.FQTypeName) + (expected : FQTypeName.FQTypeName) + (errorFn : Path -> string -> string -> unit) + : unit = + let err () = errorFn path (string actual) (string expected) + + match actual, expected with + | FQTypeName.Package a, FQTypeName.Package e -> if a <> e then err () + + + // let nameResolutionEqualityBaseFn<'a> + // (path : Path) + // (actual : NameResolution<'a>) + // (expected : NameResolution<'a>) + // (fn: ) + // (errorFn : Path -> string -> string -> unit) + // : unit = + // let err () = errorFn path (string actual) (string expected) + + // match actual, expected with + // | NRNotFound, NRNotFound -> () + // | NRName a, NRName e -> if a <> e then err () + // | NRType a, NRType e -> if a <> e then err () + + + let rec letPatternEqualityBaseFn + (checkIDs : bool) + (path : Path) + (actual : LetPattern) + (expected : LetPattern) + (errorFn : Path -> string -> string -> unit) + : unit = + let check path (a : 'a) (e : 'a) = + if a <> e then errorFn path (string actual) (string expected) + + if checkIDs then check path (LetPattern.toID actual) (LetPattern.toID expected) + + match actual, expected with + | LPVariable(_, name), LPVariable(_, name') -> check path name name' + | LPUnit(_), LPUnit(_) -> () + | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> + let all = first :: second :: theRest + let all' = first' :: second' :: theRest' + let zipped = List.zip all all' + List.iter + (fun (a, e) -> + letPatternEqualityBaseFn checkIDs (path @ [ "tuple" ]) a e errorFn) + zipped + + // exhaustive match + | LPVariable _, _ + | LPUnit _, _ + | LPTuple _, _ -> errorFn path (string actual) (string expected) + + + + let rec pipeExprEqualityBaseFn + (checkIDs : bool) + (path : Path) + (actual : PipeExpr) + (expected : PipeExpr) + (errorFn : Path -> string -> string -> unit) + : unit = + let check path (a : 'a) (e : 'a) = + if a <> e then errorFn path (string actual) (string expected) + + match actual, expected with + | EPipeLambda(_, pats, body), EPipeLambda(_, pats', body') -> + NEList.iteri2 + (fun i l r -> letPatternEqualityBaseFn checkIDs (string i :: path) l r errorFn) + pats + pats' + exprEqualityBaseFn checkIDs ("body" :: path) body body' errorFn + + | EPipeInfix(_, op, e), EPipeInfix(_, op', e') -> + check path op op' + exprEqualityBaseFn checkIDs ("expr" :: path) e e' errorFn + + | EPipeFnCall(_, name, typeArgs, args), EPipeFnCall(_, name', typeArgs', args') -> + let path = (string name :: path) + check path name name' + check path (List.length typeArgs) (List.length typeArgs') + List.iteri2 + (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) + typeArgs + typeArgs' + List.iteri2 + (fun i l r -> exprEqualityBaseFn checkIDs (string i :: path) l r errorFn) + args + args' + + // | EPipeEnum(_, typeName, caseName, fields), EPipeEnum(_, typeName', caseName', fields') -> + // typeNameEqualityBaseFn path typeName typeName' errorFn + // check path caseName caseName' + // List.iteri2 + // (fun i l r -> exprEqualityBaseFn checkIDs (string i :: path) l r errorFn) + // fields + // fields' + + | EPipeVariable(_, varContainingPipeable, args), EPipeVariable(_, varContainingPipeable', args') -> + check path varContainingPipeable varContainingPipeable' + List.iteri2 + (fun i l r -> exprEqualityBaseFn checkIDs (string i :: path) l r errorFn) + args + args' + + // exhaustive match + | EPipeLambda _, _ + | EPipeInfix _, _ + | EPipeFnCall _, _ + | EPipeEnum _, _ + | EPipeVariable _, _ -> errorFn path (string actual) (string expected) + + + and exprEqualityBaseFn + (checkIDs : bool) + (path : Path) + (actual : Expr) + (expected : Expr) + (errorFn : Path -> string -> string -> unit) + : unit = + let eq path a e = exprEqualityBaseFn checkIDs path a e errorFn + + let check path (a : 'a) (e : 'a) = + if a <> e then errorFn path (string actual) (string expected) + + let eqList path (l1 : List) (l2 : List) = + List.iteri2 (fun i -> eq (string i :: path)) l1 l2 + check path (List.length l1) (List.length l2) + + let eqNEList path (l1 : NEList) (l2 : NEList) = + NEList.iteri2 (fun i -> eq (string i :: path)) l1 l2 + check path (NEList.length l1) (NEList.length l2) + + if checkIDs then check path (PT.Expr.toID actual) (PT.Expr.toID expected) + + match actual, expected with + // expressions with no values + | EUnit _, EUnit _ -> () + + + // Simple exprs + | EBool(_, v), EBool(_, v') -> check path v v' + + | EInt8(_, v), EInt8(_, v') -> check path v v' + | EUInt8(_, v), EUInt8(_, v') -> check path v v' + | EInt16(_, v), EInt16(_, v') -> check path v v' + | EUInt16(_, v), EUInt16(_, v') -> check path v v' + | EInt32(_, v), EInt32(_, v') -> check path v v' + | EUInt32(_, v), EUInt32(_, v') -> check path v v' + | EInt64(_, v), EInt64(_, v') -> check path v v' + | EUInt64(_, v), EUInt64(_, v') -> check path v v' + | EInt128(_, v), EInt128(_, v') -> check path v v' + | EUInt128(_, v), EUInt128(_, v') -> check path v v' + + | EFloat(_, sign, whole, part), EFloat(_, sign', whole', part') -> + check path sign sign' + check path whole whole' + check path part part' + + | EInfix(_, op, l, r), EInfix(_, op', l', r') -> + check path op op' + eq ("lhs" :: path) l l' + eq ("rhs" :: path) r r' + + // expressions with single string values + | EString(_, s), EString(_, s') -> + let rec checkSegment s s' = + match s, s' with + | StringText s, StringText s' -> check path s s' + | StringInterpolation e, StringInterpolation e' -> eq path e e' + | _ -> check path s s' + List.iter2 checkSegment s s' + + | EChar(_, v), EChar(_, v') + | EVariable(_, v), EVariable(_, v') -> check path v v' + | EConstant(_, name), EConstant(_, name') -> check path name name' + | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> + letPatternEqualityBaseFn checkIDs path pat pat' errorFn + eq ("rhs" :: path) rhs rhs' + eq ("body" :: path) body body' + | EIf(_, con, thn, els), EIf(_, con', thn', els') -> + eq ("cond" :: path) con con' + eq ("then" :: path) thn thn' + match els, els' with + | Some el, Some el' -> eq ("else" :: path) el el' + | None, None -> () + | _ -> + errorFn ("else" :: path) (string actual) (string expected) + () + + | EList(_, l), EList(_, l') -> eqList path l l' + | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> + eq ("first" :: path) first first' + eq ("second" :: path) second second' + eqList path theRest theRest' + + | EApply(_, name, typeArgs, args), EApply(_, name', typeArgs', args') -> + let path = (string name :: path) + eq path name name' + check path (List.length typeArgs) (List.length typeArgs') + List.iteri2 + (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) + typeArgs + typeArgs' + eqNEList path args args' + + | EFnName(_, name), EFnName(_, name') -> check path name name' + + // | ERecord(_, typeName, typeArgs, fields), ERecord(_, typeName', typeArgs', fields') -> + // typeNameEqualityBaseFn path typeName typeName' errorFn + // List.iteri2 + // (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) + // typeArgs + // typeArgs' + // NEList.iter2 + // (fun (k, v) (k', v') -> + // check path k k' + // eq (k :: path) v v') + // fields + // fields' + + | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> + check path record record' + NEList.iter2 + (fun (k, v) (k', v') -> + check path k k' + eq (k :: path) v v') + updates + updates' + | EDict(_, fields), EDict(_, fields') -> + List.iter2 + (fun (k, v) (k', v') -> + check ("key" :: path) k k' + eq ("value" :: path) v v') + fields + fields' + + | ERecordFieldAccess(_, e, f), ERecordFieldAccess(_, e', f') -> + eq (f :: path) e e' + check path f f' + + // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> + // typeNameEqualityBaseFn path typeName typeName' errorFn + // check path caseName caseName' + // eqList path fields fields' + // () + + | ELambda(_, pats, e), ELambda(_, pats', e') -> + let path = ("lambda" :: path) + eq path e e' + NEList.iter2 + (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) + pats + pats' + + // | EMatch(_, e, branches), EMatch(_, e', branches') -> + // eq ("matchCond" :: path) e e' + + // check path (NEList.length branches) (NEList.length branches') + // NEList.iteri2 + // (fun i branch branch' -> + // let path = $"Case {i} - {branch.pat}" :: path + // matchPatternEqualityBaseFn + // checkIDs + // ("pat" :: path) + // branch.pat + // branch'.pat + // errorFn + // match branch.whenCondition, branch'.whenCondition with + // | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' + // | None, None -> () + // | _ -> + // errorFn ("whenCondition" :: path) (string actual) (string expected) + // () + // eq ("rhs" :: path) branch.rhs branch'.rhs) + // branches + // branches' + + // exhaustiveness check + | EUnit _, _ + | EInt8 _, _ + | EUInt8 _, _ + | EInt16 _, _ + | EUInt16 _, _ + | EInt32 _, _ + | EUInt32 _, _ + | EInt64 _, _ + | EUInt64 _, _ + | EInt128 _, _ + | EUInt128 _, _ + | EString _, _ + | EChar _, _ + | EVariable _, _ + | EConstant _, _ + | EBool _, _ + | EFloat _, _ + | ELet _, _ + | EIf _, _ + | EList _, _ + | ETuple _, _ + | EApply _, _ + | EFnName _, _ + | ERecord _, _ + | ERecordUpdate _, _ + | EDict _, _ + | ERecordFieldAccess _, _ + | EEnum _, _ + | ELambda _, _ + | EInfix _, _ + | EPipe _, _ // TODO: make case above + | EMatch _, _ -> check path actual expected + + + let rec equalExprIgnoringIDs (actual : Expr) (expected : Expr) : unit = + exprEqualityBaseFn false [] actual expected (fun path a e -> + Expect.equal a e (formatMsg "" path actual)) - // let eqNEList path (l1 : NEList) (l2 : NEList) = - // NEList.iteri2 (fun i -> eq (string i :: path)) l1 l2 - // check path (NEList.length l1) (NEList.length l2) - // if checkIDs then check path (Expr.toID actual) (Expr.toID expected) - // match actual, expected with - // // expressions with no values - // | EUnit _, EUnit _ -> () - - - // // Simple exprs - // | EBool(_, v), EBool(_, v') -> check path v v' - - // // | EInt8(_, v), EInt8(_, v') -> check path v v' - // // | EUInt8(_, v), EUInt8(_, v') -> check path v v' - // // | EInt16(_, v), EInt16(_, v') -> check path v v' - // // | EUInt16(_, v), EUInt16(_, v') -> check path v v' - // // | EInt32(_, v), EInt32(_, v') -> check path v v' - // // | EUInt32(_, v), EUInt32(_, v') -> check path v v' - // | EInt64(_, v), EInt64(_, v') -> check path v v' - // // | EUInt64(_, v), EUInt64(_, v') -> check path v v' - // // | EInt128(_, v), EInt128(_, v') -> check path v v' - // // | EUInt128(_, v), EUInt128(_, v') -> check path v v' - - // // | EFloat(_, v), EFloat(_, v') -> check path v v' - - // // expressions with single string values - // | EString(_, s), EString(_, s') -> - // let rec checkSegment s s' = - // match s, s' with - // | StringText s, StringText s' -> check path s s' - // | StringInterpolation e, StringInterpolation e' -> eq path e e' - // | _ -> check path s s' - // List.iter2 checkSegment s s' - - // // | EChar(_, v), EChar(_, v') - // // | EVariable(_, v), EVariable(_, v') -> check path v v' - // // | EConstant(_, name), EConstant(_, name') -> check path name name' - // // | ELet(_, pat, rhs, body), ELet(_, pat', rhs', body') -> - // // letPatternEqualityBaseFn checkIDs path pat pat' errorFn - // // eq ("rhs" :: path) rhs rhs' - // // eq ("body" :: path) body body' - // // | EIf(_, con, thn, els), EIf(_, con', thn', els') -> - // // eq ("cond" :: path) con con' - // // eq ("then" :: path) thn thn' - // // match els, els' with - // // | Some el, Some el' -> eq ("else" :: path) el el' - // // | None, None -> () - // // | _ -> - // // errorFn ("else" :: path) (string actual) (string expected) - // // () - - // // | EList(_, l), EList(_, l') -> eqList path l l' - // // | ETuple(_, first, second, theRest), ETuple(_, first', second', theRest') -> - // // eq ("first" :: path) first first' - // // eq ("second" :: path) second second' - // // eqList path theRest theRest' - - // | EApply(_, name, typeArgs, args), EApply(_, name', typeArgs', args') -> - // let path = (string name :: path) - // eq path name name' - - // check path (List.length typeArgs) (List.length typeArgs') - // List.iteri2 - // (fun i l r -> dTypeEqualityBaseFn (string i :: path) l r errorFn) - // typeArgs - // typeArgs' - - // eqNEList path args args' - - // | EFnName(_, name), EFnName(_, name') -> check path name name' - - // // | ERecord(_, typeName, fields), ERecord(_, typeName', fields') -> - // // userTypeNameEqualityBaseFn path typeName typeName' errorFn - // // NEList.iter2 - // // (fun (k, v) (k', v') -> - // // check path k k' - // // eq (k :: path) v v') - // // fields - // // fields' - // // | ERecordUpdate(_, record, updates), ERecordUpdate(_, record', updates') -> - // // check path record record' - // // NEList.iter2 - // // (fun (k, v) (k', v') -> - // // check path k k' - // // eq (k :: path) v v') - // // updates - // // updates' - // // | EDict(_, fields), EDict(_, fields') -> - // // List.iter2 - // // (fun (k, v) (k', v') -> - // // check ("key" :: path) k k' - // // eq ("value" :: path) v v') - // // fields - // // fields' - - // // | ERecordFieldAccess(_, e, f), ERecordFieldAccess(_, e', f') -> - // // eq (f :: path) e e' - // // check path f f' - - // // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> - // // userTypeNameEqualityBaseFn path typeName typeName' errorFn - // // check path caseName caseName' - // // eqList path fields fields' - // // () - - // // | ELambda(_, pats, e), ELambda(_, pats', e') -> - // // let path = ("lambda" :: path) - // // eq path e e' - // // NEList.iter2 - // // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) - // // pats - // // pats' - // // | EMatch(_, e, branches), EMatch(_, e', branches') -> - // // eq ("matchCond" :: path) e e' - - // // check path (NEList.length branches) (NEList.length branches') - // // NEList.iteri2 - // // (fun i branch branch' -> - // // let path = $"Case {i} - {branch.pat}" :: path - // // matchPatternEqualityBaseFn - // // checkIDs - // // ("pat" :: path) - // // branch.pat - // // branch'.pat - // // errorFn - // // match branch.whenCondition, branch'.whenCondition with - // // | Some cond, Some cond' -> eq ("whenCondition" :: path) cond cond' - // // | None, None -> () - // // | _ -> - // // errorFn ("whenCondition" :: path) (string actual) (string expected) - // // () - // // eq ("rhs" :: path) branch.rhs branch'.rhs) - // // branches - // // branches' - // // | EAnd(_, l, r), EAnd(_, l', r') -> - // // eq ("left" :: path) l l' - // // eq ("right" :: path) r r' - // // | EOr(_, l, r), EOr(_, l', r') -> - // // eq ("left" :: path) l l' - // // eq ("right" :: path) r r' - // | EError(_, msg, exprs), EError(_, msg', exprs') -> - // check path msg msg' - // eqList path exprs exprs' - // // exhaustiveness check - // | EUnit _, _ - // // | EInt8 _, _ - // // | EUInt8 _, _ - // // | EInt16 _, _ - // // | EUInt16 _, _ - // // | EInt32 _, _ - // // | EUInt32 _, _ - // | EInt64 _, _ - // // | EUInt64 _, _ - // // | EInt128 _, _ - // // | EUInt128 _, _ - // | EString _, _ - // // | EChar _, _ - // // | EVariable _, _ - // // | EConstant _, _ - // | EBool _, _ - // // | EFloat _, _ - // // | ELet _, _ - // // | EIf _, _ - // // | EList _, _ - // // | ETuple _, _ - // | EApply _, _ - // | EFnName _, _ - // // | ERecord _, _ - // // | ERecordUpdate _, _ - // // | EDict _, _ - // // | ERecordFieldAccess _, _ - // // | EEnum _, _ - // // | ELambda _, _ - // // | EMatch _, _ - // // | EAnd _, _ - // // | EOr _, _ - // | EError _, _ -> check path actual expected - - - - // If the dvals are not the same, call errorFn. This is in this form to allow - // both an equality function and a test expectation function - let rec dvalEqualityBaseFn - (path : Path) - (actual : Dval) - (expected : Dval) - (errorFn : Path -> string -> string -> unit) - : unit = - let de p a e = dvalEqualityBaseFn p a e errorFn - let error path = errorFn path (string actual) (string expected) - - let check (path : Path) (a : 'a) (e : 'a) : unit = - if a <> e then errorFn path (debugDval actual) (debugDval expected) - - let checkValueType (path : Path) (a : ValueType) (e : ValueType) : unit = - match VT.merge a e with - | Ok _merged -> () - | Error() -> errorFn path (debugDval actual) (debugDval expected) - - match actual, expected with - | DFloat l, DFloat r -> - if System.Double.IsNaN l && System.Double.IsNaN r then - // This isn't "true" equality, it's just for tests - () - else if - System.Double.IsPositiveInfinity l && System.Double.IsPositiveInfinity r - then - () - else if - System.Double.IsNegativeInfinity l && System.Double.IsNegativeInfinity r - then - () - else if - System.Double.IsNaN l - || System.Double.IsNaN r - || System.Double.IsPositiveInfinity l - || System.Double.IsPositiveInfinity r - || System.Double.IsNegativeInfinity l - || System.Double.IsNegativeInfinity r - then - error path - else if not (Accuracy.areClose Accuracy.veryHigh l r) then - error path - - | DDateTime l, DDateTime r -> - // Two dates can be the same millisecond and not be equal if they don't - // have the same number of ticks. For testing, we shall consider them - // equal if they print the same string. - check path (string l) (string r) - - | DList(lType, ls), DList(rType, rs) -> - checkValueType ("Type" :: path) lType rType - - check ("Length" :: path) (List.length ls) (List.length rs) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) ls rs - - | DTuple(firstL, secondL, theRestL), DTuple(firstR, secondR, theRestR) -> - de path firstL firstR - - de path secondL secondR - - check ("Length" :: path) (List.length theRestL) (List.length theRestR) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) theRestL theRestR - - | DDict(lType, ls), DDict(rType, rs) -> - check ("Length" :: path) (Map.count ls) (Map.count rs) - - checkValueType ("Type" :: path) lType rType - - // check keys from ls are in both, check matching values - Map.iterWithIndex - (fun key v1 -> - match Map.find key rs with - | Some v2 -> de (key :: path) v1 v2 - | None -> check (key :: path) ls rs) - ls - - // check keys from rs are in both - Map.iterWithIndex - (fun key _ -> - match Map.find key rs with - | Some _ -> () // already checked - | None -> check (key :: path) ls rs) - rs - - - | DRecord(ltn, _, ltypeArgs, ls), DRecord(rtn, _, rtypeArgs, rs) -> - // check type name - userTypeNameEqualityBaseFn path ltn rtn errorFn - - // check type args - check - ("TypeArgsLength" :: path) - (List.length ltypeArgs) - (List.length rtypeArgs) - List.iteri2 (fun i -> checkValueType (string i :: path)) ltypeArgs rtypeArgs - - check ("Length" :: path) (Map.count ls) (Map.count rs) - - // check keys - // -- keys from ls are in both, check matching values - Map.iterWithIndex - (fun key v1 -> - match Map.find key rs with - | Some v2 -> de (key :: path) v1 v2 - | None -> check (key :: path) ls rs) - ls - - // -- keys from rs are in both - Map.iterWithIndex - (fun key _ -> - match Map.find key rs with - | Some _ -> () // already checked - | None -> check (key :: path) ls rs) - rs - - - | DEnum(_, typeName, typeArgs, caseName, fields), - DEnum(_, typeName', typeArgs', caseName', fields') -> - userTypeNameEqualityBaseFn path typeName typeName' errorFn - check ("caseName" :: path) caseName caseName' - - check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') - List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' - - check ("fields.Length" :: path) (List.length fields) (List.length fields) - List.iteri2 (fun i -> de ($"[{i}]" :: path)) fields fields' - () - - // | DFnVal(Lambda l1), DFnVal(Lambda l2) -> - // NEList.iter2 - // (fun pat pat' -> letPatternEqualityBaseFn false path pat pat' errorFn) - // l1.parameters - // l2.parameters - // check ("symbtable" :: path) l1.symtable l2.symtable // TODO: use dvalEquality - // exprEqualityBaseFn false path l1.body l2.body errorFn - - | DString _, DString _ -> check path (debugDval actual) (debugDval expected) - // Keep for exhaustiveness checking - | DUnit, _ - | DBool _, _ - | DInt8 _, _ - | DUInt8 _, _ - | DInt16 _, _ - | DUInt16 _, _ - | DInt32 _, _ - | DUInt32 _, _ - | DInt64 _, _ - | DUInt64 _, _ - | DInt128 _, _ - | DUInt128 _, _ - | DFloat _, _ - | DChar _, _ - | DString _, _ - | DDateTime _, _ - | DUuid _, _ - | DList _, _ - | DTuple _, _ - | DDict _, _ - | DRecord _, _ - | DEnum _, _ - | DApplicable _, _ - // | DDB _, _ - -> check path actual expected - let formatMsg (initialMsg : string) (path : Path) (actual : 'a) : string = - let initial = if initialMsg = "" then "" else $"{initialMsg}\n\n" - $"{initial}Error was found in{pathToString path}:\nError was:\n{actual})\n\n" - let rec equalDval (actual : Dval) (expected : Dval) (msg : string) : unit = - dvalEqualityBaseFn [] actual expected (fun path a e -> - Expect.equal a e (formatMsg msg path actual)) // let rec equalMatchPattern // (actual : MatchPattern) @@ -912,14 +1031,10 @@ module Expect = // exprEqualityBaseFn true [] actual expected (fun path a e -> // Expect.equal a e (formatMsg msg path actual)) - // let rec equalExprIgnoringIDs (actual : Expr) (expected : Expr) : unit = - // exprEqualityBaseFn false [] actual expected (fun path a e -> - // Expect.equal a e (formatMsg "" path actual)) - let dvalEquality (left : Dval) (right : Dval) : bool = - let mutable success = true - dvalEqualityBaseFn [] left right (fun _ _ _ -> success <- false) - success + + + let visitDval (f : Dval -> 'a) (dv : Dval) : List<'a> = let mutable state = [] diff --git a/backend/tests/Tests/LibParser.Tests.fs b/backend/tests/Tests/LibParser.Tests.fs index af3a3342e3..6dba1ee5c0 100644 --- a/backend/tests/Tests/LibParser.Tests.fs +++ b/backend/tests/Tests/LibParser.Tests.fs @@ -21,15 +21,14 @@ let exprRTs = let t name testStr expectedExpr = testTask name { let! actual = - LibParser.Parser.parseRTExpr + LibParser.Parser.parsePTExpr (localBuiltIns pmPT) pmPT NR.OnMissing.Allow "libparser.tests.fs" testStr |> Ply.toTask - let expectedExpr = PT2RT.Expr.toRT expectedExpr - return Expect.equalExprIgnoringIDs actual expectedExpr + return Expect.PT.equalExprIgnoringIDs actual expectedExpr } @@ -103,27 +102,28 @@ let exprRTs = PT.EInt64(id, 8L) )) - // Now let's test some more complex expressions - // CLEANUP the reference to Stdlib.List.map only exists - // in PackageIDs to support this test. Fix that. - t - "pipe without expr" - "(let x = 5L\nx |> PACKAGE.Darklang.Stdlib.List.map 5L)" - (PT.ELet( - id, - PT.LPVariable(id, "x"), - PT.EInt64(id, 5L), - PT.EPipe( - id, - PT.EVariable(id, "x"), - [ PT.EPipeFnCall( - id, - Ok(PT.FQFnName.fqPackage PackageIDs.Fn.Stdlib.List.map), - [], - [ PT.EInt64(id, 5L) ] - ) ] - ) - )) ] + // // Now let's test some more complex expressions + // // CLEANUP the reference to Stdlib.List.map only exists + // // in PackageIDs to support this test. Fix that. + // t + // "pipe without expr" + // "(let x = 5L\nx |> PACKAGE.Darklang.Stdlib.List.map 5L)" + // (PT.ELet( + // id, + // PT.LPVariable(id, "x"), + // PT.EInt64(id, 5L), + // PT.EPipe( + // id, + // PT.EVariable(id, "x"), + // [ PT.EPipeFnCall( + // id, + // Ok(PT.FQFnName.fqPackage PackageIDs.Fn.Stdlib.List.map), + // [], + // [ PT.EInt64(id, 5L) ] + // ) ] + // ) + // )) + ] let tests = testList "LibParser" [ exprRTs ] diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 9fdb226897..4bf04f62a7 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -44,7 +44,7 @@ let main (args : string array) : int = Tests.Builtin.tests // Tests.DvalRepr.tests -- maybe this gets deleted TODO Tests.PackageManager.tests - //Tests.LibParser.tests + Tests.LibParser.tests // Tests.NewParser.tests // Tests.HttpClient.tests diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index c735bb26d3..1ad1b76451 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -47,7 +47,7 @@ - + From ab7f303f8181e67b8a86c3bdc655cd8ae23a08fe Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Wed, 18 Sep 2024 15:56:09 -0400 Subject: [PATCH 43/60] localexec uncommented; many packages being loaded again --- backend/fsdark.sln | 14 +- backend/src/BuiltinCli/Libs/Directory.fs | 10 +- backend/src/BuiltinCli/Libs/Environment.fs | 6 +- backend/src/BuiltinCli/Libs/Execution.fs | 17 +- backend/src/BuiltinCli/Libs/File.fs | 18 +- .../BuiltinCli/Libs/LanguageServerProtocol.fs | 2 +- backend/src/BuiltinCli/Libs/Output.fs | 4 +- backend/src/BuiltinCli/Libs/Stdin.fs | 2 +- backend/src/BuiltinCli/Libs/Time.fs | 2 +- backend/src/BuiltinCliHost/Libs/Cli.fs | 610 +++++++++--------- backend/src/BuiltinCliHost/Utils.fs | 2 +- backend/src/BuiltinExecution/Builtin.fs | 2 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 108 ++-- backend/src/LibExecution/PackageIDs.fs | 4 +- backend/src/LibExecution/RuntimeTypes.fs | 13 +- backend/src/LibParser/FSharpToWrittenTypes.fs | 40 +- backend/src/LibParser/WrittenTypes.fs | 2 +- .../LibParser/WrittenTypesToProgramTypes.fs | 4 +- backend/src/LocalExec/LoadPackagesFromDisk.fs | 1 + backend/src/LocalExec/LocalExec.fs | 22 +- backend/src/LocalExec/LocalExec.fsproj | 6 +- backend/tests/Tests/DvalRepr.Tests.fs | 2 +- packages/darklang/{cli => _cli}/cli.dark | 0 .../{cli => _cli}/local-install/README.md | 0 .../{cli => _cli}/local-install/config.dark | 0 .../{cli => _cli}/local-install/install.dark | 0 .../{cli => _cli}/local-install/main.dark | 0 .../local-install/uninstall.dark | 0 ...dark-packages.dark => _dark-packages.dark} | 0 .../darklang/{github.dark => _github.dark} | 0 .../{internal.dark => _internal.dark} | 0 .../{json-rpc.dark => _json-rpc.dark} | 0 .../README.md | 0 .../common.dark | 0 .../documentSync/README.md | 0 .../documentSync/common.dark | 0 .../documentSync/notebook.dark | 0 .../documentSync/textDocument.dark | 0 .../io.dark | 0 .../language/callHierarchy.dark | 0 .../language/codeAction.dark | 0 .../language/codeLens.dark | 0 .../language/colorProvider.dark | 0 .../language/completion.dark | 0 .../language/diagnostics.dark | 0 .../language/documentHighlight.dark | 0 .../language/documentSymbols.dark | 0 .../language/findReferences.dark | 0 .../language/foldingRange.dark | 0 .../language/formatting.dark | 0 .../language/getDocumentLinks.dark | 0 .../language/goToDeclaration.dark | 0 .../language/goToDefinition.dark | 0 .../language/goToImplementation.dark | 0 .../language/handleRename.dark | 0 .../language/inlayHint.dark | 0 .../language/inlineCompletion.dark | 0 .../language/inlineValue.dark | 0 .../language/linkedEditingRange.dark | 0 .../language/monikor.dark | 0 .../language/onHover.dark | 0 .../language/selectionRange.dark | 0 .../language/semanticToken.dark | 0 .../language/signatureHelp.dark | 0 .../language/typeDefinition.dark | 0 .../language/typeHierarchy.dark | 0 .../lifecycle/capabilityRegistration.dark | 0 .../lifecycle/exit.dark | 0 .../lifecycle/initialize.dark | 0 .../lifecycle/initialized.dark | 0 .../lifecycle/shutdown.dark | 0 .../tracing.dark | 0 .../window/logMessage.dark | 0 .../window/showDocument.dark | 0 .../window/showMessage.dark | 0 .../window/showMessageRequest.dark | 0 .../window/telemetry.dark | 0 .../workInProgress.dark | 0 .../workspace/configuration.dark | 0 .../workspace/executeCommand.dark | 0 .../workspace/fileOperations.dark | 0 .../workspace/onDidChangeWatchedFiles.dark | 0 .../workspace/workspaceEdit.dark | 0 .../workspace/workspaceFolder.dark | 0 .../workspace/workspaceSymbols.dark | 0 .../darklang/{openai.dark => _openai.dark} | 0 .../canvas.dark | 0 .../cliScript.dark | 0 .../common.dark | 0 .../moduleDeclaration.dark | 0 .../packages.dark | 0 .../programTypes.dark | 0 .../runtimeTypes.dark | 0 .../aaaa_state.dark | 0 .../completions.dark | 0 .../diagnostics.dark | 0 .../{lsp-server => _lsp-server}/docSync.dark | 0 .../handleIncomingMessage.dark | 0 .../initialize.dark | 0 .../{lsp-server => _lsp-server}/logging.dark | 0 .../lsp-server.dark | 0 .../semanticTokens.dark | 0 .../languageTools/{lsp.dark => _lsp.dark} | 0 .../{nameResolver.dark => _nameResolver.dark} | 0 ...ckageManager.dark => _packageManager.dark} | 0 .../{parser => _parser}/canvas.dark | 0 .../{parser => _parser}/cliScript.dark | 0 .../constantDeclaration.dark | 0 .../{parser => _parser}/core.dark | 0 .../{parser => _parser}/expr.dark | 0 .../functionDeclaration.dark | 0 .../{parser => _parser}/identifiers.dark | 0 .../{parser => _parser}/matchPattern.dark | 0 .../moduleDeclaration.dark | 0 .../{parser => _parser}/parserTest.dark | 0 .../{parser => _parser}/pipeExpr.dark | 0 .../{parser => _parser}/sourceFile.dark | 0 .../{parser => _parser}/typeDeclaration.dark | 0 .../{parser => _parser}/typeReference.dark | 0 .../cli.dark | 0 .../execution.dark | 0 .../int.dark | 0 .../json.dark | 0 .../nameResolution.dark | 0 .../runtimeErrors.dark | 0 .../typeChecker.dark | 0 ...manticTokens.dark => _semanticTokens.dark} | 0 .../{writtenTypes.dark => _writtenTypes.dark} | 0 ....dark => _writtenTypesToProgramTypes.dark} | 0 .../darklang/languageTools/programTypes.dark | 6 +- .../darklang/languageTools/runtimeTypes.dark | 419 ++++++------ .../stdlib/{canvas.dark => _canvas.dark} | 0 .../darklang/stdlib/{cli => _cli}/bash.dark | 0 .../darklang/stdlib/{cli => _cli}/curl.dark | 0 .../stdlib/{cli => _cli}/execution.dark | 0 .../darklang/stdlib/{cli => _cli}/gunzip.dark | 0 .../darklang/stdlib/{cli => _cli}/host.dark | 0 .../darklang/stdlib/{cli => _cli}/unix.dark | 0 .../darklang/stdlib/{cli => _cli}/zsh.dark | 0 .../darklang/stdlib/{db.dark => _db.dark} | 0 .../darklang/test/{test.dark => _test.dark} | 0 packages/internal/{tests.dark => _tests.dark} | 0 packages/stachu/{json.dark => _json.dark} | 0 .../stachu/{timespan.dark => _timespan.dark} | 0 scripts/build/reload-packages | 30 +- 145 files changed, 681 insertions(+), 665 deletions(-) rename packages/darklang/{cli => _cli}/cli.dark (100%) rename packages/darklang/{cli => _cli}/local-install/README.md (100%) rename packages/darklang/{cli => _cli}/local-install/config.dark (100%) rename packages/darklang/{cli => _cli}/local-install/install.dark (100%) rename packages/darklang/{cli => _cli}/local-install/main.dark (100%) rename packages/darklang/{cli => _cli}/local-install/uninstall.dark (100%) rename packages/darklang/{dark-packages.dark => _dark-packages.dark} (100%) rename packages/darklang/{github.dark => _github.dark} (100%) rename packages/darklang/{internal.dark => _internal.dark} (100%) rename packages/darklang/{json-rpc.dark => _json-rpc.dark} (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/README.md (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/common.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/documentSync/README.md (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/documentSync/common.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/documentSync/notebook.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/documentSync/textDocument.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/io.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/callHierarchy.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/codeAction.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/codeLens.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/colorProvider.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/completion.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/diagnostics.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/documentHighlight.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/documentSymbols.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/findReferences.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/foldingRange.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/formatting.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/getDocumentLinks.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/goToDeclaration.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/goToDefinition.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/goToImplementation.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/handleRename.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/inlayHint.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/inlineCompletion.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/inlineValue.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/linkedEditingRange.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/monikor.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/onHover.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/selectionRange.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/semanticToken.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/signatureHelp.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/typeDefinition.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/language/typeHierarchy.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/lifecycle/capabilityRegistration.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/lifecycle/exit.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/lifecycle/initialize.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/lifecycle/initialized.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/lifecycle/shutdown.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/tracing.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/window/logMessage.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/window/showDocument.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/window/showMessage.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/window/showMessageRequest.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/window/telemetry.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workInProgress.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/configuration.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/executeCommand.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/fileOperations.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/onDidChangeWatchedFiles.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/workspaceEdit.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/workspaceFolder.dark (100%) rename packages/darklang/{languageServerProtocol => _languageServerProtocol}/workspace/workspaceSymbols.dark (100%) rename packages/darklang/{openai.dark => _openai.dark} (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/canvas.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/cliScript.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/common.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/moduleDeclaration.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/packages.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/programTypes.dark (100%) rename packages/darklang/{prettyPrinter => _prettyPrinter}/runtimeTypes.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/aaaa_state.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/completions.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/diagnostics.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/docSync.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/handleIncomingMessage.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/initialize.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/logging.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/lsp-server.dark (100%) rename packages/darklang/languageTools/{lsp-server => _lsp-server}/semanticTokens.dark (100%) rename packages/darklang/languageTools/{lsp.dark => _lsp.dark} (100%) rename packages/darklang/languageTools/{nameResolver.dark => _nameResolver.dark} (100%) rename packages/darklang/languageTools/{packageManager.dark => _packageManager.dark} (100%) rename packages/darklang/languageTools/{parser => _parser}/canvas.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/cliScript.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/constantDeclaration.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/core.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/expr.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/functionDeclaration.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/identifiers.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/matchPattern.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/moduleDeclaration.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/parserTest.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/pipeExpr.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/sourceFile.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/typeDeclaration.dark (100%) rename packages/darklang/languageTools/{parser => _parser}/typeReference.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/cli.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/execution.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/int.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/json.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/nameResolution.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/runtimeErrors.dark (100%) rename packages/darklang/languageTools/{runtimeErrors => _runtimeErrors}/typeChecker.dark (100%) rename packages/darklang/languageTools/{semanticTokens.dark => _semanticTokens.dark} (100%) rename packages/darklang/languageTools/{writtenTypes.dark => _writtenTypes.dark} (100%) rename packages/darklang/languageTools/{writtenTypesToProgramTypes.dark => _writtenTypesToProgramTypes.dark} (100%) rename packages/darklang/stdlib/{canvas.dark => _canvas.dark} (100%) rename packages/darklang/stdlib/{cli => _cli}/bash.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/curl.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/execution.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/gunzip.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/host.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/unix.dark (100%) rename packages/darklang/stdlib/{cli => _cli}/zsh.dark (100%) rename packages/darklang/stdlib/{db.dark => _db.dark} (100%) rename packages/darklang/test/{test.dark => _test.dark} (100%) rename packages/internal/{tests.dark => _tests.dark} (100%) rename packages/stachu/{json.dark => _json.dark} (100%) rename packages/stachu/{timespan.dark => _timespan.dark} (100%) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index cfd0c8d0b6..b6a3fb0272 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -75,8 +75,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Tests", "tests\Tests\Tests. EndProject # local dev -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LocalExec", "src\LocalExec\LocalExec.fsproj", "{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LocalExec", "src\LocalExec\LocalExec.fsproj", "{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -165,10 +165,10 @@ Global #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.Build.0 = Debug|Any CPU #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.ActiveCfg = Release|Any CPU #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.Build.0 = Release|Any CPU - #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.Build.0 = Release|Any CPU + {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.Build.0 = Release|Any CPU #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -209,7 +209,7 @@ Global {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/BuiltinCli/Libs/Directory.fs b/backend/src/BuiltinCli/Libs/Directory.fs index d52af3efd3..7b8507ff29 100644 --- a/backend/src/BuiltinCli/Libs/Directory.fs +++ b/backend/src/BuiltinCli/Libs/Directory.fs @@ -6,7 +6,7 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts @@ -20,7 +20,7 @@ let fns : List = description = "Returns the current working directory" fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> uply { let contents = System.IO.Directory.GetCurrentDirectory() return DString contents @@ -41,7 +41,7 @@ let fns : List = let resultOk r = Dval.resultOk KTUnit KTString r |> Ply let resultError r = Dval.resultError KTUnit KTString r |> Ply (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> try System.IO.Directory.CreateDirectory(path) |> ignore @@ -64,7 +64,7 @@ let fns : List = let resultOk r = Dval.resultOk KTUnit KTString r |> Ply let resultError r = Dval.resultError KTUnit KTString r |> Ply (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> try System.IO.Directory.Delete(path, false) resultOk DUnit @@ -83,7 +83,7 @@ let fns : List = description = "Returns the directory at " fn = (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { // TODO make async let contents = diff --git a/backend/src/BuiltinCli/Libs/Environment.fs b/backend/src/BuiltinCli/Libs/Environment.fs index 4dd72fb1a2..77b42b60b9 100644 --- a/backend/src/BuiltinCli/Libs/Environment.fs +++ b/backend/src/BuiltinCli/Libs/Environment.fs @@ -7,7 +7,7 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes -module VT = ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts @@ -22,7 +22,7 @@ let fns : List = "Gets the value of the environment variable with the given if it exists." fn = (function - | _, _, [ DString varName ] -> + | _, _, _, [ DString varName ] -> let envValue = System.Environment.GetEnvironmentVariable(varName) if isNull envValue then @@ -43,7 +43,7 @@ let fns : List = "Returns a list of tuples containing all the environment variables and their values." fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> let envVars = System.Environment.GetEnvironmentVariables() let envMap = diff --git a/backend/src/BuiltinCli/Libs/Execution.fs b/backend/src/BuiltinCli/Libs/Execution.fs index 42e89efba2..641c0ec8a1 100644 --- a/backend/src/BuiltinCli/Libs/Execution.fs +++ b/backend/src/BuiltinCli/Libs/Execution.fs @@ -26,7 +26,7 @@ let fns : List = returnType = TCustomType(Ok executionOutcomeTypeName, []) fn = (function - | _, _, [ DString command ] -> + | _, _, _, [ DString command ] -> let command = command.Replace( "$HOME", @@ -37,14 +37,15 @@ let fns : List = if RuntimeInformation.IsOSPlatform OSPlatform.Windows then "cmd.exe", $"/c {command}" // TODO: run in whatever the default shell is -- not just bash. - else if - RuntimeInformation.IsOSPlatform OSPlatform.Linux - || RuntimeInformation.IsOSPlatform OSPlatform.OSX - then - "/bin/bash", $"-c \"{command}\"" else - "Executing CLI commands is not supported for your operating system (Linux, Windows, or Mac not detected)" - |> raiseUntargetedString + // if + // RuntimeInformation.IsOSPlatform OSPlatform.Linux + // || RuntimeInformation.IsOSPlatform OSPlatform.OSX + //then + "/bin/bash", $"-c \"{command}\"" + // else + // "Executing CLI commands is not supported for your operating system (Linux, Windows, or Mac not detected)" + // |> raiseUntargetedString let psi = System.Diagnostics.ProcessStartInfo( diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index c92ed0bf6e..68c1c7235d 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -22,7 +22,7 @@ let fns : List = let resultOk = Dval.resultOk (KTList(ValueType.Known KTUInt8)) KTString let resultError = Dval.resultError (KTList(ValueType.Known KTUInt8)) KTString (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try let path = @@ -53,7 +53,7 @@ let fns : List = let resultOk = Dval.resultOk KTUnit KTString let resultError = Dval.resultError KTUnit KTString (function - | _, _, [ DList(_, contents); DString path ] -> + | _, _, _, [ DList(_, contents); DString path ] -> uply { try let path = @@ -84,7 +84,7 @@ let fns : List = description = "Deletes the file specified by " fn = (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try System.IO.File.Delete path @@ -112,7 +112,7 @@ let fns : List = let resultOk = Dval.resultOk KTUnit KTString let resultError = Dval.resultError KTUnit KTString (function - | _, _, [ DString path; DString content ] -> + | _, _, _, [ DString path; DString content ] -> uply { try do! System.IO.File.AppendAllTextAsync(path, content) @@ -136,7 +136,7 @@ let fns : List = let resultOk r = Dval.resultOk KTString KTString r |> Ply let resultError r = Dval.resultError KTString KTString r |> Ply (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> try let tempPath = System.IO.Path.GetTempFileName() resultOk (DString tempPath) @@ -156,7 +156,7 @@ let fns : List = "Returns true if the file specified by is a directory, or false if it is a file or does not exist" fn = (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try let attrs = System.IO.File.GetAttributes(path) @@ -179,7 +179,7 @@ let fns : List = "Returns true if the file specified by is a normal file (not a directory), or false if it is a directory or does not exist" fn = (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try let attrs = System.IO.File.GetAttributes(path) @@ -204,7 +204,7 @@ let fns : List = "Returns true if a file or directory exists at the specified , or false otherwise" fn = (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try let exists = @@ -229,7 +229,7 @@ let fns : List = let resultOk r = Dval.resultOk KTInt64 KTString r |> Ply let resultError r = Dval.resultError KTInt64 KTString r |> Ply (function - | _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> try let fileInfo = System.IO.FileInfo(path) resultOk (DInt64 fileInfo.Length) diff --git a/backend/src/BuiltinCli/Libs/LanguageServerProtocol.fs b/backend/src/BuiltinCli/Libs/LanguageServerProtocol.fs index da7c228e49..8948269d8a 100644 --- a/backend/src/BuiltinCli/Libs/LanguageServerProtocol.fs +++ b/backend/src/BuiltinCli/Libs/LanguageServerProtocol.fs @@ -20,7 +20,7 @@ let fns : List = description = "Reads a single incoming request from an LSP client, over stdin." fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> let tryReadHeader (input : StreamReader) = let mutable contentLength = None let mutable complete = false diff --git a/backend/src/BuiltinCli/Libs/Output.fs b/backend/src/BuiltinCli/Libs/Output.fs index a6f8ebcc37..687d2c93d0 100644 --- a/backend/src/BuiltinCli/Libs/Output.fs +++ b/backend/src/BuiltinCli/Libs/Output.fs @@ -20,7 +20,7 @@ let fns : List = "Prints the given to the standard output, followed by a newline." fn = (function - | _, _, [ DString str ] -> + | _, _, _, [ DString str ] -> print str Ply DUnit | _ -> incorrectArgs ()) @@ -36,7 +36,7 @@ let fns : List = description = "Prints the given to the standard output." fn = (function - | _, _, [ DString str ] -> + | _, _, _, [ DString str ] -> printInline str Ply DUnit | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinCli/Libs/Stdin.fs b/backend/src/BuiltinCli/Libs/Stdin.fs index bf6e194f55..7768f7083f 100644 --- a/backend/src/BuiltinCli/Libs/Stdin.fs +++ b/backend/src/BuiltinCli/Libs/Stdin.fs @@ -15,7 +15,7 @@ let fns : List = description = "Reads a single line from the standard input." fn = (function - | _, _, [ DUnit ] -> + | _, _, _, [ DUnit ] -> let input = System.Console.ReadLine() Ply(DString input) | _ -> incorrectArgs ()) diff --git a/backend/src/BuiltinCli/Libs/Time.fs b/backend/src/BuiltinCli/Libs/Time.fs index 31f013724f..6d3bf20a80 100644 --- a/backend/src/BuiltinCli/Libs/Time.fs +++ b/backend/src/BuiltinCli/Libs/Time.fs @@ -18,7 +18,7 @@ let fns : List = description = "Sleeps for the given milliseconds." fn = (function - | _, _, [ DFloat delay ] -> + | _, _, _, [ DFloat delay ] -> uply { let delay = System.TimeSpan.FromMilliseconds delay do! Task.Delay(delay) diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index b35a985633..80c1137dda 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -10,7 +10,7 @@ open LibExecution.Builtin.Shortcuts module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module RT2DT = LibExecution.RuntimeTypesToDarkTypes @@ -60,8 +60,8 @@ module CliRuntimeError = DEnum(typeName, typeName, [], caseName, fields) - let toRuntimeError (e : Error) : RT.RuntimeError = - Error.toDT e |> RT.RuntimeError.fromDT + // let toRuntimeError (e : Error) : RT.RuntimeError = + // Error.toDT e |> RT.RuntimeError.fromDT @@ -85,66 +85,68 @@ let builtinsToUse : RT.Builtins = [] -let execute - (parentState : RT.ExecutionState) - (mod' : Utils.CliScript.PTCliScriptModule) - (symtable : Map) - : Ply * RuntimeError>> = - uply { - let (program : Program) = - { canvasID = System.Guid.NewGuid() - internalFnsAllowed = false - secrets = [] - dbs = Map.empty } - - let types = - List.concat - [ mod'.types |> List.map PT2RT.PackageType.toRT - mod'.submodules.types |> List.map PT2RT.PackageType.toRT ] - - let constants = - List.concat - [ mod'.constants |> List.map PT2RT.PackageConstant.toRT - mod'.submodules.constants |> List.map PT2RT.PackageConstant.toRT ] - - let fns = - List.concat - [ mod'.fns |> List.map PT2RT.PackageFn.toRT - mod'.submodules.fns |> List.map PT2RT.PackageFn.toRT ] - - let packageManager = - PackageManager.withExtras packageManagerRT types constants fns - - let tracing = Exe.noTracing (CallStack.fromEntryPoint Script) - - let state = - Exe.createState - builtinsToUse - packageManager - tracing - parentState.reportException - parentState.notify - program - - if mod'.exprs.Length = 0 then - let rte = - CliRuntimeError.NoExpressionsToExecute |> CliRuntimeError.RTE.toRuntimeError - return Error((None, rte)) - else // mod'.exprs.Length > 1 - let exprs = List.map PT2RT.Expr.toRT mod'.exprs - let results = List.map (Exe.executeExpr state symtable) exprs - match List.tryLast results with - | Some lastResult -> return! lastResult - | None -> - let rte = - CliRuntimeError.NoExpressionsToExecute - |> CliRuntimeError.RTE.toRuntimeError - return Error((None, rte)) - } +// let execute +// (parentState : RT.ExecutionState) +// (mod' : Utils.CliScript.PTCliScriptModule) +// (symtable : Map) +// : Ply> = +// uply { +// let (program : Program) = +// { canvasID = System.Guid.NewGuid() +// internalFnsAllowed = false +// //secrets = [] +// //dbs = Map.empty +// } + +// let types = +// List.concat +// [ mod'.types |> List.map PT2RT.PackageType.toRT +// mod'.submodules.types |> List.map PT2RT.PackageType.toRT ] + +// let constants = +// List.concat +// [ mod'.constants |> List.map PT2RT.PackageConstant.toRT +// mod'.submodules.constants |> List.map PT2RT.PackageConstant.toRT ] + +// let fns = +// List.concat +// [ mod'.fns |> List.map PT2RT.PackageFn.toRT +// mod'.submodules.fns |> List.map PT2RT.PackageFn.toRT ] + +// let packageManager = +// packageManagerRT |> PackageManager.withExtras types constants fns + +// let tracing = Exe.noTracing // (CallStack.fromEntryPoint Script) + +// let state = +// Exe.createState +// builtinsToUse +// packageManager +// tracing +// parentState.reportException +// parentState.notify +// program + +// if mod'.exprs.Length = 0 then +// let rte = +// CliRuntimeError.NoExpressionsToExecute |> CliRuntimeError.RTE.toRuntimeError +// return Error((None, rte)) +// else // mod'.exprs.Length > 1 +// let exprs = List.map PT2RT.Expr.toRT mod'.exprs +// let results = List.map (Exe.executeExpr state symtable) exprs +// match List.tryLast results with +// | Some lastResult -> return! lastResult +// | None -> +// let rte = +// CliRuntimeError.NoExpressionsToExecute +// |> CliRuntimeError.RTE.toRuntimeError +// return Error( rte) +// } let fns : List = - [ { name = fn "cliParseAndExecuteScript" 0 + [ + { name = fn "cliParseAndExecuteScript" 0 typeParams = [] parameters = [ Param.make "filename" TString "" @@ -154,95 +156,96 @@ let fns : List = description = "Parses Dark code as a script, and and executes it, returning an exit code" fn = - let errType = KTCustomType(ExecutionError.fqTypeName, []) - let resultOk = Dval.resultOk KTInt64 errType - let resultError = Dval.resultError KTInt64 errType + // let errType = KTCustomType(ExecutionError.fqTypeName, []) + // let resultOk = Dval.resultOk KTInt64 errType + // let resultError = Dval.resultError KTInt64 errType (function - | state, [], [ DString filename; DString code; DDict(_vtTODO, symtable) ] -> + | _exeState, _, [], [ DString _filename; DString _code; DDict(_vtTODO, _symtable) ] -> uply { - let exnError (e : exn) : RuntimeError = - let msg = Exception.getMessages e |> String.concat "\n" - let metadata = - Exception.toMetadata e |> List.map (fun (k, v) -> k, string v) - CliRuntimeError.UncaughtException(msg, metadata) - |> CliRuntimeError.RTE.toRuntimeError - - let onMissingType = - RT.FQTypeName.FQTypeName.Package - PackageIDs.Type.LanguageTools.NameResolver.nameResolverOnMissing - let onMissingAllow = - RT.Dval.DEnum(onMissingType, onMissingType, [], "Allow", []) - - let getPmFnName = - RT.FQFnName.FQFnName.Package - PackageIDs.Fn.LanguageTools.PackageManager.pm - - let! execResult = - Exe.executeFunction - state - getPmFnName - [] - (NEList.singleton RT.Dval.DUnit) - - let! pm = - uply { - match execResult with - | Ok dval -> return dval - | Error(_callStack, rte) -> - let! rteString = (Exe.rteToString state rte) - return - Exception.raiseInternal - "Error executing pm function" - [ "rte", rteString ] - } - let args = - NEList.ofList - (RT.Dval.DString "CliScript") - [ RT.Dval.DString "ScriptName" - onMissingAllow - pm - RT.Dval.DString filename - RT.Dval.DString code ] - - let parseCliScriptFnName = - RT.FQFnName.FQFnName.Package - PackageIDs.Fn.LanguageTools.Parser.CliScript.parseCliScript - - let! execResult = Exe.executeFunction state parseCliScriptFnName [] args - - let! parsedScript = - uply { - match execResult with - | Ok dval -> return (Utils.CliScript.fromDT dval) |> Ok - | Error(_callStack, rte) -> - let! rteString = Exe.rteToString state rte - return - Exception.raiseInternal - "Error executing parseCanvas function" - [ "error", rteString ] - } - - try - match parsedScript with - | Ok mod' -> - match! execute state mod' symtable with - | Ok(DInt64 i) -> return resultOk (DInt64 i) - | Ok result -> - return - CliRuntimeError.NonIntReturned result - |> CliRuntimeError.RTE.toRuntimeError - |> RuntimeError.toDT - |> resultError - | Error(_callStack, e) -> - // TODO: do this, some better way - // (probably pass it back in a structured way) - // let! csString = Exe.callStackString state callStack - // print $"Error when executing Script. Call-stack:\n{csString}\n" - - return e |> RuntimeError.toDT |> resultError - | Error e -> return e |> RuntimeError.toDT |> resultError - with e -> - return exnError e |> RuntimeError.toDT |> resultError + // let exnError (e : exn) : RuntimeError = + // let msg = Exception.getMessages e |> String.concat "\n" + // let metadata = + // Exception.toMetadata e |> List.map (fun (k, v) -> k, string v) + // CliRuntimeError.UncaughtException(msg, metadata) + // |> CliRuntimeError.RTE.toRuntimeError + + // let onMissingType = + // RT.FQTypeName.FQTypeName.Package + // PackageIDs.Type.LanguageTools.NameResolver.nameResolverOnMissing + // let onMissingAllow = + // RT.Dval.DEnum(onMissingType, onMissingType, [], "Allow", []) + + // let getPmFnName = + // RT.FQFnName.FQFnName.Package + // PackageIDs.Fn.LanguageTools.PackageManager.pm + + // let! execResult = + // Exe.executeFunction + // state + // getPmFnName + // [] + // (NEList.singleton RT.Dval.DUnit) + + // let! pm = + // uply { + // match execResult with + // | Ok dval -> return dval + // | Error(_callStack, rte) -> + // let! rteString = (Exe.rteToString state rte) + // return + // Exception.raiseInternal + // "Error executing pm function" + // [ "rte", rteString ] + // } + // let args = + // NEList.ofList + // (RT.Dval.DString "CliScript") + // [ RT.Dval.DString "ScriptName" + // onMissingAllow + // pm + // RT.Dval.DString filename + // RT.Dval.DString code ] + + // let parseCliScriptFnName = + // RT.FQFnName.FQFnName.Package + // PackageIDs.Fn.LanguageTools.Parser.CliScript.parseCliScript + + // let! execResult = Exe.executeFunction state parseCliScriptFnName [] args + + // let! parsedScript = + // uply { + // match execResult with + // | Ok dval -> return (Utils.CliScript.fromDT dval) |> Ok + // | Error(_callStack, rte) -> + // let! rteString = Exe.rteToString state rte + // return + // Exception.raiseInternal + // "Error executing parseCanvas function" + // [ "error", rteString ] + // } + + // try + // match parsedScript with + // | Ok mod' -> + // match! execute state mod' symtable with + // | Ok(DInt64 i) -> return resultOk (DInt64 i) + // | Ok result -> + // return + // CliRuntimeError.NonIntReturned result + // |> CliRuntimeError.RTE.toRuntimeError + // |> RuntimeError.toDT + // |> resultError + // | Error(_callStack, e) -> + // // TODO: do this, some better way + // // (probably pass it back in a structured way) + // // let! csString = Exe.callStackString state callStack + // // print $"Error when executing Script. Call-stack:\n{csString}\n" + + // return e |> RuntimeError.toDT |> resultError + // | Error e -> return e |> RuntimeError.toDT |> resultError + // with e -> + // return exnError e |> RuntimeError.toDT |> resultError + return DUnit } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -260,165 +263,166 @@ let fns : List = description = "Executes an arbitrary Dark package function using the new darklang parser" fn = - let errType = KTCustomType(ExecutionError.fqTypeName, []) - let resultOk = Dval.resultOk KTString errType - let resultError = Dval.resultError KTString errType + // let errType = KTCustomType(ExecutionError.fqTypeName, []) + // let resultOk = Dval.resultOk KTString errType + // let resultError = Dval.resultError KTString errType function - | state, [], [ DString functionName; DList(_vtTODO, args) ] -> + | _exeState, _, [], [ DString _functionName; DList(_vtTODO, _args) ] -> uply { - let err (msg : string) (metadata : List) : Dval = - let fields = - [ ("msg", DString msg) - ("metadata", - DDict( - VT.string, - metadata |> List.map (Tuple2.mapSecond DString) |> Map - )) ] - - DRecord( - ExecutionError.fqTypeName, - ExecutionError.fqTypeName, - [], - Map fields - ) - - let exnError (e : exn) : Dval = - let msg = Exception.getMessages e |> String.concat "\n" - let metadata = - Exception.toMetadata e |> List.map (fun (k, v) -> k, string v) - err msg metadata - - try - let resolveFn = - RT.FQFnName.FQFnName.Package - PackageIDs.Fn.LanguageTools.NameResolver.FnName.resolve - - let onMissingType = - RT.FQTypeName.FQTypeName.Package - PackageIDs.Type.LanguageTools.NameResolver.nameResolverOnMissing - let onMissingAllow = - RT.Dval.DEnum(onMissingType, onMissingType, [], "Allow", []) - - let parserRangeType = - RT.FQTypeName.FQTypeName.Package - PackageIDs.Type.LanguageTools.Parser.range - let pointType = - RT.FQTypeName.FQTypeName.Package - PackageIDs.Type.LanguageTools.Parser.point - let pointFields = - [ ("row", RT.Dval.DInt64 0); ("column", RT.Dval.DInt64 0) ] - let fields = - [ ("start", - RT.Dval.DRecord(pointType, pointType, [], Map pointFields)) - ("end_", RT.Dval.DRecord(pointType, pointType, [], Map pointFields)) ] - - let rangeParser = - RT.Dval.DRecord(parserRangeType, parserRangeType, [], Map fields) - let writtenTypesNameType = - RT.FQTypeName.FQTypeName.Package - PackageIDs.Type.LanguageTools.WrittenTypes.name - - let parts = functionName.Split('.') |> List.ofArray - let currentModule = RT.Dval.DList(VT.string, []) - let nameArg = - RT.Dval.DEnum( - writtenTypesNameType, - writtenTypesNameType, - [], - "Unresolved", - [ rangeParser - RT.Dval.DList(VT.string, parts |> List.map RT.Dval.DString) ] - ) - - let pm = - RT.FQFnName.FQFnName.Package - PackageIDs.Fn.LanguageTools.PackageManager.pm - let! execResult = - Exe.executeFunction state pm [] (NEList.singleton RT.Dval.DUnit) - let! pm = - uply { - match execResult with - | Ok dval -> return dval - | Error(_, rte) -> - let! rteString = (Exe.rteToString state rte) - return - Exception.raiseInternal - "Error executing pm function" - [ "rte", rteString ] - } - - let resolveFnArgs = - NEList.ofList onMissingAllow [ pm; currentModule; nameArg ] - - let! execResult = Exe.executeFunction state resolveFn [] resolveFnArgs - - let! fnName = - uply { - match execResult with - | Ok dval -> - match C2DT.Result.fromDT PT2DT.FQFnName.fromDT dval identity with - | Ok fnName -> return Ok fnName - | Error _ -> - return - Exception.raiseInternal "Error converting Dval to FQName" [] - | Error(_, rte) -> - return - Exception.raiseInternal - "Error executing resolve function" - [ "rte", rte ] - } - - match fnName with - | Ok fnName -> - let! fn = - match PT2RT.FQFnName.toRT fnName with - | FQFnName.Package pkg -> - uply { - let! fn = state.packageManager.getFn pkg - return Option.map packageFnToFn fn - } - | _ -> - Exception.raiseInternal - "Error constructing package function name" - [ "fn", fn ] - - match fn with - | None -> return DString "fn not found" - | Some f -> - let newArgs = - args - |> List.collect (fun dval -> - match dval with - | DEnum(_, _, _, _, fields) -> fields |> List.tail - | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ]) - - let! result = - Exe.executeFunction - state - f.name - [] - (NEList.ofList newArgs.Head newArgs.Tail) - - match result with - | Error(_, e) -> - // TODO we should probably return the error here as-is, and handle by calling the - // toSegments on the error within the CLI - return - e - |> RuntimeError.toDT - |> LibExecution.DvalReprDeveloper.toRepr - |> DString - |> resultError - | Ok value -> - match value with - | DString s -> return resultOk (DString s) - | _ -> - let asString = LibExecution.DvalReprDeveloper.toRepr value - return resultOk (DString asString) - | _ -> return incorrectArgs () - with e -> - return exnError e + // let err (msg : string) (metadata : List) : Dval = + // let fields = + // [ ("msg", DString msg) + // ("metadata", + // DDict( + // VT.string, + // metadata |> List.map (Tuple2.mapSecond DString) |> Map + // )) ] + + // DRecord( + // ExecutionError.fqTypeName, + // ExecutionError.fqTypeName, + // [], + // Map fields + // ) + + // let exnError (e : exn) : Dval = + // let msg = Exception.getMessages e |> String.concat "\n" + // let metadata = + // Exception.toMetadata e |> List.map (fun (k, v) -> k, string v) + // err msg metadata + + // try + // let resolveFn = + // RT.FQFnName.FQFnName.Package + // PackageIDs.Fn.LanguageTools.NameResolver.FnName.resolve + + // let onMissingType = + // RT.FQTypeName.FQTypeName.Package + // PackageIDs.Type.LanguageTools.NameResolver.nameResolverOnMissing + // let onMissingAllow = + // RT.Dval.DEnum(onMissingType, onMissingType, [], "Allow", []) + + // let parserRangeType = + // RT.FQTypeName.FQTypeName.Package + // PackageIDs.Type.LanguageTools.Parser.range + // let pointType = + // RT.FQTypeName.FQTypeName.Package + // PackageIDs.Type.LanguageTools.Parser.point + // let pointFields = + // [ ("row", RT.Dval.DInt64 0); ("column", RT.Dval.DInt64 0) ] + // let fields = + // [ ("start", + // RT.Dval.DRecord(pointType, pointType, [], Map pointFields)) + // ("end_", RT.Dval.DRecord(pointType, pointType, [], Map pointFields)) ] + + // let rangeParser = + // RT.Dval.DRecord(parserRangeType, parserRangeType, [], Map fields) + // let writtenTypesNameType = + // RT.FQTypeName.FQTypeName.Package + // PackageIDs.Type.LanguageTools.WrittenTypes.name + + // let parts = functionName.Split('.') |> List.ofArray + // let currentModule = RT.Dval.DList(VT.string, []) + // let nameArg = + // RT.Dval.DEnum( + // writtenTypesNameType, + // writtenTypesNameType, + // [], + // "Unresolved", + // [ rangeParser + // RT.Dval.DList(VT.string, parts |> List.map RT.Dval.DString) ] + // ) + + // let pm = + // RT.FQFnName.FQFnName.Package + // PackageIDs.Fn.LanguageTools.PackageManager.pm + // let! execResult = + // Exe.executeFunction state pm [] (NEList.singleton RT.Dval.DUnit) + // let! pm = + // uply { + // match execResult with + // | Ok dval -> return dval + // | Error(_, rte) -> + // let! rteString = (Exe.rteToString state rte) + // return + // Exception.raiseInternal + // "Error executing pm function" + // [ "rte", rteString ] + // } + + // let resolveFnArgs = + // NEList.ofList onMissingAllow [ pm; currentModule; nameArg ] + + // let! execResult = Exe.executeFunction state resolveFn [] resolveFnArgs + + // let! fnName = + // uply { + // match execResult with + // | Ok dval -> + // match C2DT.Result.fromDT PT2DT.FQFnName.fromDT dval identity with + // | Ok fnName -> return Ok fnName + // | Error _ -> + // return + // Exception.raiseInternal "Error converting Dval to FQName" [] + // | Error(_, rte) -> + // return + // Exception.raiseInternal + // "Error executing resolve function" + // [ "rte", rte ] + // } + + // match fnName with + // | Ok fnName -> + // let! fn = + // match PT2RT.FQFnName.toRT fnName with + // | FQFnName.Package pkg -> + // uply { + // let! fn = state.packageManager.getFn pkg + // return Option.map packageFnToFn fn + // } + // | _ -> + // Exception.raiseInternal + // "Error constructing package function name" + // [ "fn", fn ] + + // match fn with + // | None -> return DString "fn not found" + // | Some f -> + // let newArgs = + // args + // |> List.collect (fun dval -> + // match dval with + // | DEnum(_, _, _, _, fields) -> fields |> List.tail + // | e -> Exception.raiseInternal "Invalid Expr" [ "e", e ]) + + // let! result = + // Exe.executeFunction + // state + // f.name + // [] + // (NEList.ofList newArgs.Head newArgs.Tail) + + // match result with + // | Error(_, e) -> + // // TODO we should probably return the error here as-is, and handle by calling the + // // toSegments on the error within the CLI + // return + // e + // |> RuntimeError.toDT + // |> LibExecution.DvalReprDeveloper.toRepr + // |> DString + // |> resultError + // | Ok value -> + // match value with + // | DString s -> return resultOk (DString s) + // | _ -> + // let asString = LibExecution.DvalReprDeveloper.toRepr value + // return resultOk (DString asString) + // | _ -> return incorrectArgs () + // with e -> + // return exnError e + return DUnit } | _ -> incorrectArgs () sqlSpec = NotQueryable diff --git a/backend/src/BuiltinCliHost/Utils.fs b/backend/src/BuiltinCliHost/Utils.fs index 820cf03641..4709f8e2a0 100644 --- a/backend/src/BuiltinCliHost/Utils.fs +++ b/backend/src/BuiltinCliHost/Utils.fs @@ -4,7 +4,7 @@ open Prelude module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module PT2DT = LibExecution.ProgramTypesToDarkTypes module PackageIDs = LibExecution.PackageIDs diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 0aab0b7bac..4b37144ae6 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -47,7 +47,7 @@ let builtins Libs.Base64.builtins - // Libs.Json.builtins + Libs.Json.builtins Libs.AltJson.builtins Libs.HttpClient.builtins httpConfig diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 0be2c0149c..53f6824309 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -390,59 +390,61 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "unwrap" 0 - // typeParams = [] - // parameters = [ Param.make "value" (TVariable "optOrRes") "" ] - // returnType = TVariable "a" - // description = - // "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" - // fn = - // (function - // | _, _, [] -> incorrectArgs () - // | _, _, [ dval ] -> - // match dval with - - // // success: extract `Some` out of an Option - // | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when - // id = PackageIDs.Type.Stdlib.option - // -> - // Ply value - - // // success: extract `Ok` out of a Result - // | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when - // id = PackageIDs.Type.Stdlib.result - // -> - // Ply value - - // // Error: expected Some, got None - // | DEnum(FQTypeName.Package id, _, _, "None", []) when - // id = PackageIDs.Type.Stdlib.option - // -> - // "expected Some, got None" |> RuntimeError.oldError |> raiseUntargetedRTE - - // // Error: expected Ok, got Error - // | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when - // id = PackageIDs.Type.Stdlib.result - // -> - // $"expected Ok, got Error:\n{value |> DvalReprDeveloper.toRepr}" - // |> RuntimeError.oldError - // |> raiseUntargetedRTE - - - // // Error: single dval, but not an Option or Result - // | otherDval -> - // $"Unwrap called with non-Option/non-Result {otherDval}" - // |> RuntimeError.oldError - // |> raiseUntargetedRTE - - // | _, _, multipleArgs -> - // $"unwrap called with multiple arguments: {multipleArgs}" - // |> RuntimeError.oldError - // |> raiseUntargetedRTE) - - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "unwrap" 0 + typeParams = [] + parameters = [ Param.make "value" (TVariable "optOrRes") "" ] + returnType = TVariable "a" + description = + "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" + fn = + (function + | _, _, _, [] -> incorrectArgs () + | _, vm, _, [ dval ] -> + match dval with + + // success: extract `Some` out of an Option + | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when + id = PackageIDs.Type.Stdlib.option + -> + Ply value + + // success: extract `Ok` out of a Result + | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when + id = PackageIDs.Type.Stdlib.result + -> + Ply value + + // Error: expected Some, got None + | DEnum(FQTypeName.Package id, _, _, "None", []) when + id = PackageIDs.Type.Stdlib.option + -> + RuntimeError.Unwraps.GotNone + |> RuntimeError.Unwrap + |> raiseRTE vm.threadID + + // Error: expected Ok, got Error + | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when + id = PackageIDs.Type.Stdlib.result + -> + RuntimeError.Unwraps.GotError value + |> RuntimeError.Unwrap + |> raiseRTE vm.threadID + + + // Error: single dval, but not an Option or Result + | otherDval -> + RuntimeError.Unwraps.NonOptionOrResult otherDval + |> RuntimeError.Unwrap + |> raiseRTE vm.threadID + + | _, vm, _, multipleArgs -> + RuntimeError.Unwraps.MultipleArgs multipleArgs + |> RuntimeError.Unwrap + |> raiseRTE vm.threadID) + + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } // { name = fn "debug" 0 diff --git a/backend/src/LibExecution/PackageIDs.fs b/backend/src/LibExecution/PackageIDs.fs index b3115165ba..ccb293cc7c 100644 --- a/backend/src/LibExecution/PackageIDs.fs +++ b/backend/src/LibExecution/PackageIDs.fs @@ -152,8 +152,8 @@ module Type = module Json = let error = p [ "Json" ] "Error" "595907db-ab8d-4fe5-b9cf-d1bd8041e9bb" - // module Cli = - // let error = p [ "Cli" ] "Error" "6756f735-2a6a-41ac-a6a8-6e0b7354ca1b" + module Cli = + let error = p [ "Cli" ] "Error" "6756f735-2a6a-41ac-a6a8-6e0b7354ca1b" let error = p [] "Error" "722cd3b3-d6af-4d28-96f2-87afd44c3898" diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index af32e8ed68..520627e7ea 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -714,11 +714,12 @@ module RuntimeError = // | FieldAccessFieldDoesntExist of typeName: RuntimeTypes.FQTypeName * invalidFieldName: String // | FieldAccessNotRecord of RuntimeTypes.ValueType * String - // module Unwrap = - // type Error = - // | GotNone - // | GotError of Dval - // | NonOptionOrResult of Dval + module Unwraps = + type Error = + | GotNone + | GotError of Dval + | NonOptionOrResult of Dval + | MultipleArgs of List module Lets = @@ -837,7 +838,7 @@ module RuntimeError = // /// but is here a `{someFn actualValueType}` (`{someFn actualValue}`)" // | IfConditionNotBool of actualValue: Dval * actualValueType: ValueType - // | Unwrap of Unwrap.Error + | Unwrap of Unwraps.Error | EqualityCheckOnIncompatibleTypes of left : ValueType * right : ValueType diff --git a/backend/src/LibParser/FSharpToWrittenTypes.fs b/backend/src/LibParser/FSharpToWrittenTypes.fs index 766b3f1776..84736bef21 100644 --- a/backend/src/LibParser/FSharpToWrittenTypes.fs +++ b/backend/src/LibParser/FSharpToWrittenTypes.fs @@ -189,16 +189,16 @@ module MatchPattern = let id = gid () let r = fromSynPat - // let convertEnumArg (ast : SynPat) : List = - // // if the arg is a tuple with one paren around it, it's just arguments to the - // // enum. But if it has two parens around it, it's a single tuple. - // // eg: (Foo(1, 2)) vs (Foo((1, 2))) - // match ast with - // | SynPat.Paren(SynPat.Paren(SynPat.Tuple(_, t1 :: t2 :: trest, _, _), _), _) -> - // [ WT.MPTuple(gid (), r t1, r t2, List.map r trest) ] - // | SynPat.Paren(SynPat.Tuple(_, args, _, _), _) -> List.map r args - // | SynPat.Tuple(_, args, _, _) -> List.map r args - // | e -> [ r e ] + let convertEnumArg (ast : SynPat) : List = + // if the arg is a tuple with one paren around it, it's just arguments to the + // enum. But if it has two parens around it, it's a single tuple. + // eg: (Foo(1, 2)) vs (Foo((1, 2))) + match ast with + | SynPat.Paren(SynPat.Paren(SynPat.Tuple(_, t1 :: t2 :: trest, _, _), _), _) -> + [ WT.MPTuple(gid (), r t1, r t2, List.map r trest) ] + | SynPat.Paren(SynPat.Tuple(_, args, _, _), _) -> List.map r args + | SynPat.Tuple(_, args, _, _) -> List.map r args + | e -> [ r e ] match pat with | SynPat.Paren(pat, _) -> r pat @@ -247,16 +247,16 @@ module MatchPattern = // parse enum pattern -- requires type name to be included - // | SynPat.LongIdent(SynLongIdent(names, _, _), _, _, SynArgPats.Pats args, _, _) -> - // let enumName = - // List.last names |> Exception.unwrapOptionInternal "missing enum name" [] - // let modules = List.initial names |> List.map _.idText - // if modules <> [] then - // Exception.raiseInternal - // "Module in enum pattern casename. Only use the casename in Enum patterns" - // [ "pat", pat ] - // let args = List.map convertEnumArg args |> List.concat - // WT.MPEnum(id, enumName.idText, args) + | SynPat.LongIdent(SynLongIdent(names, _, _), _, _, SynArgPats.Pats args, _, _) -> + let enumName = + List.last names |> Exception.unwrapOptionInternal "missing enum name" [] + let modules = List.initial names |> List.map _.idText + if modules <> [] then + Exception.raiseInternal + "Module in enum pattern casename. Only use the casename in Enum patterns" + [ "pat", pat ] + let args = List.map convertEnumArg args |> List.concat + WT.MPEnum(id, enumName.idText, args) | SynPat.ArrayOrList(_, pats, _) -> WT.MPList(id, List.map r pats) diff --git a/backend/src/LibParser/WrittenTypes.fs b/backend/src/LibParser/WrittenTypes.fs index c33170f413..bb765924b0 100644 --- a/backend/src/LibParser/WrittenTypes.fs +++ b/backend/src/LibParser/WrittenTypes.fs @@ -82,7 +82,7 @@ type MatchPattern = | MPVariable of id * string -//| MPEnum of id * caseName : string * fieldPats : List + | MPEnum of id * caseName : string * fieldPats : List type BinaryOperation = | BinOpAnd diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index c136a57cf2..5511d044c2 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -104,8 +104,8 @@ module MatchPattern = let rec toPT (p : WT.MatchPattern) : PT.MatchPattern = match p with | WT.MPVariable(id, str) -> PT.MPVariable(id, str) - // | WT.MPEnum(id, caseName, fieldPats) -> - // PT.MPEnum(id, caseName, List.map toPT fieldPats) + | WT.MPEnum(id, caseName, fieldPats) -> + PT.MPEnum(id, caseName, List.map toPT fieldPats) | WT.MPInt64(id, i) -> PT.MPInt64(id, i) | WT.MPUInt64(id, i) -> PT.MPUInt64(id, i) | WT.MPInt8(id, i) -> PT.MPInt8(id, i) diff --git a/backend/src/LocalExec/LoadPackagesFromDisk.fs b/backend/src/LocalExec/LoadPackagesFromDisk.fs index 1a2dbe84e9..316ffc7e82 100644 --- a/backend/src/LocalExec/LoadPackagesFromDisk.fs +++ b/backend/src/LocalExec/LoadPackagesFromDisk.fs @@ -20,6 +20,7 @@ let load (builtins : RT.Builtins) : Ply = let filesWithContents = "/home/dark/app/packages" |> listDirectoryRecursive + |> List.filter (String.contains "_" >> not) |> List.filter (fun x -> x |> String.endsWith ".dark") |> List.map (fun fileName -> (fileName, System.IO.File.ReadAllText fileName)) diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index 17688cd3a5..3a15a58c88 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -36,15 +36,15 @@ module HandleCommand = } - let reloadDarkPackagesCanvas () : Ply> = - uply { - let! (canvasId, toplevels) = - Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" + // let reloadDarkPackagesCanvas () : Ply> = + // uply { + // let! (canvasId, toplevels) = + // Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" - print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" + // print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" - return Ok() - } + // return Ok() + // } @@ -90,10 +90,10 @@ let main (args : string[]) : int = "reading, parsing packages from `packages` directory, and saving to internal SQL tables" (HandleCommand.loadPackagesToInternalSqlTables ()) - | [ "reload-dark-packages" ] -> - handleCommand - $"purging, re-creating, and seeding `dark-packages` canvas" - (HandleCommand.reloadDarkPackagesCanvas ()) + // | [ "reload-dark-packages" ] -> + // handleCommand + // $"purging, re-creating, and seeding `dark-packages` canvas" + // (HandleCommand.reloadDarkPackagesCanvas ()) | _ -> print "Invalid arguments" diff --git a/backend/src/LocalExec/LocalExec.fsproj b/backend/src/LocalExec/LocalExec.fsproj index ca4233d8df..2030b7036d 100644 --- a/backend/src/LocalExec/LocalExec.fsproj +++ b/backend/src/LocalExec/LocalExec.fsproj @@ -22,15 +22,15 @@ - - + + - + diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index f1f7ffb198..0d7975cdb0 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -8,7 +8,7 @@ open Prelude open TestUtils.TestUtils module RT = LibExecution.RuntimeTypes -module VT = RT.ValueType +module VT = LibExecution.ValueType module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes diff --git a/packages/darklang/cli/cli.dark b/packages/darklang/_cli/cli.dark similarity index 100% rename from packages/darklang/cli/cli.dark rename to packages/darklang/_cli/cli.dark diff --git a/packages/darklang/cli/local-install/README.md b/packages/darklang/_cli/local-install/README.md similarity index 100% rename from packages/darklang/cli/local-install/README.md rename to packages/darklang/_cli/local-install/README.md diff --git a/packages/darklang/cli/local-install/config.dark b/packages/darklang/_cli/local-install/config.dark similarity index 100% rename from packages/darklang/cli/local-install/config.dark rename to packages/darklang/_cli/local-install/config.dark diff --git a/packages/darklang/cli/local-install/install.dark b/packages/darklang/_cli/local-install/install.dark similarity index 100% rename from packages/darklang/cli/local-install/install.dark rename to packages/darklang/_cli/local-install/install.dark diff --git a/packages/darklang/cli/local-install/main.dark b/packages/darklang/_cli/local-install/main.dark similarity index 100% rename from packages/darklang/cli/local-install/main.dark rename to packages/darklang/_cli/local-install/main.dark diff --git a/packages/darklang/cli/local-install/uninstall.dark b/packages/darklang/_cli/local-install/uninstall.dark similarity index 100% rename from packages/darklang/cli/local-install/uninstall.dark rename to packages/darklang/_cli/local-install/uninstall.dark diff --git a/packages/darklang/dark-packages.dark b/packages/darklang/_dark-packages.dark similarity index 100% rename from packages/darklang/dark-packages.dark rename to packages/darklang/_dark-packages.dark diff --git a/packages/darklang/github.dark b/packages/darklang/_github.dark similarity index 100% rename from packages/darklang/github.dark rename to packages/darklang/_github.dark diff --git a/packages/darklang/internal.dark b/packages/darklang/_internal.dark similarity index 100% rename from packages/darklang/internal.dark rename to packages/darklang/_internal.dark diff --git a/packages/darklang/json-rpc.dark b/packages/darklang/_json-rpc.dark similarity index 100% rename from packages/darklang/json-rpc.dark rename to packages/darklang/_json-rpc.dark diff --git a/packages/darklang/languageServerProtocol/README.md b/packages/darklang/_languageServerProtocol/README.md similarity index 100% rename from packages/darklang/languageServerProtocol/README.md rename to packages/darklang/_languageServerProtocol/README.md diff --git a/packages/darklang/languageServerProtocol/common.dark b/packages/darklang/_languageServerProtocol/common.dark similarity index 100% rename from packages/darklang/languageServerProtocol/common.dark rename to packages/darklang/_languageServerProtocol/common.dark diff --git a/packages/darklang/languageServerProtocol/documentSync/README.md b/packages/darklang/_languageServerProtocol/documentSync/README.md similarity index 100% rename from packages/darklang/languageServerProtocol/documentSync/README.md rename to packages/darklang/_languageServerProtocol/documentSync/README.md diff --git a/packages/darklang/languageServerProtocol/documentSync/common.dark b/packages/darklang/_languageServerProtocol/documentSync/common.dark similarity index 100% rename from packages/darklang/languageServerProtocol/documentSync/common.dark rename to packages/darklang/_languageServerProtocol/documentSync/common.dark diff --git a/packages/darklang/languageServerProtocol/documentSync/notebook.dark b/packages/darklang/_languageServerProtocol/documentSync/notebook.dark similarity index 100% rename from packages/darklang/languageServerProtocol/documentSync/notebook.dark rename to packages/darklang/_languageServerProtocol/documentSync/notebook.dark diff --git a/packages/darklang/languageServerProtocol/documentSync/textDocument.dark b/packages/darklang/_languageServerProtocol/documentSync/textDocument.dark similarity index 100% rename from packages/darklang/languageServerProtocol/documentSync/textDocument.dark rename to packages/darklang/_languageServerProtocol/documentSync/textDocument.dark diff --git a/packages/darklang/languageServerProtocol/io.dark b/packages/darklang/_languageServerProtocol/io.dark similarity index 100% rename from packages/darklang/languageServerProtocol/io.dark rename to packages/darklang/_languageServerProtocol/io.dark diff --git a/packages/darklang/languageServerProtocol/language/callHierarchy.dark b/packages/darklang/_languageServerProtocol/language/callHierarchy.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/callHierarchy.dark rename to packages/darklang/_languageServerProtocol/language/callHierarchy.dark diff --git a/packages/darklang/languageServerProtocol/language/codeAction.dark b/packages/darklang/_languageServerProtocol/language/codeAction.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/codeAction.dark rename to packages/darklang/_languageServerProtocol/language/codeAction.dark diff --git a/packages/darklang/languageServerProtocol/language/codeLens.dark b/packages/darklang/_languageServerProtocol/language/codeLens.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/codeLens.dark rename to packages/darklang/_languageServerProtocol/language/codeLens.dark diff --git a/packages/darklang/languageServerProtocol/language/colorProvider.dark b/packages/darklang/_languageServerProtocol/language/colorProvider.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/colorProvider.dark rename to packages/darklang/_languageServerProtocol/language/colorProvider.dark diff --git a/packages/darklang/languageServerProtocol/language/completion.dark b/packages/darklang/_languageServerProtocol/language/completion.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/completion.dark rename to packages/darklang/_languageServerProtocol/language/completion.dark diff --git a/packages/darklang/languageServerProtocol/language/diagnostics.dark b/packages/darklang/_languageServerProtocol/language/diagnostics.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/diagnostics.dark rename to packages/darklang/_languageServerProtocol/language/diagnostics.dark diff --git a/packages/darklang/languageServerProtocol/language/documentHighlight.dark b/packages/darklang/_languageServerProtocol/language/documentHighlight.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/documentHighlight.dark rename to packages/darklang/_languageServerProtocol/language/documentHighlight.dark diff --git a/packages/darklang/languageServerProtocol/language/documentSymbols.dark b/packages/darklang/_languageServerProtocol/language/documentSymbols.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/documentSymbols.dark rename to packages/darklang/_languageServerProtocol/language/documentSymbols.dark diff --git a/packages/darklang/languageServerProtocol/language/findReferences.dark b/packages/darklang/_languageServerProtocol/language/findReferences.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/findReferences.dark rename to packages/darklang/_languageServerProtocol/language/findReferences.dark diff --git a/packages/darklang/languageServerProtocol/language/foldingRange.dark b/packages/darklang/_languageServerProtocol/language/foldingRange.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/foldingRange.dark rename to packages/darklang/_languageServerProtocol/language/foldingRange.dark diff --git a/packages/darklang/languageServerProtocol/language/formatting.dark b/packages/darklang/_languageServerProtocol/language/formatting.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/formatting.dark rename to packages/darklang/_languageServerProtocol/language/formatting.dark diff --git a/packages/darklang/languageServerProtocol/language/getDocumentLinks.dark b/packages/darklang/_languageServerProtocol/language/getDocumentLinks.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/getDocumentLinks.dark rename to packages/darklang/_languageServerProtocol/language/getDocumentLinks.dark diff --git a/packages/darklang/languageServerProtocol/language/goToDeclaration.dark b/packages/darklang/_languageServerProtocol/language/goToDeclaration.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/goToDeclaration.dark rename to packages/darklang/_languageServerProtocol/language/goToDeclaration.dark diff --git a/packages/darklang/languageServerProtocol/language/goToDefinition.dark b/packages/darklang/_languageServerProtocol/language/goToDefinition.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/goToDefinition.dark rename to packages/darklang/_languageServerProtocol/language/goToDefinition.dark diff --git a/packages/darklang/languageServerProtocol/language/goToImplementation.dark b/packages/darklang/_languageServerProtocol/language/goToImplementation.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/goToImplementation.dark rename to packages/darklang/_languageServerProtocol/language/goToImplementation.dark diff --git a/packages/darklang/languageServerProtocol/language/handleRename.dark b/packages/darklang/_languageServerProtocol/language/handleRename.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/handleRename.dark rename to packages/darklang/_languageServerProtocol/language/handleRename.dark diff --git a/packages/darklang/languageServerProtocol/language/inlayHint.dark b/packages/darklang/_languageServerProtocol/language/inlayHint.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/inlayHint.dark rename to packages/darklang/_languageServerProtocol/language/inlayHint.dark diff --git a/packages/darklang/languageServerProtocol/language/inlineCompletion.dark b/packages/darklang/_languageServerProtocol/language/inlineCompletion.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/inlineCompletion.dark rename to packages/darklang/_languageServerProtocol/language/inlineCompletion.dark diff --git a/packages/darklang/languageServerProtocol/language/inlineValue.dark b/packages/darklang/_languageServerProtocol/language/inlineValue.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/inlineValue.dark rename to packages/darklang/_languageServerProtocol/language/inlineValue.dark diff --git a/packages/darklang/languageServerProtocol/language/linkedEditingRange.dark b/packages/darklang/_languageServerProtocol/language/linkedEditingRange.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/linkedEditingRange.dark rename to packages/darklang/_languageServerProtocol/language/linkedEditingRange.dark diff --git a/packages/darklang/languageServerProtocol/language/monikor.dark b/packages/darklang/_languageServerProtocol/language/monikor.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/monikor.dark rename to packages/darklang/_languageServerProtocol/language/monikor.dark diff --git a/packages/darklang/languageServerProtocol/language/onHover.dark b/packages/darklang/_languageServerProtocol/language/onHover.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/onHover.dark rename to packages/darklang/_languageServerProtocol/language/onHover.dark diff --git a/packages/darklang/languageServerProtocol/language/selectionRange.dark b/packages/darklang/_languageServerProtocol/language/selectionRange.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/selectionRange.dark rename to packages/darklang/_languageServerProtocol/language/selectionRange.dark diff --git a/packages/darklang/languageServerProtocol/language/semanticToken.dark b/packages/darklang/_languageServerProtocol/language/semanticToken.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/semanticToken.dark rename to packages/darklang/_languageServerProtocol/language/semanticToken.dark diff --git a/packages/darklang/languageServerProtocol/language/signatureHelp.dark b/packages/darklang/_languageServerProtocol/language/signatureHelp.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/signatureHelp.dark rename to packages/darklang/_languageServerProtocol/language/signatureHelp.dark diff --git a/packages/darklang/languageServerProtocol/language/typeDefinition.dark b/packages/darklang/_languageServerProtocol/language/typeDefinition.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/typeDefinition.dark rename to packages/darklang/_languageServerProtocol/language/typeDefinition.dark diff --git a/packages/darklang/languageServerProtocol/language/typeHierarchy.dark b/packages/darklang/_languageServerProtocol/language/typeHierarchy.dark similarity index 100% rename from packages/darklang/languageServerProtocol/language/typeHierarchy.dark rename to packages/darklang/_languageServerProtocol/language/typeHierarchy.dark diff --git a/packages/darklang/languageServerProtocol/lifecycle/capabilityRegistration.dark b/packages/darklang/_languageServerProtocol/lifecycle/capabilityRegistration.dark similarity index 100% rename from packages/darklang/languageServerProtocol/lifecycle/capabilityRegistration.dark rename to packages/darklang/_languageServerProtocol/lifecycle/capabilityRegistration.dark diff --git a/packages/darklang/languageServerProtocol/lifecycle/exit.dark b/packages/darklang/_languageServerProtocol/lifecycle/exit.dark similarity index 100% rename from packages/darklang/languageServerProtocol/lifecycle/exit.dark rename to packages/darklang/_languageServerProtocol/lifecycle/exit.dark diff --git a/packages/darklang/languageServerProtocol/lifecycle/initialize.dark b/packages/darklang/_languageServerProtocol/lifecycle/initialize.dark similarity index 100% rename from packages/darklang/languageServerProtocol/lifecycle/initialize.dark rename to packages/darklang/_languageServerProtocol/lifecycle/initialize.dark diff --git a/packages/darklang/languageServerProtocol/lifecycle/initialized.dark b/packages/darklang/_languageServerProtocol/lifecycle/initialized.dark similarity index 100% rename from packages/darklang/languageServerProtocol/lifecycle/initialized.dark rename to packages/darklang/_languageServerProtocol/lifecycle/initialized.dark diff --git a/packages/darklang/languageServerProtocol/lifecycle/shutdown.dark b/packages/darklang/_languageServerProtocol/lifecycle/shutdown.dark similarity index 100% rename from packages/darklang/languageServerProtocol/lifecycle/shutdown.dark rename to packages/darklang/_languageServerProtocol/lifecycle/shutdown.dark diff --git a/packages/darklang/languageServerProtocol/tracing.dark b/packages/darklang/_languageServerProtocol/tracing.dark similarity index 100% rename from packages/darklang/languageServerProtocol/tracing.dark rename to packages/darklang/_languageServerProtocol/tracing.dark diff --git a/packages/darklang/languageServerProtocol/window/logMessage.dark b/packages/darklang/_languageServerProtocol/window/logMessage.dark similarity index 100% rename from packages/darklang/languageServerProtocol/window/logMessage.dark rename to packages/darklang/_languageServerProtocol/window/logMessage.dark diff --git a/packages/darklang/languageServerProtocol/window/showDocument.dark b/packages/darklang/_languageServerProtocol/window/showDocument.dark similarity index 100% rename from packages/darklang/languageServerProtocol/window/showDocument.dark rename to packages/darklang/_languageServerProtocol/window/showDocument.dark diff --git a/packages/darklang/languageServerProtocol/window/showMessage.dark b/packages/darklang/_languageServerProtocol/window/showMessage.dark similarity index 100% rename from packages/darklang/languageServerProtocol/window/showMessage.dark rename to packages/darklang/_languageServerProtocol/window/showMessage.dark diff --git a/packages/darklang/languageServerProtocol/window/showMessageRequest.dark b/packages/darklang/_languageServerProtocol/window/showMessageRequest.dark similarity index 100% rename from packages/darklang/languageServerProtocol/window/showMessageRequest.dark rename to packages/darklang/_languageServerProtocol/window/showMessageRequest.dark diff --git a/packages/darklang/languageServerProtocol/window/telemetry.dark b/packages/darklang/_languageServerProtocol/window/telemetry.dark similarity index 100% rename from packages/darklang/languageServerProtocol/window/telemetry.dark rename to packages/darklang/_languageServerProtocol/window/telemetry.dark diff --git a/packages/darklang/languageServerProtocol/workInProgress.dark b/packages/darklang/_languageServerProtocol/workInProgress.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workInProgress.dark rename to packages/darklang/_languageServerProtocol/workInProgress.dark diff --git a/packages/darklang/languageServerProtocol/workspace/configuration.dark b/packages/darklang/_languageServerProtocol/workspace/configuration.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/configuration.dark rename to packages/darklang/_languageServerProtocol/workspace/configuration.dark diff --git a/packages/darklang/languageServerProtocol/workspace/executeCommand.dark b/packages/darklang/_languageServerProtocol/workspace/executeCommand.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/executeCommand.dark rename to packages/darklang/_languageServerProtocol/workspace/executeCommand.dark diff --git a/packages/darklang/languageServerProtocol/workspace/fileOperations.dark b/packages/darklang/_languageServerProtocol/workspace/fileOperations.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/fileOperations.dark rename to packages/darklang/_languageServerProtocol/workspace/fileOperations.dark diff --git a/packages/darklang/languageServerProtocol/workspace/onDidChangeWatchedFiles.dark b/packages/darklang/_languageServerProtocol/workspace/onDidChangeWatchedFiles.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/onDidChangeWatchedFiles.dark rename to packages/darklang/_languageServerProtocol/workspace/onDidChangeWatchedFiles.dark diff --git a/packages/darklang/languageServerProtocol/workspace/workspaceEdit.dark b/packages/darklang/_languageServerProtocol/workspace/workspaceEdit.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/workspaceEdit.dark rename to packages/darklang/_languageServerProtocol/workspace/workspaceEdit.dark diff --git a/packages/darklang/languageServerProtocol/workspace/workspaceFolder.dark b/packages/darklang/_languageServerProtocol/workspace/workspaceFolder.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/workspaceFolder.dark rename to packages/darklang/_languageServerProtocol/workspace/workspaceFolder.dark diff --git a/packages/darklang/languageServerProtocol/workspace/workspaceSymbols.dark b/packages/darklang/_languageServerProtocol/workspace/workspaceSymbols.dark similarity index 100% rename from packages/darklang/languageServerProtocol/workspace/workspaceSymbols.dark rename to packages/darklang/_languageServerProtocol/workspace/workspaceSymbols.dark diff --git a/packages/darklang/openai.dark b/packages/darklang/_openai.dark similarity index 100% rename from packages/darklang/openai.dark rename to packages/darklang/_openai.dark diff --git a/packages/darklang/prettyPrinter/canvas.dark b/packages/darklang/_prettyPrinter/canvas.dark similarity index 100% rename from packages/darklang/prettyPrinter/canvas.dark rename to packages/darklang/_prettyPrinter/canvas.dark diff --git a/packages/darklang/prettyPrinter/cliScript.dark b/packages/darklang/_prettyPrinter/cliScript.dark similarity index 100% rename from packages/darklang/prettyPrinter/cliScript.dark rename to packages/darklang/_prettyPrinter/cliScript.dark diff --git a/packages/darklang/prettyPrinter/common.dark b/packages/darklang/_prettyPrinter/common.dark similarity index 100% rename from packages/darklang/prettyPrinter/common.dark rename to packages/darklang/_prettyPrinter/common.dark diff --git a/packages/darklang/prettyPrinter/moduleDeclaration.dark b/packages/darklang/_prettyPrinter/moduleDeclaration.dark similarity index 100% rename from packages/darklang/prettyPrinter/moduleDeclaration.dark rename to packages/darklang/_prettyPrinter/moduleDeclaration.dark diff --git a/packages/darklang/prettyPrinter/packages.dark b/packages/darklang/_prettyPrinter/packages.dark similarity index 100% rename from packages/darklang/prettyPrinter/packages.dark rename to packages/darklang/_prettyPrinter/packages.dark diff --git a/packages/darklang/prettyPrinter/programTypes.dark b/packages/darklang/_prettyPrinter/programTypes.dark similarity index 100% rename from packages/darklang/prettyPrinter/programTypes.dark rename to packages/darklang/_prettyPrinter/programTypes.dark diff --git a/packages/darklang/prettyPrinter/runtimeTypes.dark b/packages/darklang/_prettyPrinter/runtimeTypes.dark similarity index 100% rename from packages/darklang/prettyPrinter/runtimeTypes.dark rename to packages/darklang/_prettyPrinter/runtimeTypes.dark diff --git a/packages/darklang/languageTools/lsp-server/aaaa_state.dark b/packages/darklang/languageTools/_lsp-server/aaaa_state.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/aaaa_state.dark rename to packages/darklang/languageTools/_lsp-server/aaaa_state.dark diff --git a/packages/darklang/languageTools/lsp-server/completions.dark b/packages/darklang/languageTools/_lsp-server/completions.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/completions.dark rename to packages/darklang/languageTools/_lsp-server/completions.dark diff --git a/packages/darklang/languageTools/lsp-server/diagnostics.dark b/packages/darklang/languageTools/_lsp-server/diagnostics.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/diagnostics.dark rename to packages/darklang/languageTools/_lsp-server/diagnostics.dark diff --git a/packages/darklang/languageTools/lsp-server/docSync.dark b/packages/darklang/languageTools/_lsp-server/docSync.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/docSync.dark rename to packages/darklang/languageTools/_lsp-server/docSync.dark diff --git a/packages/darklang/languageTools/lsp-server/handleIncomingMessage.dark b/packages/darklang/languageTools/_lsp-server/handleIncomingMessage.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/handleIncomingMessage.dark rename to packages/darklang/languageTools/_lsp-server/handleIncomingMessage.dark diff --git a/packages/darklang/languageTools/lsp-server/initialize.dark b/packages/darklang/languageTools/_lsp-server/initialize.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/initialize.dark rename to packages/darklang/languageTools/_lsp-server/initialize.dark diff --git a/packages/darklang/languageTools/lsp-server/logging.dark b/packages/darklang/languageTools/_lsp-server/logging.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/logging.dark rename to packages/darklang/languageTools/_lsp-server/logging.dark diff --git a/packages/darklang/languageTools/lsp-server/lsp-server.dark b/packages/darklang/languageTools/_lsp-server/lsp-server.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/lsp-server.dark rename to packages/darklang/languageTools/_lsp-server/lsp-server.dark diff --git a/packages/darklang/languageTools/lsp-server/semanticTokens.dark b/packages/darklang/languageTools/_lsp-server/semanticTokens.dark similarity index 100% rename from packages/darklang/languageTools/lsp-server/semanticTokens.dark rename to packages/darklang/languageTools/_lsp-server/semanticTokens.dark diff --git a/packages/darklang/languageTools/lsp.dark b/packages/darklang/languageTools/_lsp.dark similarity index 100% rename from packages/darklang/languageTools/lsp.dark rename to packages/darklang/languageTools/_lsp.dark diff --git a/packages/darklang/languageTools/nameResolver.dark b/packages/darklang/languageTools/_nameResolver.dark similarity index 100% rename from packages/darklang/languageTools/nameResolver.dark rename to packages/darklang/languageTools/_nameResolver.dark diff --git a/packages/darklang/languageTools/packageManager.dark b/packages/darklang/languageTools/_packageManager.dark similarity index 100% rename from packages/darklang/languageTools/packageManager.dark rename to packages/darklang/languageTools/_packageManager.dark diff --git a/packages/darklang/languageTools/parser/canvas.dark b/packages/darklang/languageTools/_parser/canvas.dark similarity index 100% rename from packages/darklang/languageTools/parser/canvas.dark rename to packages/darklang/languageTools/_parser/canvas.dark diff --git a/packages/darklang/languageTools/parser/cliScript.dark b/packages/darklang/languageTools/_parser/cliScript.dark similarity index 100% rename from packages/darklang/languageTools/parser/cliScript.dark rename to packages/darklang/languageTools/_parser/cliScript.dark diff --git a/packages/darklang/languageTools/parser/constantDeclaration.dark b/packages/darklang/languageTools/_parser/constantDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/parser/constantDeclaration.dark rename to packages/darklang/languageTools/_parser/constantDeclaration.dark diff --git a/packages/darklang/languageTools/parser/core.dark b/packages/darklang/languageTools/_parser/core.dark similarity index 100% rename from packages/darklang/languageTools/parser/core.dark rename to packages/darklang/languageTools/_parser/core.dark diff --git a/packages/darklang/languageTools/parser/expr.dark b/packages/darklang/languageTools/_parser/expr.dark similarity index 100% rename from packages/darklang/languageTools/parser/expr.dark rename to packages/darklang/languageTools/_parser/expr.dark diff --git a/packages/darklang/languageTools/parser/functionDeclaration.dark b/packages/darklang/languageTools/_parser/functionDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/parser/functionDeclaration.dark rename to packages/darklang/languageTools/_parser/functionDeclaration.dark diff --git a/packages/darklang/languageTools/parser/identifiers.dark b/packages/darklang/languageTools/_parser/identifiers.dark similarity index 100% rename from packages/darklang/languageTools/parser/identifiers.dark rename to packages/darklang/languageTools/_parser/identifiers.dark diff --git a/packages/darklang/languageTools/parser/matchPattern.dark b/packages/darklang/languageTools/_parser/matchPattern.dark similarity index 100% rename from packages/darklang/languageTools/parser/matchPattern.dark rename to packages/darklang/languageTools/_parser/matchPattern.dark diff --git a/packages/darklang/languageTools/parser/moduleDeclaration.dark b/packages/darklang/languageTools/_parser/moduleDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/parser/moduleDeclaration.dark rename to packages/darklang/languageTools/_parser/moduleDeclaration.dark diff --git a/packages/darklang/languageTools/parser/parserTest.dark b/packages/darklang/languageTools/_parser/parserTest.dark similarity index 100% rename from packages/darklang/languageTools/parser/parserTest.dark rename to packages/darklang/languageTools/_parser/parserTest.dark diff --git a/packages/darklang/languageTools/parser/pipeExpr.dark b/packages/darklang/languageTools/_parser/pipeExpr.dark similarity index 100% rename from packages/darklang/languageTools/parser/pipeExpr.dark rename to packages/darklang/languageTools/_parser/pipeExpr.dark diff --git a/packages/darklang/languageTools/parser/sourceFile.dark b/packages/darklang/languageTools/_parser/sourceFile.dark similarity index 100% rename from packages/darklang/languageTools/parser/sourceFile.dark rename to packages/darklang/languageTools/_parser/sourceFile.dark diff --git a/packages/darklang/languageTools/parser/typeDeclaration.dark b/packages/darklang/languageTools/_parser/typeDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/parser/typeDeclaration.dark rename to packages/darklang/languageTools/_parser/typeDeclaration.dark diff --git a/packages/darklang/languageTools/parser/typeReference.dark b/packages/darklang/languageTools/_parser/typeReference.dark similarity index 100% rename from packages/darklang/languageTools/parser/typeReference.dark rename to packages/darklang/languageTools/_parser/typeReference.dark diff --git a/packages/darklang/languageTools/runtimeErrors/cli.dark b/packages/darklang/languageTools/_runtimeErrors/cli.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/cli.dark rename to packages/darklang/languageTools/_runtimeErrors/cli.dark diff --git a/packages/darklang/languageTools/runtimeErrors/execution.dark b/packages/darklang/languageTools/_runtimeErrors/execution.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/execution.dark rename to packages/darklang/languageTools/_runtimeErrors/execution.dark diff --git a/packages/darklang/languageTools/runtimeErrors/int.dark b/packages/darklang/languageTools/_runtimeErrors/int.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/int.dark rename to packages/darklang/languageTools/_runtimeErrors/int.dark diff --git a/packages/darklang/languageTools/runtimeErrors/json.dark b/packages/darklang/languageTools/_runtimeErrors/json.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/json.dark rename to packages/darklang/languageTools/_runtimeErrors/json.dark diff --git a/packages/darklang/languageTools/runtimeErrors/nameResolution.dark b/packages/darklang/languageTools/_runtimeErrors/nameResolution.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/nameResolution.dark rename to packages/darklang/languageTools/_runtimeErrors/nameResolution.dark diff --git a/packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark b/packages/darklang/languageTools/_runtimeErrors/runtimeErrors.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark rename to packages/darklang/languageTools/_runtimeErrors/runtimeErrors.dark diff --git a/packages/darklang/languageTools/runtimeErrors/typeChecker.dark b/packages/darklang/languageTools/_runtimeErrors/typeChecker.dark similarity index 100% rename from packages/darklang/languageTools/runtimeErrors/typeChecker.dark rename to packages/darklang/languageTools/_runtimeErrors/typeChecker.dark diff --git a/packages/darklang/languageTools/semanticTokens.dark b/packages/darklang/languageTools/_semanticTokens.dark similarity index 100% rename from packages/darklang/languageTools/semanticTokens.dark rename to packages/darklang/languageTools/_semanticTokens.dark diff --git a/packages/darklang/languageTools/writtenTypes.dark b/packages/darklang/languageTools/_writtenTypes.dark similarity index 100% rename from packages/darklang/languageTools/writtenTypes.dark rename to packages/darklang/languageTools/_writtenTypes.dark diff --git a/packages/darklang/languageTools/writtenTypesToProgramTypes.dark b/packages/darklang/languageTools/_writtenTypesToProgramTypes.dark similarity index 100% rename from packages/darklang/languageTools/writtenTypesToProgramTypes.dark rename to packages/darklang/languageTools/_writtenTypesToProgramTypes.dark diff --git a/packages/darklang/languageTools/programTypes.dark b/packages/darklang/languageTools/programTypes.dark index b948bc794e..256657fa1a 100644 --- a/packages/darklang/languageTools/programTypes.dark +++ b/packages/darklang/languageTools/programTypes.dark @@ -24,8 +24,12 @@ module Darklang = | Package of Package + type NameResolutionError = + | NotFound of List + | InvalidName of List + type NameResolution<'a> = - Stdlib.Result.Result<'a, RuntimeErrors.NameResolution.Error> + Stdlib.Result.Result<'a, NameResolutionError> /// Darklang's available types (int, List, user-defined types, etc.) diff --git a/packages/darklang/languageTools/runtimeTypes.dark b/packages/darklang/languageTools/runtimeTypes.dark index 74fa978f74..48c41ca3ce 100644 --- a/packages/darklang/languageTools/runtimeTypes.dark +++ b/packages/darklang/languageTools/runtimeTypes.dark @@ -25,8 +25,11 @@ module Darklang = | Builtin of Builtin | Package of Package + type NameResolutionError = + | NotFound of List + | InvalidName of List - type NameResolution<'a> = Stdlib.Result.Result<'a, RuntimeError> + type NameResolution<'a> = Stdlib.Result.Result<'a, NameResolutionError> type TypeReference = @@ -58,210 +61,210 @@ module Darklang = | TDict of TypeReference - type MatchCase = - { pat: MatchPattern - whenCondition: Stdlib.Option.Option - rhs: Expr } - - type LetPattern = - | LPVariable of ID * name: String - | LPTuple of - ID * - first: LetPattern * - second: LetPattern * - theRest: List - - type StringSegment = - | StringText of String - | StringInterpolation of Expr - - type MatchPattern = - | MPVariable of ID * String - | MPEnum of ID * caseName: String * fieldPatterns: List - | MPInt64 of ID * Int64 - | MPUInt64 of ID * UInt64 - | MPInt8 of ID * Int8 - | MPUInt8 of ID * UInt8 - | MPInt16 of ID * Int16 - | MPUInt16 of ID * UInt16 - | MPInt32 of ID * Int32 - | MPUInt32 of ID * UInt32 - | MPInt128 of ID * Int128 - | MPUInt128 of ID * UInt128 - | MPBool of ID * Bool - | MPChar of ID * String - | MPString of ID * String - | MPFloat of ID * Float - | MPUnit of ID - | MPTuple of ID * MatchPattern * MatchPattern * List - | MPList of ID * List - | MPListCons of ID * head: MatchPattern * tail: MatchPattern - - type DvalMap = Dict - - type LambdaImpl = - { typeSymbolTable: TypeSymbolTable - symtable: Symtable - parameters: List - body: Expr } - - type FnValImpl = - | Lambda of LambdaImpl - | NamedFn of FQFnName.FQFnName - - type RuntimeError = RuntimeError of Dval.Dval - - type KnownType = - | KTUnit - | KTBool - | KTInt64 - | KTUInt64 - | KTInt8 - | KTUInt8 - | KTInt16 - | KTUInt16 - | KTInt32 - | KTUInt32 - | KTInt128 - | KTUInt128 - | KTFloat - | KTChar - | KTString - | KTUuid - | KTDateTime - | KTList of ValueType - | KTTuple of ValueType * ValueType * List - | KTFn of List * ValueType - - | KTDB of ValueType - | KTCustomType of FQTypeName.FQTypeName * typeArgs: List - - | KTDict of ValueType - - type ValueType = - | Unknown - | Known of KnownType - - - module Dval = - type Dval = - | DUnit - | DBool of Bool - | DInt64 of Int64 - | DUInt64 of UInt64 - | DInt8 of Int8 - | DUInt8 of UInt8 - | DInt16 of Int16 - | DUInt16 of UInt16 - | DInt32 of Int32 - | DUInt32 of UInt32 - | DInt128 of Int128 - | DUInt128 of UInt128 - | DFloat of Float - | DChar of String - | DString of String - | DDateTime of DateTime - | DUuid of Uuid - - | DList of ValueType * List - | DDict of ValueType * DvalMap - | DTuple of Dval * Dval * List - - | DFnVal of FnValImpl - - | DDB of String - - | DRecord of - runtimeTypeName: FQTypeName.FQTypeName * - sourceTypeName: FQTypeName.FQTypeName * - typeArgs: List * - fields: DvalMap - - | DEnum of - runtimeTypeName: FQTypeName.FQTypeName * - sourceTypeName: FQTypeName.FQTypeName * - typeArgs: List * - caseName: String * - fields: List - - - let toValueType (dv: Dval) : ValueType = - let dvalValueTypeTODO = ValueType.Unknown - - match dv with - | DUnit -> ValueType.Known KnownType.KTUnit - | DBool _ -> ValueType.Known KnownType.KTBool - | DInt64 _ -> ValueType.Known KnownType.KTInt64 - | DUInt64 _ -> ValueType.Known KnownType.KTUInt64 - | DInt8 _ -> ValueType.Known KnownType.KTInt8 - | DUInt8 _ -> ValueType.Known KnownType.KTUInt8 - | DInt16 _ -> ValueType.Known KnownType.KTInt16 - | DUInt16 _ -> ValueType.Known KnownType.KTUInt16 - | DInt32 _ -> ValueType.Known KnownType.KTInt32 - | DUInt32 _ -> ValueType.Known KnownType.KTUInt32 - | DInt128 _ -> ValueType.Known KnownType.KTInt128 - | DUInt128 _ -> ValueType.Known KnownType.KTUInt128 - | DFloat _ -> ValueType.Known KnownType.KTFloat - | DChar _ -> ValueType.Known KnownType.KTChar - | DString _ -> ValueType.Known KnownType.KTString - | DUuid _ -> ValueType.Known KnownType.KTUuid - | DDateTime _ -> ValueType.Known KnownType.KTDateTime - - | DList(t, _) -> ValueType.Known(KnownType.KTList t) - | DDict(t, _) -> ValueType.Known(KnownType.KTDict t) - | DTuple(first, second, theRest) -> - (KnownType.KTTuple( - toValueType first, - toValueType second, - theRest |> Stdlib.List.map (fun item -> toValueType item) - )) - |> ValueType.Known - - | DRecord(typeName, _, typeArgs, fields) -> - ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) - - | DEnum(typeName, _, typeArgs, _caseName, _fields) -> - ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) - - | DFnVal fnImpl -> - match fnImpl with - | Lambda lambda -> - let ps = Stdlib.List.map lambda.parameters (fun _ -> ValueType.Unknown) - - ValueType.Known(KnownType.KTFn(ps, ValueType.Unknown)) - - // VTTODO look up type, etc? - | NamedFn _named -> dvalValueTypeTODO - - // CLEANUP follow up when DDB has a typeReference - // or look up the type of the DB by name - | DDB _ -> ValueType.Unknown - - /// our record of any variable bindings in scope - /// - /// i.e. within the execution of `x+y` in - /// `let x = 1; let y = 2; x + y` - /// , we would have a Symtable of - /// `{ "x" => DInt64 1; "y" => DInt64 2 }` - type Symtable = Dict - - type TypeSymbolTable = Dict - - - // Record the source of an incomplete or error. Would be useful to add more - // information later, such as the iteration count that led to this, or - // something like a stack trace - type DvalSource = - // We do not have context to supply an identifier - | SourceNone - - // Caused by an expression of `id` within the given `tlid` - | SourceID of TLID * ID - - type BuiltInParam = - { name: String - typ: TypeReference - blockArgs: List - description: String } - - type Param = { name: String; typ: TypeReference } \ No newline at end of file + // type MatchCase = + // { pat: MatchPattern + // whenCondition: Stdlib.Option.Option + // rhs: Expr } + + // type LetPattern = + // | LPVariable of ID * name: String + // | LPTuple of + // ID * + // first: LetPattern * + // second: LetPattern * + // theRest: List + + // type StringSegment = + // | StringText of String + // | StringInterpolation of Expr + + // type MatchPattern = + // | MPVariable of ID * String + // | MPEnum of ID * caseName: String * fieldPatterns: List + // | MPInt64 of ID * Int64 + // | MPUInt64 of ID * UInt64 + // | MPInt8 of ID * Int8 + // | MPUInt8 of ID * UInt8 + // | MPInt16 of ID * Int16 + // | MPUInt16 of ID * UInt16 + // | MPInt32 of ID * Int32 + // | MPUInt32 of ID * UInt32 + // | MPInt128 of ID * Int128 + // | MPUInt128 of ID * UInt128 + // | MPBool of ID * Bool + // | MPChar of ID * String + // | MPString of ID * String + // | MPFloat of ID * Float + // | MPUnit of ID + // | MPTuple of ID * MatchPattern * MatchPattern * List + // | MPList of ID * List + // | MPListCons of ID * head: MatchPattern * tail: MatchPattern + + // type DvalMap = Dict + + // type LambdaImpl = + // { typeSymbolTable: TypeSymbolTable + // symtable: Symtable + // parameters: List + // body: Expr } + + // type FnValImpl = + // | Lambda of LambdaImpl + // | NamedFn of FQFnName.FQFnName + + // type RuntimeError = RuntimeError of Dval.Dval + + // type KnownType = + // | KTUnit + // | KTBool + // | KTInt64 + // | KTUInt64 + // | KTInt8 + // | KTUInt8 + // | KTInt16 + // | KTUInt16 + // | KTInt32 + // | KTUInt32 + // | KTInt128 + // | KTUInt128 + // | KTFloat + // | KTChar + // | KTString + // | KTUuid + // | KTDateTime + // | KTList of ValueType + // | KTTuple of ValueType * ValueType * List + // | KTFn of List * ValueType + + // | KTDB of ValueType + // | KTCustomType of FQTypeName.FQTypeName * typeArgs: List + + // | KTDict of ValueType + + // type ValueType = + // | Unknown + // | Known of KnownType + + + // module Dval = + // type Dval = + // | DUnit + // | DBool of Bool + // | DInt64 of Int64 + // | DUInt64 of UInt64 + // | DInt8 of Int8 + // | DUInt8 of UInt8 + // | DInt16 of Int16 + // | DUInt16 of UInt16 + // | DInt32 of Int32 + // | DUInt32 of UInt32 + // | DInt128 of Int128 + // | DUInt128 of UInt128 + // | DFloat of Float + // | DChar of String + // | DString of String + // | DDateTime of DateTime + // | DUuid of Uuid + + // | DList of ValueType * List + // | DDict of ValueType * DvalMap + // | DTuple of Dval * Dval * List + + // | DFnVal of FnValImpl + + // | DDB of String + + // | DRecord of + // runtimeTypeName: FQTypeName.FQTypeName * + // sourceTypeName: FQTypeName.FQTypeName * + // typeArgs: List * + // fields: DvalMap + + // | DEnum of + // runtimeTypeName: FQTypeName.FQTypeName * + // sourceTypeName: FQTypeName.FQTypeName * + // typeArgs: List * + // caseName: String * + // fields: List + + + // let toValueType (dv: Dval) : ValueType = + // let dvalValueTypeTODO = ValueType.Unknown + + // match dv with + // | DUnit -> ValueType.Known KnownType.KTUnit + // | DBool _ -> ValueType.Known KnownType.KTBool + // | DInt64 _ -> ValueType.Known KnownType.KTInt64 + // | DUInt64 _ -> ValueType.Known KnownType.KTUInt64 + // | DInt8 _ -> ValueType.Known KnownType.KTInt8 + // | DUInt8 _ -> ValueType.Known KnownType.KTUInt8 + // | DInt16 _ -> ValueType.Known KnownType.KTInt16 + // | DUInt16 _ -> ValueType.Known KnownType.KTUInt16 + // | DInt32 _ -> ValueType.Known KnownType.KTInt32 + // | DUInt32 _ -> ValueType.Known KnownType.KTUInt32 + // | DInt128 _ -> ValueType.Known KnownType.KTInt128 + // | DUInt128 _ -> ValueType.Known KnownType.KTUInt128 + // | DFloat _ -> ValueType.Known KnownType.KTFloat + // | DChar _ -> ValueType.Known KnownType.KTChar + // | DString _ -> ValueType.Known KnownType.KTString + // | DUuid _ -> ValueType.Known KnownType.KTUuid + // | DDateTime _ -> ValueType.Known KnownType.KTDateTime + + // | DList(t, _) -> ValueType.Known(KnownType.KTList t) + // | DDict(t, _) -> ValueType.Known(KnownType.KTDict t) + // | DTuple(first, second, theRest) -> + // (KnownType.KTTuple( + // toValueType first, + // toValueType second, + // theRest |> Stdlib.List.map (fun item -> toValueType item) + // )) + // |> ValueType.Known + + // | DRecord(typeName, _, typeArgs, fields) -> + // ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) + + // | DEnum(typeName, _, typeArgs, _caseName, _fields) -> + // ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) + + // | DFnVal fnImpl -> + // match fnImpl with + // | Lambda lambda -> + // let ps = Stdlib.List.map lambda.parameters (fun _ -> ValueType.Unknown) + + // ValueType.Known(KnownType.KTFn(ps, ValueType.Unknown)) + + // // VTTODO look up type, etc? + // | NamedFn _named -> dvalValueTypeTODO + + // // CLEANUP follow up when DDB has a typeReference + // // or look up the type of the DB by name + // | DDB _ -> ValueType.Unknown + + // /// our record of any variable bindings in scope + // /// + // /// i.e. within the execution of `x+y` in + // /// `let x = 1; let y = 2; x + y` + // /// , we would have a Symtable of + // /// `{ "x" => DInt64 1; "y" => DInt64 2 }` + // type Symtable = Dict + + // type TypeSymbolTable = Dict + + + // // Record the source of an incomplete or error. Would be useful to add more + // // information later, such as the iteration count that led to this, or + // // something like a stack trace + // type DvalSource = + // // We do not have context to supply an identifier + // | SourceNone + + // // Caused by an expression of `id` within the given `tlid` + // | SourceID of TLID * ID + + // type BuiltInParam = + // { name: String + // typ: TypeReference + // blockArgs: List + // description: String } + + // type Param = { name: String; typ: TypeReference } \ No newline at end of file diff --git a/packages/darklang/stdlib/canvas.dark b/packages/darklang/stdlib/_canvas.dark similarity index 100% rename from packages/darklang/stdlib/canvas.dark rename to packages/darklang/stdlib/_canvas.dark diff --git a/packages/darklang/stdlib/cli/bash.dark b/packages/darklang/stdlib/_cli/bash.dark similarity index 100% rename from packages/darklang/stdlib/cli/bash.dark rename to packages/darklang/stdlib/_cli/bash.dark diff --git a/packages/darklang/stdlib/cli/curl.dark b/packages/darklang/stdlib/_cli/curl.dark similarity index 100% rename from packages/darklang/stdlib/cli/curl.dark rename to packages/darklang/stdlib/_cli/curl.dark diff --git a/packages/darklang/stdlib/cli/execution.dark b/packages/darklang/stdlib/_cli/execution.dark similarity index 100% rename from packages/darklang/stdlib/cli/execution.dark rename to packages/darklang/stdlib/_cli/execution.dark diff --git a/packages/darklang/stdlib/cli/gunzip.dark b/packages/darklang/stdlib/_cli/gunzip.dark similarity index 100% rename from packages/darklang/stdlib/cli/gunzip.dark rename to packages/darklang/stdlib/_cli/gunzip.dark diff --git a/packages/darklang/stdlib/cli/host.dark b/packages/darklang/stdlib/_cli/host.dark similarity index 100% rename from packages/darklang/stdlib/cli/host.dark rename to packages/darklang/stdlib/_cli/host.dark diff --git a/packages/darklang/stdlib/cli/unix.dark b/packages/darklang/stdlib/_cli/unix.dark similarity index 100% rename from packages/darklang/stdlib/cli/unix.dark rename to packages/darklang/stdlib/_cli/unix.dark diff --git a/packages/darklang/stdlib/cli/zsh.dark b/packages/darklang/stdlib/_cli/zsh.dark similarity index 100% rename from packages/darklang/stdlib/cli/zsh.dark rename to packages/darklang/stdlib/_cli/zsh.dark diff --git a/packages/darklang/stdlib/db.dark b/packages/darklang/stdlib/_db.dark similarity index 100% rename from packages/darklang/stdlib/db.dark rename to packages/darklang/stdlib/_db.dark diff --git a/packages/darklang/test/test.dark b/packages/darklang/test/_test.dark similarity index 100% rename from packages/darklang/test/test.dark rename to packages/darklang/test/_test.dark diff --git a/packages/internal/tests.dark b/packages/internal/_tests.dark similarity index 100% rename from packages/internal/tests.dark rename to packages/internal/_tests.dark diff --git a/packages/stachu/json.dark b/packages/stachu/_json.dark similarity index 100% rename from packages/stachu/json.dark rename to packages/stachu/_json.dark diff --git a/packages/stachu/timespan.dark b/packages/stachu/_timespan.dark similarity index 100% rename from packages/stachu/timespan.dark rename to packages/stachu/_timespan.dark diff --git a/scripts/build/reload-packages b/scripts/build/reload-packages index 2ab27f4ed7..cfa6f47b91 100755 --- a/scripts/build/reload-packages +++ b/scripts/build/reload-packages @@ -30,18 +30,18 @@ fi ./scripts/run-local-exec $PUBLISHED_FLAG load-packages-to-internal-sql-tables > $LOG_CANVAS 2>&1 - - -if [[ "$TEST" != "true" ]]; then - echo "Waiting for BwdServer to be ready" - for i in {1..100}; do - if curl -s -o /dev/null "localhost:${DARK_CONFIG_BWDSERVER_KUBERNETES_PORT}" ; then - break - fi - printf '.' - sleep 0.1 - done - - echo -e "Reloading dark-packages canvas ${grey}($LOG_CANVAS)${reset}" - ./scripts/run-local-exec $PUBLISHED_FLAG reload-dark-packages >> $LOG_CANVAS 2>&1 -fi \ No newline at end of file +echo -e "Done loading packages to internal SQL tables" + +# if [[ "$TEST" != "true" ]]; then +# echo "Waiting for BwdServer to be ready" +# for i in {1..100}; do +# if curl -s -o /dev/null "localhost:${DARK_CONFIG_BWDSERVER_KUBERNETES_PORT}" ; then +# break +# fi +# printf '.' +# sleep 0.1 +# done + +# echo -e "Reloading dark-packages canvas ${grey}($LOG_CANVAS)${reset}" +# ./scripts/run-local-exec $PUBLISHED_FLAG reload-dark-packages >> $LOG_CANVAS 2>&1 +# fi \ No newline at end of file From 4f54d374303e10bff56f4b21fb7dffa9fed350e0 Mon Sep 17 00:00:00 2001 From: Ocean Date: Thu, 19 Sep 2024 11:56:32 +0000 Subject: [PATCH 44/60] uncomment many packages --- packages/darklang/{_cli => cli}/cli.dark | 0 .../{_cli => cli}/local-install/README.md | 0 .../{_cli => cli}/local-install/config.dark | 0 .../{_cli => cli}/local-install/install.dark | 0 .../{_cli => cli}/local-install/main.dark | 0 .../local-install/uninstall.dark | 0 ..._dark-packages.dark => dark-packages.dark} | 0 .../darklang/{_github.dark => github.dark} | 0 .../{_internal.dark => internal.dark} | 0 .../{_json-rpc.dark => json-rpc.dark} | 0 .../README.md | 0 .../common.dark | 0 .../documentSync/README.md | 0 .../documentSync/common.dark | 0 .../documentSync/notebook.dark | 0 .../documentSync/textDocument.dark | 0 .../io.dark | 0 .../language/callHierarchy.dark | 0 .../language/codeAction.dark | 0 .../language/codeLens.dark | 0 .../language/colorProvider.dark | 0 .../language/completion.dark | 0 .../language/diagnostics.dark | 0 .../language/documentHighlight.dark | 0 .../language/documentSymbols.dark | 0 .../language/findReferences.dark | 0 .../language/foldingRange.dark | 0 .../language/formatting.dark | 0 .../language/getDocumentLinks.dark | 0 .../language/goToDeclaration.dark | 0 .../language/goToDefinition.dark | 0 .../language/goToImplementation.dark | 0 .../language/handleRename.dark | 0 .../language/inlayHint.dark | 0 .../language/inlineCompletion.dark | 0 .../language/inlineValue.dark | 0 .../language/linkedEditingRange.dark | 0 .../language/monikor.dark | 0 .../language/onHover.dark | 0 .../language/selectionRange.dark | 0 .../language/semanticToken.dark | 0 .../language/signatureHelp.dark | 0 .../language/typeDefinition.dark | 0 .../language/typeHierarchy.dark | 0 .../lifecycle/capabilityRegistration.dark | 0 .../lifecycle/exit.dark | 0 .../lifecycle/initialize.dark | 0 .../lifecycle/initialized.dark | 0 .../lifecycle/shutdown.dark | 0 .../tracing.dark | 0 .../window/logMessage.dark | 0 .../window/showDocument.dark | 0 .../window/showMessage.dark | 0 .../window/showMessageRequest.dark | 0 .../window/telemetry.dark | 0 .../workInProgress.dark | 0 .../workspace/configuration.dark | 0 .../workspace/executeCommand.dark | 0 .../workspace/fileOperations.dark | 0 .../workspace/onDidChangeWatchedFiles.dark | 0 .../workspace/workspaceEdit.dark | 0 .../workspace/workspaceFolder.dark | 0 .../workspace/workspaceSymbols.dark | 0 .../darklang/languageTools/_nameResolver.dark | 315 ------------------ .../aaaa-state.dark} | 0 .../completions.dark | 0 .../diagnostics.dark | 0 .../{_lsp-server => lsp-server}/docSync.dark | 0 .../handleIncomingMessage.dark | 0 .../initialize.dark | 0 .../{_lsp-server => lsp-server}/logging.dark | 0 .../lsp-server.dark | 0 .../semanticTokens.dark | 0 .../languageTools/{_lsp.dark => lsp.dark} | 0 .../darklang/languageTools/nameResolver.dark | 315 ++++++++++++++++++ ...ackageManager.dark => packageManager.dark} | 0 .../{_parser => parser}/canvas.dark | 0 .../{_parser => parser}/cliScript.dark | 0 .../constantDeclaration.dark | 0 .../{_parser => parser}/core.dark | 0 .../{_parser => parser}/expr.dark | 0 .../functionDeclaration.dark | 0 .../{_parser => parser}/identifiers.dark | 0 .../{_parser => parser}/matchPattern.dark | 0 .../moduleDeclaration.dark | 0 .../{_parser => parser}/parserTest.dark | 0 .../{_parser => parser}/pipeExpr.dark | 0 .../{_parser => parser}/sourceFile.dark | 0 .../{_parser => parser}/typeDeclaration.dark | 0 .../{_parser => parser}/typeReference.dark | 0 ...emanticTokens.dark => semanticTokens.dark} | 0 .../{_writtenTypes.dark => writtenTypes.dark} | 0 ...s.dark => writtenTypesToProgramTypes.dark} | 0 .../darklang/{_openai.dark => openai.dark} | 0 .../_runtimeTypes.dark} | 0 .../canvas.dark | 0 .../cliScript.dark | 0 .../common.dark | 0 .../moduleDeclaration.dark | 0 .../packages.dark | 0 .../programTypes.dark | 33 +- .../stdlib/{_canvas.dark => canvas.dark} | 0 .../darklang/stdlib/{_cli => cli}/bash.dark | 0 .../darklang/stdlib/{_cli => cli}/curl.dark | 0 .../stdlib/{_cli => cli}/execution.dark | 0 .../darklang/stdlib/{_cli => cli}/gunzip.dark | 0 .../darklang/stdlib/{_cli => cli}/host.dark | 0 .../darklang/stdlib/{_cli => cli}/unix.dark | 0 .../darklang/stdlib/{_cli => cli}/zsh.dark | 0 .../darklang/test/{_test.dark => test.dark} | 0 packages/internal/{_tests.dark => tests.dark} | 0 packages/stachu/{_json.dark => json.dark} | 0 .../stachu/{_timespan.dark => timespan.dark} | 0 113 files changed, 337 insertions(+), 326 deletions(-) rename packages/darklang/{_cli => cli}/cli.dark (100%) rename packages/darklang/{_cli => cli}/local-install/README.md (100%) rename packages/darklang/{_cli => cli}/local-install/config.dark (100%) rename packages/darklang/{_cli => cli}/local-install/install.dark (100%) rename packages/darklang/{_cli => cli}/local-install/main.dark (100%) rename packages/darklang/{_cli => cli}/local-install/uninstall.dark (100%) rename packages/darklang/{_dark-packages.dark => dark-packages.dark} (100%) rename packages/darklang/{_github.dark => github.dark} (100%) rename packages/darklang/{_internal.dark => internal.dark} (100%) rename packages/darklang/{_json-rpc.dark => json-rpc.dark} (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/README.md (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/common.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/documentSync/README.md (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/documentSync/common.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/documentSync/notebook.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/documentSync/textDocument.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/io.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/callHierarchy.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/codeAction.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/codeLens.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/colorProvider.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/completion.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/diagnostics.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/documentHighlight.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/documentSymbols.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/findReferences.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/foldingRange.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/formatting.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/getDocumentLinks.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/goToDeclaration.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/goToDefinition.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/goToImplementation.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/handleRename.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/inlayHint.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/inlineCompletion.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/inlineValue.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/linkedEditingRange.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/monikor.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/onHover.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/selectionRange.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/semanticToken.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/signatureHelp.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/typeDefinition.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/language/typeHierarchy.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/lifecycle/capabilityRegistration.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/lifecycle/exit.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/lifecycle/initialize.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/lifecycle/initialized.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/lifecycle/shutdown.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/tracing.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/window/logMessage.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/window/showDocument.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/window/showMessage.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/window/showMessageRequest.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/window/telemetry.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workInProgress.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/configuration.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/executeCommand.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/fileOperations.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/onDidChangeWatchedFiles.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/workspaceEdit.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/workspaceFolder.dark (100%) rename packages/darklang/{_languageServerProtocol => languageServerProtocol}/workspace/workspaceSymbols.dark (100%) delete mode 100644 packages/darklang/languageTools/_nameResolver.dark rename packages/darklang/languageTools/{_lsp-server/aaaa_state.dark => lsp-server/aaaa-state.dark} (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/completions.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/diagnostics.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/docSync.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/handleIncomingMessage.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/initialize.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/logging.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/lsp-server.dark (100%) rename packages/darklang/languageTools/{_lsp-server => lsp-server}/semanticTokens.dark (100%) rename packages/darklang/languageTools/{_lsp.dark => lsp.dark} (100%) create mode 100644 packages/darklang/languageTools/nameResolver.dark rename packages/darklang/languageTools/{_packageManager.dark => packageManager.dark} (100%) rename packages/darklang/languageTools/{_parser => parser}/canvas.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/cliScript.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/constantDeclaration.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/core.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/expr.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/functionDeclaration.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/identifiers.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/matchPattern.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/moduleDeclaration.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/parserTest.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/pipeExpr.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/sourceFile.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/typeDeclaration.dark (100%) rename packages/darklang/languageTools/{_parser => parser}/typeReference.dark (100%) rename packages/darklang/languageTools/{_semanticTokens.dark => semanticTokens.dark} (100%) rename packages/darklang/languageTools/{_writtenTypes.dark => writtenTypes.dark} (100%) rename packages/darklang/languageTools/{_writtenTypesToProgramTypes.dark => writtenTypesToProgramTypes.dark} (100%) rename packages/darklang/{_openai.dark => openai.dark} (100%) rename packages/darklang/{_prettyPrinter/runtimeTypes.dark => prettyPrinter/_runtimeTypes.dark} (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/canvas.dark (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/cliScript.dark (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/common.dark (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/moduleDeclaration.dark (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/packages.dark (100%) rename packages/darklang/{_prettyPrinter => prettyPrinter}/programTypes.dark (96%) rename packages/darklang/stdlib/{_canvas.dark => canvas.dark} (100%) rename packages/darklang/stdlib/{_cli => cli}/bash.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/curl.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/execution.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/gunzip.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/host.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/unix.dark (100%) rename packages/darklang/stdlib/{_cli => cli}/zsh.dark (100%) rename packages/darklang/test/{_test.dark => test.dark} (100%) rename packages/internal/{_tests.dark => tests.dark} (100%) rename packages/stachu/{_json.dark => json.dark} (100%) rename packages/stachu/{_timespan.dark => timespan.dark} (100%) diff --git a/packages/darklang/_cli/cli.dark b/packages/darklang/cli/cli.dark similarity index 100% rename from packages/darklang/_cli/cli.dark rename to packages/darklang/cli/cli.dark diff --git a/packages/darklang/_cli/local-install/README.md b/packages/darklang/cli/local-install/README.md similarity index 100% rename from packages/darklang/_cli/local-install/README.md rename to packages/darklang/cli/local-install/README.md diff --git a/packages/darklang/_cli/local-install/config.dark b/packages/darklang/cli/local-install/config.dark similarity index 100% rename from packages/darklang/_cli/local-install/config.dark rename to packages/darklang/cli/local-install/config.dark diff --git a/packages/darklang/_cli/local-install/install.dark b/packages/darklang/cli/local-install/install.dark similarity index 100% rename from packages/darklang/_cli/local-install/install.dark rename to packages/darklang/cli/local-install/install.dark diff --git a/packages/darklang/_cli/local-install/main.dark b/packages/darklang/cli/local-install/main.dark similarity index 100% rename from packages/darklang/_cli/local-install/main.dark rename to packages/darklang/cli/local-install/main.dark diff --git a/packages/darklang/_cli/local-install/uninstall.dark b/packages/darklang/cli/local-install/uninstall.dark similarity index 100% rename from packages/darklang/_cli/local-install/uninstall.dark rename to packages/darklang/cli/local-install/uninstall.dark diff --git a/packages/darklang/_dark-packages.dark b/packages/darklang/dark-packages.dark similarity index 100% rename from packages/darklang/_dark-packages.dark rename to packages/darklang/dark-packages.dark diff --git a/packages/darklang/_github.dark b/packages/darklang/github.dark similarity index 100% rename from packages/darklang/_github.dark rename to packages/darklang/github.dark diff --git a/packages/darklang/_internal.dark b/packages/darklang/internal.dark similarity index 100% rename from packages/darklang/_internal.dark rename to packages/darklang/internal.dark diff --git a/packages/darklang/_json-rpc.dark b/packages/darklang/json-rpc.dark similarity index 100% rename from packages/darklang/_json-rpc.dark rename to packages/darklang/json-rpc.dark diff --git a/packages/darklang/_languageServerProtocol/README.md b/packages/darklang/languageServerProtocol/README.md similarity index 100% rename from packages/darklang/_languageServerProtocol/README.md rename to packages/darklang/languageServerProtocol/README.md diff --git a/packages/darklang/_languageServerProtocol/common.dark b/packages/darklang/languageServerProtocol/common.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/common.dark rename to packages/darklang/languageServerProtocol/common.dark diff --git a/packages/darklang/_languageServerProtocol/documentSync/README.md b/packages/darklang/languageServerProtocol/documentSync/README.md similarity index 100% rename from packages/darklang/_languageServerProtocol/documentSync/README.md rename to packages/darklang/languageServerProtocol/documentSync/README.md diff --git a/packages/darklang/_languageServerProtocol/documentSync/common.dark b/packages/darklang/languageServerProtocol/documentSync/common.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/documentSync/common.dark rename to packages/darklang/languageServerProtocol/documentSync/common.dark diff --git a/packages/darklang/_languageServerProtocol/documentSync/notebook.dark b/packages/darklang/languageServerProtocol/documentSync/notebook.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/documentSync/notebook.dark rename to packages/darklang/languageServerProtocol/documentSync/notebook.dark diff --git a/packages/darklang/_languageServerProtocol/documentSync/textDocument.dark b/packages/darklang/languageServerProtocol/documentSync/textDocument.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/documentSync/textDocument.dark rename to packages/darklang/languageServerProtocol/documentSync/textDocument.dark diff --git a/packages/darklang/_languageServerProtocol/io.dark b/packages/darklang/languageServerProtocol/io.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/io.dark rename to packages/darklang/languageServerProtocol/io.dark diff --git a/packages/darklang/_languageServerProtocol/language/callHierarchy.dark b/packages/darklang/languageServerProtocol/language/callHierarchy.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/callHierarchy.dark rename to packages/darklang/languageServerProtocol/language/callHierarchy.dark diff --git a/packages/darklang/_languageServerProtocol/language/codeAction.dark b/packages/darklang/languageServerProtocol/language/codeAction.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/codeAction.dark rename to packages/darklang/languageServerProtocol/language/codeAction.dark diff --git a/packages/darklang/_languageServerProtocol/language/codeLens.dark b/packages/darklang/languageServerProtocol/language/codeLens.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/codeLens.dark rename to packages/darklang/languageServerProtocol/language/codeLens.dark diff --git a/packages/darklang/_languageServerProtocol/language/colorProvider.dark b/packages/darklang/languageServerProtocol/language/colorProvider.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/colorProvider.dark rename to packages/darklang/languageServerProtocol/language/colorProvider.dark diff --git a/packages/darklang/_languageServerProtocol/language/completion.dark b/packages/darklang/languageServerProtocol/language/completion.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/completion.dark rename to packages/darklang/languageServerProtocol/language/completion.dark diff --git a/packages/darklang/_languageServerProtocol/language/diagnostics.dark b/packages/darklang/languageServerProtocol/language/diagnostics.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/diagnostics.dark rename to packages/darklang/languageServerProtocol/language/diagnostics.dark diff --git a/packages/darklang/_languageServerProtocol/language/documentHighlight.dark b/packages/darklang/languageServerProtocol/language/documentHighlight.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/documentHighlight.dark rename to packages/darklang/languageServerProtocol/language/documentHighlight.dark diff --git a/packages/darklang/_languageServerProtocol/language/documentSymbols.dark b/packages/darklang/languageServerProtocol/language/documentSymbols.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/documentSymbols.dark rename to packages/darklang/languageServerProtocol/language/documentSymbols.dark diff --git a/packages/darklang/_languageServerProtocol/language/findReferences.dark b/packages/darklang/languageServerProtocol/language/findReferences.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/findReferences.dark rename to packages/darklang/languageServerProtocol/language/findReferences.dark diff --git a/packages/darklang/_languageServerProtocol/language/foldingRange.dark b/packages/darklang/languageServerProtocol/language/foldingRange.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/foldingRange.dark rename to packages/darklang/languageServerProtocol/language/foldingRange.dark diff --git a/packages/darklang/_languageServerProtocol/language/formatting.dark b/packages/darklang/languageServerProtocol/language/formatting.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/formatting.dark rename to packages/darklang/languageServerProtocol/language/formatting.dark diff --git a/packages/darklang/_languageServerProtocol/language/getDocumentLinks.dark b/packages/darklang/languageServerProtocol/language/getDocumentLinks.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/getDocumentLinks.dark rename to packages/darklang/languageServerProtocol/language/getDocumentLinks.dark diff --git a/packages/darklang/_languageServerProtocol/language/goToDeclaration.dark b/packages/darklang/languageServerProtocol/language/goToDeclaration.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/goToDeclaration.dark rename to packages/darklang/languageServerProtocol/language/goToDeclaration.dark diff --git a/packages/darklang/_languageServerProtocol/language/goToDefinition.dark b/packages/darklang/languageServerProtocol/language/goToDefinition.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/goToDefinition.dark rename to packages/darklang/languageServerProtocol/language/goToDefinition.dark diff --git a/packages/darklang/_languageServerProtocol/language/goToImplementation.dark b/packages/darklang/languageServerProtocol/language/goToImplementation.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/goToImplementation.dark rename to packages/darklang/languageServerProtocol/language/goToImplementation.dark diff --git a/packages/darklang/_languageServerProtocol/language/handleRename.dark b/packages/darklang/languageServerProtocol/language/handleRename.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/handleRename.dark rename to packages/darklang/languageServerProtocol/language/handleRename.dark diff --git a/packages/darklang/_languageServerProtocol/language/inlayHint.dark b/packages/darklang/languageServerProtocol/language/inlayHint.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/inlayHint.dark rename to packages/darklang/languageServerProtocol/language/inlayHint.dark diff --git a/packages/darklang/_languageServerProtocol/language/inlineCompletion.dark b/packages/darklang/languageServerProtocol/language/inlineCompletion.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/inlineCompletion.dark rename to packages/darklang/languageServerProtocol/language/inlineCompletion.dark diff --git a/packages/darklang/_languageServerProtocol/language/inlineValue.dark b/packages/darklang/languageServerProtocol/language/inlineValue.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/inlineValue.dark rename to packages/darklang/languageServerProtocol/language/inlineValue.dark diff --git a/packages/darklang/_languageServerProtocol/language/linkedEditingRange.dark b/packages/darklang/languageServerProtocol/language/linkedEditingRange.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/linkedEditingRange.dark rename to packages/darklang/languageServerProtocol/language/linkedEditingRange.dark diff --git a/packages/darklang/_languageServerProtocol/language/monikor.dark b/packages/darklang/languageServerProtocol/language/monikor.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/monikor.dark rename to packages/darklang/languageServerProtocol/language/monikor.dark diff --git a/packages/darklang/_languageServerProtocol/language/onHover.dark b/packages/darklang/languageServerProtocol/language/onHover.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/onHover.dark rename to packages/darklang/languageServerProtocol/language/onHover.dark diff --git a/packages/darklang/_languageServerProtocol/language/selectionRange.dark b/packages/darklang/languageServerProtocol/language/selectionRange.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/selectionRange.dark rename to packages/darklang/languageServerProtocol/language/selectionRange.dark diff --git a/packages/darklang/_languageServerProtocol/language/semanticToken.dark b/packages/darklang/languageServerProtocol/language/semanticToken.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/semanticToken.dark rename to packages/darklang/languageServerProtocol/language/semanticToken.dark diff --git a/packages/darklang/_languageServerProtocol/language/signatureHelp.dark b/packages/darklang/languageServerProtocol/language/signatureHelp.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/signatureHelp.dark rename to packages/darklang/languageServerProtocol/language/signatureHelp.dark diff --git a/packages/darklang/_languageServerProtocol/language/typeDefinition.dark b/packages/darklang/languageServerProtocol/language/typeDefinition.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/typeDefinition.dark rename to packages/darklang/languageServerProtocol/language/typeDefinition.dark diff --git a/packages/darklang/_languageServerProtocol/language/typeHierarchy.dark b/packages/darklang/languageServerProtocol/language/typeHierarchy.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/language/typeHierarchy.dark rename to packages/darklang/languageServerProtocol/language/typeHierarchy.dark diff --git a/packages/darklang/_languageServerProtocol/lifecycle/capabilityRegistration.dark b/packages/darklang/languageServerProtocol/lifecycle/capabilityRegistration.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/lifecycle/capabilityRegistration.dark rename to packages/darklang/languageServerProtocol/lifecycle/capabilityRegistration.dark diff --git a/packages/darklang/_languageServerProtocol/lifecycle/exit.dark b/packages/darklang/languageServerProtocol/lifecycle/exit.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/lifecycle/exit.dark rename to packages/darklang/languageServerProtocol/lifecycle/exit.dark diff --git a/packages/darklang/_languageServerProtocol/lifecycle/initialize.dark b/packages/darklang/languageServerProtocol/lifecycle/initialize.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/lifecycle/initialize.dark rename to packages/darklang/languageServerProtocol/lifecycle/initialize.dark diff --git a/packages/darklang/_languageServerProtocol/lifecycle/initialized.dark b/packages/darklang/languageServerProtocol/lifecycle/initialized.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/lifecycle/initialized.dark rename to packages/darklang/languageServerProtocol/lifecycle/initialized.dark diff --git a/packages/darklang/_languageServerProtocol/lifecycle/shutdown.dark b/packages/darklang/languageServerProtocol/lifecycle/shutdown.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/lifecycle/shutdown.dark rename to packages/darklang/languageServerProtocol/lifecycle/shutdown.dark diff --git a/packages/darklang/_languageServerProtocol/tracing.dark b/packages/darklang/languageServerProtocol/tracing.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/tracing.dark rename to packages/darklang/languageServerProtocol/tracing.dark diff --git a/packages/darklang/_languageServerProtocol/window/logMessage.dark b/packages/darklang/languageServerProtocol/window/logMessage.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/window/logMessage.dark rename to packages/darklang/languageServerProtocol/window/logMessage.dark diff --git a/packages/darklang/_languageServerProtocol/window/showDocument.dark b/packages/darklang/languageServerProtocol/window/showDocument.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/window/showDocument.dark rename to packages/darklang/languageServerProtocol/window/showDocument.dark diff --git a/packages/darklang/_languageServerProtocol/window/showMessage.dark b/packages/darklang/languageServerProtocol/window/showMessage.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/window/showMessage.dark rename to packages/darklang/languageServerProtocol/window/showMessage.dark diff --git a/packages/darklang/_languageServerProtocol/window/showMessageRequest.dark b/packages/darklang/languageServerProtocol/window/showMessageRequest.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/window/showMessageRequest.dark rename to packages/darklang/languageServerProtocol/window/showMessageRequest.dark diff --git a/packages/darklang/_languageServerProtocol/window/telemetry.dark b/packages/darklang/languageServerProtocol/window/telemetry.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/window/telemetry.dark rename to packages/darklang/languageServerProtocol/window/telemetry.dark diff --git a/packages/darklang/_languageServerProtocol/workInProgress.dark b/packages/darklang/languageServerProtocol/workInProgress.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workInProgress.dark rename to packages/darklang/languageServerProtocol/workInProgress.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/configuration.dark b/packages/darklang/languageServerProtocol/workspace/configuration.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/configuration.dark rename to packages/darklang/languageServerProtocol/workspace/configuration.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/executeCommand.dark b/packages/darklang/languageServerProtocol/workspace/executeCommand.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/executeCommand.dark rename to packages/darklang/languageServerProtocol/workspace/executeCommand.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/fileOperations.dark b/packages/darklang/languageServerProtocol/workspace/fileOperations.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/fileOperations.dark rename to packages/darklang/languageServerProtocol/workspace/fileOperations.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/onDidChangeWatchedFiles.dark b/packages/darklang/languageServerProtocol/workspace/onDidChangeWatchedFiles.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/onDidChangeWatchedFiles.dark rename to packages/darklang/languageServerProtocol/workspace/onDidChangeWatchedFiles.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/workspaceEdit.dark b/packages/darklang/languageServerProtocol/workspace/workspaceEdit.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/workspaceEdit.dark rename to packages/darklang/languageServerProtocol/workspace/workspaceEdit.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/workspaceFolder.dark b/packages/darklang/languageServerProtocol/workspace/workspaceFolder.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/workspaceFolder.dark rename to packages/darklang/languageServerProtocol/workspace/workspaceFolder.dark diff --git a/packages/darklang/_languageServerProtocol/workspace/workspaceSymbols.dark b/packages/darklang/languageServerProtocol/workspace/workspaceSymbols.dark similarity index 100% rename from packages/darklang/_languageServerProtocol/workspace/workspaceSymbols.dark rename to packages/darklang/languageServerProtocol/workspace/workspaceSymbols.dark diff --git a/packages/darklang/languageTools/_nameResolver.dark b/packages/darklang/languageTools/_nameResolver.dark deleted file mode 100644 index f12d5ef07d..0000000000 --- a/packages/darklang/languageTools/_nameResolver.dark +++ /dev/null @@ -1,315 +0,0 @@ -module Darklang = - module LanguageTools = - module NameResolver = - - /// If a name is not found, should we raise an error? - /// - /// sometimes when parsing, we're not sure whether something is: - /// - a variable - /// - or something else, like a constant or fn. - /// During these times, and others, we wantto allow errors, so we can - /// parse it as a variable as a fallback if nothing is found under that name. - type OnMissing = - | ThrowError - | Allow - - // TODO: we should probably just return the Result, and let the caller - // handle the error if they want to... - let throwIfRelevant - (onMissing: OnMissing) - (result: ProgramTypes.NameResolution<'a>) - : ProgramTypes.NameResolution<'a> = - result - |> Stdlib.Result.mapError (fun err -> - match onMissing with - | ThrowError -> err // TODO: something - | Allow -> err) - - - type GenericName = - { modules: List - name: String - version: Int64 } - - /// If we're 'given' the name `Option.Option` - /// and we're parsing in `Darklang.Stdlib`, - /// - /// We should look for the thing in the following places: - /// - Darklang.Stdlib.Option.Option - /// - Darklang.Option.Option - /// - Option.Option - /// , in that order (most specific first). - let namesToTry - (owner: String) - (currentModule: List) - (given: GenericName) - : List = - let addl = - match given.modules with - | "Stdlib" :: _ -> - [ { given with - modules = Stdlib.List.append [ "Darklang" ] given.modules } ] - | "PACKAGE" :: owner :: modules -> - [ { given with - modules = Stdlib.List.append [ owner ] modules } ] - | _ -> [] - - let currentModule = Stdlib.List.append [ owner ] currentModule - Stdlib.List.append (namesToTryHelper currentModule given) addl - - // TODO we can do this without a helper function, - // by removing the recursion and using a fold. - let namesToTryHelper - (modulesToPrepend: List) - (given: GenericName) - : List = - match Stdlib.List.splitLast modulesToPrepend with - | None -> [ given ] - | Some((allButLast, _last)) -> - let newNameToTry = - { given with - modules = Stdlib.List.append modulesToPrepend given.modules } - - Stdlib.List.append [ newNameToTry ] (namesToTryHelper allButLast given) - - - module TypeName = - let err - (errType: RuntimeErrors.NameResolution.ErrorType) - : ProgramTypes.NameResolution = - (LanguageTools.RuntimeErrors.NameResolution.Error - { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Type - errorType = errType }) - |> Stdlib.Result.Result.Error - - - let tryResolve - (pm: ProgramTypes.PackageManager.PackageManager) - (name: GenericName) - : Stdlib.Result.Result = - match name.modules with - | [] -> Stdlib.Result.Result.Error() - | owner :: modules -> - let nameForLookup = - (Stdlib.List.flatten [ name.modules; [ name.name ] ]) - |> Stdlib.String.join "." - - let find = pm.findType - - match find nameForLookup with - | Some id -> - (ProgramTypes.FQTypeName.FQTypeName.Package id) - |> Stdlib.Result.Result.Ok - | None -> Stdlib.Result.Result.Error() - - - let resolve - (onMissing: OnMissing) - (pm: ProgramTypes.PackageManager.PackageManager) - (owner: String) - (currentModule: List) - (name: WrittenTypes.Name) - : ProgramTypes.NameResolution = - match name with - // TODO remodel things appropriately so this is not needed - | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error - - | Unresolved(_range, given) -> - let modules = Stdlib.List.dropLast given - let name = Stdlib.List.last given - - // TODO: handle versions... (parse out the _v[n] part if present) - match name with - | None -> - err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) - | Some name -> - let genericName = - GenericName - { modules = modules - name = name - version = 0L } - - let result = - Stdlib.List.fold - (namesToTry owner currentModule genericName) - (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) - (fun currentResult nameToTry -> - match currentResult with - | Ok _ -> currentResult - | Error _ -> - match tryResolve pm nameToTry with - | Error() -> currentResult - | Ok success -> Stdlib.Result.Result.Ok success) - - throwIfRelevant onMissing result - - - - module ConstantName = - let err - (errType: RuntimeErrors.NameResolution.ErrorType) - : ProgramTypes.NameResolution = - (LanguageTools.RuntimeErrors.NameResolution.Error - { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Constant - errorType = errType }) - |> Stdlib.Result.Result.Error - - let builtinThingExists (name: String) : Bool = - (Builtin.languageToolsAllBuiltinConstants ()) - |> Stdlib.List.findFirst (fun f -> f.name == name) - |> Stdlib.Option.isSome - - let tryResolve - (pm: ProgramTypes.PackageManager.PackageManager) - (name: GenericName) - : Stdlib.Result.Result = - match name.modules with - | [] -> Stdlib.Result.Result.Error() - | owner :: modules -> - let nameForLookup = - (Stdlib.List.flatten [ name.modules; [ name.name ] ]) - |> Stdlib.String.join "." - - if owner == "Builtin" && modules == [] then - if builtinThingExists name.name then - (ProgramTypes.FQConstantName.Builtin - { name = name.name - version = name.version }) - |> ProgramTypes.FQConstantName.FQConstantName.Builtin - |> Stdlib.Result.Result.Ok - else - Stdlib.Result.Result.Error() - else - let find = pm.findConstant - - match find nameForLookup with - | Some id -> - (ProgramTypes.FQConstantName.FQConstantName.Package id) - |> Stdlib.Result.Result.Ok - | None -> Stdlib.Result.Result.Error() - - - let resolve - (onMissing: OnMissing) - (pm: ProgramTypes.PackageManager.PackageManager) - (owner: String) - (currentModule: List) - (name: WrittenTypes.Name) - : ProgramTypes.NameResolution = - match name with - // TODO remodel things appropriately so this is not needed - | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error - - | Unresolved(_range, given) -> - let modules = Stdlib.List.dropLast given - let name = Stdlib.List.last given - - // TODO: handle versions... (parse out the _v[n] part if present) - match name with - | None -> - err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) - | Some name -> - let genericName = - GenericName - { modules = modules - name = name - version = 0L } - - let result = - Stdlib.List.fold - (namesToTry owner currentModule genericName) - (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) - (fun currentResult nameToTry -> - match currentResult with - | Ok _ -> currentResult - | Error _ -> - match tryResolve pm nameToTry with - | Error() -> currentResult - | Ok success -> Stdlib.Result.Result.Ok success) - - throwIfRelevant onMissing result - - - - module FnName = - let err - (errType: RuntimeErrors.NameResolution.ErrorType) - : ProgramTypes.NameResolution = - (LanguageTools.RuntimeErrors.NameResolution.Error - { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Function - errorType = errType }) - |> Stdlib.Result.Result.Error - - - let tryResolve - (pm: ProgramTypes.PackageManager.PackageManager) - (name: GenericName) - : Stdlib.Result.Result = - match name.modules with - | [] -> Stdlib.Result.Result.Error() - | owner :: modules -> - if owner == "Builtin" && modules == [] then - if Builtin.languageToolsBuiltinFnExists name.name name.version then - (ProgramTypes.FQFnName.Builtin - { name = name.name - version = name.version }) - |> ProgramTypes.FQFnName.FQFnName.Builtin - |> Stdlib.Result.Result.Ok - else - Stdlib.Result.Result.Error() - else - let nameForLookup = - (Stdlib.List.flatten [ name.modules; [ name.name ] ]) - |> Stdlib.String.join "." - - // CLEANUP: allow this to be inline (i.e. `pm.findFn nameForLookup`) - let find = pm.findFn - - match find nameForLookup with - | Some id -> - (ProgramTypes.FQFnName.FQFnName.Package id) - |> Stdlib.Result.Result.Ok - | None -> Stdlib.Result.Result.Error() - - - let resolve - (onMissing: OnMissing) - (pm: ProgramTypes.PackageManager.PackageManager) - (owner: String) - (currentModule: List) - (name: WrittenTypes.Name) - : ProgramTypes.NameResolution = - match name with - // TODO remodel things appropriately so this is not needed - | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error - - | Unresolved(_range, given) -> - let modules = Stdlib.List.dropLast given - let name = Stdlib.List.last given - - // TODO: handle versions... (parse out the _v[n] part if present) - match name with - | None -> - err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) - | Some name -> - let genericName = - GenericName - { modules = modules - name = name - version = 0L } - - let names = namesToTry owner currentModule genericName - - let result = - Stdlib.List.fold - names - (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) - (fun currentResult nameToTry -> - match currentResult with - | Ok _ -> currentResult - | Error _ -> - match tryResolve pm nameToTry with - | Error() -> currentResult - | Ok success -> Stdlib.Result.Result.Ok success) - - throwIfRelevant onMissing result \ No newline at end of file diff --git a/packages/darklang/languageTools/_lsp-server/aaaa_state.dark b/packages/darklang/languageTools/lsp-server/aaaa-state.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/aaaa_state.dark rename to packages/darklang/languageTools/lsp-server/aaaa-state.dark diff --git a/packages/darklang/languageTools/_lsp-server/completions.dark b/packages/darklang/languageTools/lsp-server/completions.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/completions.dark rename to packages/darklang/languageTools/lsp-server/completions.dark diff --git a/packages/darklang/languageTools/_lsp-server/diagnostics.dark b/packages/darklang/languageTools/lsp-server/diagnostics.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/diagnostics.dark rename to packages/darklang/languageTools/lsp-server/diagnostics.dark diff --git a/packages/darklang/languageTools/_lsp-server/docSync.dark b/packages/darklang/languageTools/lsp-server/docSync.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/docSync.dark rename to packages/darklang/languageTools/lsp-server/docSync.dark diff --git a/packages/darklang/languageTools/_lsp-server/handleIncomingMessage.dark b/packages/darklang/languageTools/lsp-server/handleIncomingMessage.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/handleIncomingMessage.dark rename to packages/darklang/languageTools/lsp-server/handleIncomingMessage.dark diff --git a/packages/darklang/languageTools/_lsp-server/initialize.dark b/packages/darklang/languageTools/lsp-server/initialize.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/initialize.dark rename to packages/darklang/languageTools/lsp-server/initialize.dark diff --git a/packages/darklang/languageTools/_lsp-server/logging.dark b/packages/darklang/languageTools/lsp-server/logging.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/logging.dark rename to packages/darklang/languageTools/lsp-server/logging.dark diff --git a/packages/darklang/languageTools/_lsp-server/lsp-server.dark b/packages/darklang/languageTools/lsp-server/lsp-server.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/lsp-server.dark rename to packages/darklang/languageTools/lsp-server/lsp-server.dark diff --git a/packages/darklang/languageTools/_lsp-server/semanticTokens.dark b/packages/darklang/languageTools/lsp-server/semanticTokens.dark similarity index 100% rename from packages/darklang/languageTools/_lsp-server/semanticTokens.dark rename to packages/darklang/languageTools/lsp-server/semanticTokens.dark diff --git a/packages/darklang/languageTools/_lsp.dark b/packages/darklang/languageTools/lsp.dark similarity index 100% rename from packages/darklang/languageTools/_lsp.dark rename to packages/darklang/languageTools/lsp.dark diff --git a/packages/darklang/languageTools/nameResolver.dark b/packages/darklang/languageTools/nameResolver.dark new file mode 100644 index 0000000000..ab6b1a5386 --- /dev/null +++ b/packages/darklang/languageTools/nameResolver.dark @@ -0,0 +1,315 @@ +module Darklang = + module LanguageTools = + module NameResolver = + + /// If a name is not found, should we raise an error? + /// + /// sometimes when parsing, we're not sure whether something is: + /// - a variable + /// - or something else, like a constant or fn. + /// During these times, and others, we wantto allow errors, so we can + /// parse it as a variable as a fallback if nothing is found under that name. + type OnMissing = + | ThrowError + | Allow + + // TODO: we should probably just return the Result, and let the caller + // handle the error if they want to... + let throwIfRelevant + (onMissing: OnMissing) + (result: ProgramTypes.NameResolution<'a>) + : ProgramTypes.NameResolution<'a> = + result + |> Stdlib.Result.mapError (fun err -> + match onMissing with + | ThrowError -> err // TODO: something + | Allow -> err) + + + type GenericName = + { modules: List + name: String + version: Int64 } + + /// If we're 'given' the name `Option.Option` + /// and we're parsing in `Darklang.Stdlib`, + /// + /// We should look for the thing in the following places: + /// - Darklang.Stdlib.Option.Option + /// - Darklang.Option.Option + /// - Option.Option + /// , in that order (most specific first). + let namesToTry + (owner: String) + (currentModule: List) + (given: GenericName) + : List = + let addl = + match given.modules with + | "Stdlib" :: _ -> + [ { given with + modules = Stdlib.List.append [ "Darklang" ] given.modules } ] + | "PACKAGE" :: owner :: modules -> + [ { given with + modules = Stdlib.List.append [ owner ] modules } ] + | _ -> [] + + let currentModule = Stdlib.List.append [ owner ] currentModule + Stdlib.List.append (namesToTryHelper currentModule given) addl + + // TODO we can do this without a helper function, + // by removing the recursion and using a fold. + let namesToTryHelper + (modulesToPrepend: List) + (given: GenericName) + : List = + match Stdlib.List.splitLast modulesToPrepend with + | None -> [ given ] + | Some((allButLast, _last)) -> + let newNameToTry = + { given with + modules = Stdlib.List.append modulesToPrepend given.modules } + + Stdlib.List.append [ newNameToTry ] (namesToTryHelper allButLast given) + + +// module TypeName = +// let err +// (errType: RuntimeErrors.NameResolution.ErrorType) +// : ProgramTypes.NameResolution = +// (LanguageTools.RuntimeErrors.NameResolution.Error +// { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Type +// errorType = errType }) +// |> Stdlib.Result.Result.Error + + +// let tryResolve +// (pm: ProgramTypes.PackageManager.PackageManager) +// (name: GenericName) +// : Stdlib.Result.Result = +// match name.modules with +// | [] -> Stdlib.Result.Result.Error() +// | owner :: modules -> +// let nameForLookup = +// (Stdlib.List.flatten [ name.modules; [ name.name ] ]) +// |> Stdlib.String.join "." + +// let find = pm.findType + +// match find nameForLookup with +// | Some id -> +// (ProgramTypes.FQTypeName.FQTypeName.Package id) +// |> Stdlib.Result.Result.Ok +// | None -> Stdlib.Result.Result.Error() + + +// let resolve +// (onMissing: OnMissing) +// (pm: ProgramTypes.PackageManager.PackageManager) +// (owner: String) +// (currentModule: List) +// (name: WrittenTypes.Name) +// : ProgramTypes.NameResolution = +// match name with +// // TODO remodel things appropriately so this is not needed +// | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error + +// | Unresolved(_range, given) -> +// let modules = Stdlib.List.dropLast given +// let name = Stdlib.List.last given + +// // TODO: handle versions... (parse out the _v[n] part if present) +// match name with +// | None -> +// err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) +// | Some name -> +// let genericName = +// GenericName +// { modules = modules +// name = name +// version = 0L } + +// let result = +// Stdlib.List.fold +// (namesToTry owner currentModule genericName) +// (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) +// (fun currentResult nameToTry -> +// match currentResult with +// | Ok _ -> currentResult +// | Error _ -> +// match tryResolve pm nameToTry with +// | Error() -> currentResult +// | Ok success -> Stdlib.Result.Result.Ok success) + +// throwIfRelevant onMissing result + + + +// module ConstantName = +// let err +// (errType: RuntimeErrors.NameResolution.ErrorType) +// : ProgramTypes.NameResolution = +// (LanguageTools.RuntimeErrors.NameResolution.Error +// { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Constant +// errorType = errType }) +// |> Stdlib.Result.Result.Error + +// let builtinThingExists (name: String) : Bool = +// (Builtin.languageToolsAllBuiltinConstants ()) +// |> Stdlib.List.findFirst (fun f -> f.name == name) +// |> Stdlib.Option.isSome + +// let tryResolve +// (pm: ProgramTypes.PackageManager.PackageManager) +// (name: GenericName) +// : Stdlib.Result.Result = +// match name.modules with +// | [] -> Stdlib.Result.Result.Error() +// | owner :: modules -> +// let nameForLookup = +// (Stdlib.List.flatten [ name.modules; [ name.name ] ]) +// |> Stdlib.String.join "." + +// if owner == "Builtin" && modules == [] then +// if builtinThingExists name.name then +// (ProgramTypes.FQConstantName.Builtin +// { name = name.name +// version = name.version }) +// |> ProgramTypes.FQConstantName.FQConstantName.Builtin +// |> Stdlib.Result.Result.Ok +// else +// Stdlib.Result.Result.Error() +// else +// let find = pm.findConstant + +// match find nameForLookup with +// | Some id -> +// (ProgramTypes.FQConstantName.FQConstantName.Package id) +// |> Stdlib.Result.Result.Ok +// | None -> Stdlib.Result.Result.Error() + + +// let resolve +// (onMissing: OnMissing) +// (pm: ProgramTypes.PackageManager.PackageManager) +// (owner: String) +// (currentModule: List) +// (name: WrittenTypes.Name) +// : ProgramTypes.NameResolution = +// match name with +// // TODO remodel things appropriately so this is not needed +// | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error + +// | Unresolved(_range, given) -> +// let modules = Stdlib.List.dropLast given +// let name = Stdlib.List.last given + +// // TODO: handle versions... (parse out the _v[n] part if present) +// match name with +// | None -> +// err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) +// | Some name -> +// let genericName = +// GenericName +// { modules = modules +// name = name +// version = 0L } + +// let result = +// Stdlib.List.fold +// (namesToTry owner currentModule genericName) +// (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) +// (fun currentResult nameToTry -> +// match currentResult with +// | Ok _ -> currentResult +// | Error _ -> +// match tryResolve pm nameToTry with +// | Error() -> currentResult +// | Ok success -> Stdlib.Result.Result.Ok success) + +// throwIfRelevant onMissing result + + + +// module FnName = +// let err +// (errType: RuntimeErrors.NameResolution.ErrorType) +// : ProgramTypes.NameResolution = +// (LanguageTools.RuntimeErrors.NameResolution.Error +// { nameType = LanguageTools.RuntimeErrors.NameResolution.NameType.Function +// errorType = errType }) +// |> Stdlib.Result.Result.Error + + +// let tryResolve +// (pm: ProgramTypes.PackageManager.PackageManager) +// (name: GenericName) +// : Stdlib.Result.Result = +// match name.modules with +// | [] -> Stdlib.Result.Result.Error() +// | owner :: modules -> +// if owner == "Builtin" && modules == [] then +// if Builtin.languageToolsBuiltinFnExists name.name name.version then +// (ProgramTypes.FQFnName.Builtin +// { name = name.name +// version = name.version }) +// |> ProgramTypes.FQFnName.FQFnName.Builtin +// |> Stdlib.Result.Result.Ok +// else +// Stdlib.Result.Result.Error() +// else +// let nameForLookup = +// (Stdlib.List.flatten [ name.modules; [ name.name ] ]) +// |> Stdlib.String.join "." + +// // CLEANUP: allow this to be inline (i.e. `pm.findFn nameForLookup`) +// let find = pm.findFn + +// match find nameForLookup with +// | Some id -> +// (ProgramTypes.FQFnName.FQFnName.Package id) +// |> Stdlib.Result.Result.Ok +// | None -> Stdlib.Result.Result.Error() + + +// let resolve +// (onMissing: OnMissing) +// (pm: ProgramTypes.PackageManager.PackageManager) +// (owner: String) +// (currentModule: List) +// (name: WrittenTypes.Name) +// : ProgramTypes.NameResolution = +// match name with +// // TODO remodel things appropriately so this is not needed +// | KnownBuiltin(_name, _version) -> "Builtin types don't exist" // TODO: error + +// | Unresolved(_range, given) -> +// let modules = Stdlib.List.dropLast given +// let name = Stdlib.List.last given + +// // TODO: handle versions... (parse out the _v[n] part if present) +// match name with +// | None -> +// err (RuntimeErrors.NameResolution.ErrorType.InvalidPackageName given) +// | Some name -> +// let genericName = +// GenericName +// { modules = modules +// name = name +// version = 0L } + +// let names = namesToTry owner currentModule genericName + +// let result = +// Stdlib.List.fold +// names +// (err (RuntimeErrors.NameResolution.ErrorType.NotFound given)) +// (fun currentResult nameToTry -> +// match currentResult with +// | Ok _ -> currentResult +// | Error _ -> +// match tryResolve pm nameToTry with +// | Error() -> currentResult +// | Ok success -> Stdlib.Result.Result.Ok success) + +// throwIfRelevant onMissing result \ No newline at end of file diff --git a/packages/darklang/languageTools/_packageManager.dark b/packages/darklang/languageTools/packageManager.dark similarity index 100% rename from packages/darklang/languageTools/_packageManager.dark rename to packages/darklang/languageTools/packageManager.dark diff --git a/packages/darklang/languageTools/_parser/canvas.dark b/packages/darklang/languageTools/parser/canvas.dark similarity index 100% rename from packages/darklang/languageTools/_parser/canvas.dark rename to packages/darklang/languageTools/parser/canvas.dark diff --git a/packages/darklang/languageTools/_parser/cliScript.dark b/packages/darklang/languageTools/parser/cliScript.dark similarity index 100% rename from packages/darklang/languageTools/_parser/cliScript.dark rename to packages/darklang/languageTools/parser/cliScript.dark diff --git a/packages/darklang/languageTools/_parser/constantDeclaration.dark b/packages/darklang/languageTools/parser/constantDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/_parser/constantDeclaration.dark rename to packages/darklang/languageTools/parser/constantDeclaration.dark diff --git a/packages/darklang/languageTools/_parser/core.dark b/packages/darklang/languageTools/parser/core.dark similarity index 100% rename from packages/darklang/languageTools/_parser/core.dark rename to packages/darklang/languageTools/parser/core.dark diff --git a/packages/darklang/languageTools/_parser/expr.dark b/packages/darklang/languageTools/parser/expr.dark similarity index 100% rename from packages/darklang/languageTools/_parser/expr.dark rename to packages/darklang/languageTools/parser/expr.dark diff --git a/packages/darklang/languageTools/_parser/functionDeclaration.dark b/packages/darklang/languageTools/parser/functionDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/_parser/functionDeclaration.dark rename to packages/darklang/languageTools/parser/functionDeclaration.dark diff --git a/packages/darklang/languageTools/_parser/identifiers.dark b/packages/darklang/languageTools/parser/identifiers.dark similarity index 100% rename from packages/darklang/languageTools/_parser/identifiers.dark rename to packages/darklang/languageTools/parser/identifiers.dark diff --git a/packages/darklang/languageTools/_parser/matchPattern.dark b/packages/darklang/languageTools/parser/matchPattern.dark similarity index 100% rename from packages/darklang/languageTools/_parser/matchPattern.dark rename to packages/darklang/languageTools/parser/matchPattern.dark diff --git a/packages/darklang/languageTools/_parser/moduleDeclaration.dark b/packages/darklang/languageTools/parser/moduleDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/_parser/moduleDeclaration.dark rename to packages/darklang/languageTools/parser/moduleDeclaration.dark diff --git a/packages/darklang/languageTools/_parser/parserTest.dark b/packages/darklang/languageTools/parser/parserTest.dark similarity index 100% rename from packages/darklang/languageTools/_parser/parserTest.dark rename to packages/darklang/languageTools/parser/parserTest.dark diff --git a/packages/darklang/languageTools/_parser/pipeExpr.dark b/packages/darklang/languageTools/parser/pipeExpr.dark similarity index 100% rename from packages/darklang/languageTools/_parser/pipeExpr.dark rename to packages/darklang/languageTools/parser/pipeExpr.dark diff --git a/packages/darklang/languageTools/_parser/sourceFile.dark b/packages/darklang/languageTools/parser/sourceFile.dark similarity index 100% rename from packages/darklang/languageTools/_parser/sourceFile.dark rename to packages/darklang/languageTools/parser/sourceFile.dark diff --git a/packages/darklang/languageTools/_parser/typeDeclaration.dark b/packages/darklang/languageTools/parser/typeDeclaration.dark similarity index 100% rename from packages/darklang/languageTools/_parser/typeDeclaration.dark rename to packages/darklang/languageTools/parser/typeDeclaration.dark diff --git a/packages/darklang/languageTools/_parser/typeReference.dark b/packages/darklang/languageTools/parser/typeReference.dark similarity index 100% rename from packages/darklang/languageTools/_parser/typeReference.dark rename to packages/darklang/languageTools/parser/typeReference.dark diff --git a/packages/darklang/languageTools/_semanticTokens.dark b/packages/darklang/languageTools/semanticTokens.dark similarity index 100% rename from packages/darklang/languageTools/_semanticTokens.dark rename to packages/darklang/languageTools/semanticTokens.dark diff --git a/packages/darklang/languageTools/_writtenTypes.dark b/packages/darklang/languageTools/writtenTypes.dark similarity index 100% rename from packages/darklang/languageTools/_writtenTypes.dark rename to packages/darklang/languageTools/writtenTypes.dark diff --git a/packages/darklang/languageTools/_writtenTypesToProgramTypes.dark b/packages/darklang/languageTools/writtenTypesToProgramTypes.dark similarity index 100% rename from packages/darklang/languageTools/_writtenTypesToProgramTypes.dark rename to packages/darklang/languageTools/writtenTypesToProgramTypes.dark diff --git a/packages/darklang/_openai.dark b/packages/darklang/openai.dark similarity index 100% rename from packages/darklang/_openai.dark rename to packages/darklang/openai.dark diff --git a/packages/darklang/_prettyPrinter/runtimeTypes.dark b/packages/darklang/prettyPrinter/_runtimeTypes.dark similarity index 100% rename from packages/darklang/_prettyPrinter/runtimeTypes.dark rename to packages/darklang/prettyPrinter/_runtimeTypes.dark diff --git a/packages/darklang/_prettyPrinter/canvas.dark b/packages/darklang/prettyPrinter/canvas.dark similarity index 100% rename from packages/darklang/_prettyPrinter/canvas.dark rename to packages/darklang/prettyPrinter/canvas.dark diff --git a/packages/darklang/_prettyPrinter/cliScript.dark b/packages/darklang/prettyPrinter/cliScript.dark similarity index 100% rename from packages/darklang/_prettyPrinter/cliScript.dark rename to packages/darklang/prettyPrinter/cliScript.dark diff --git a/packages/darklang/_prettyPrinter/common.dark b/packages/darklang/prettyPrinter/common.dark similarity index 100% rename from packages/darklang/_prettyPrinter/common.dark rename to packages/darklang/prettyPrinter/common.dark diff --git a/packages/darklang/_prettyPrinter/moduleDeclaration.dark b/packages/darklang/prettyPrinter/moduleDeclaration.dark similarity index 100% rename from packages/darklang/_prettyPrinter/moduleDeclaration.dark rename to packages/darklang/prettyPrinter/moduleDeclaration.dark diff --git a/packages/darklang/_prettyPrinter/packages.dark b/packages/darklang/prettyPrinter/packages.dark similarity index 100% rename from packages/darklang/_prettyPrinter/packages.dark rename to packages/darklang/prettyPrinter/packages.dark diff --git a/packages/darklang/_prettyPrinter/programTypes.dark b/packages/darklang/prettyPrinter/programTypes.dark similarity index 96% rename from packages/darklang/_prettyPrinter/programTypes.dark rename to packages/darklang/prettyPrinter/programTypes.dark index b553c73a77..26e92c7049 100644 --- a/packages/darklang/_prettyPrinter/programTypes.dark +++ b/packages/darklang/prettyPrinter/programTypes.dark @@ -10,18 +10,29 @@ module Darklang = // i.e. common, typeReference, expr, declarations, packages, sourceFile module ProgramTypes = - let nameResolutionError - (nr: LanguageTools.RuntimeErrors.NameResolution.Error) - : String = - match nr.errorType with + // let nameResolutionError + // (nr: LanguageTools.RuntimeErrors.NameResolution.Error) + // : String = + // match nr.errorType with + // | NotFound names -> Stdlib.String.join names "." + // | InvalidPackageName names -> Stdlib.String.join names "." + // | ExpectedEnumButNot -> + // "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedEnumButNot" + // | ExpectedRecordButNot -> + // "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedRecordButNot" + // | MissingEnumModuleName -> + // "Unexpected: stringification of NRE in RT Pretty-Printer for MissingEnumModuleName" + + type NameResolutionError = + | NotFound of List + | InvalidName of List + + type NameResolution<'a> = Stdlib.Result.Result<'a, NameResolutionError> + + let nameResolutionError (nr: NameResolutionError) : String = + match nr with | NotFound names -> Stdlib.String.join names "." - | InvalidPackageName names -> Stdlib.String.join names "." - | ExpectedEnumButNot -> - "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedEnumButNot" - | ExpectedRecordButNot -> - "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedRecordButNot" - | MissingEnumModuleName -> - "Unexpected: stringification of NRE in RT Pretty-Printer for MissingEnumModuleName" + | InvalidName names -> Stdlib.String.join names "." let packageName diff --git a/packages/darklang/stdlib/_canvas.dark b/packages/darklang/stdlib/canvas.dark similarity index 100% rename from packages/darklang/stdlib/_canvas.dark rename to packages/darklang/stdlib/canvas.dark diff --git a/packages/darklang/stdlib/_cli/bash.dark b/packages/darklang/stdlib/cli/bash.dark similarity index 100% rename from packages/darklang/stdlib/_cli/bash.dark rename to packages/darklang/stdlib/cli/bash.dark diff --git a/packages/darklang/stdlib/_cli/curl.dark b/packages/darklang/stdlib/cli/curl.dark similarity index 100% rename from packages/darklang/stdlib/_cli/curl.dark rename to packages/darklang/stdlib/cli/curl.dark diff --git a/packages/darklang/stdlib/_cli/execution.dark b/packages/darklang/stdlib/cli/execution.dark similarity index 100% rename from packages/darklang/stdlib/_cli/execution.dark rename to packages/darklang/stdlib/cli/execution.dark diff --git a/packages/darklang/stdlib/_cli/gunzip.dark b/packages/darklang/stdlib/cli/gunzip.dark similarity index 100% rename from packages/darklang/stdlib/_cli/gunzip.dark rename to packages/darklang/stdlib/cli/gunzip.dark diff --git a/packages/darklang/stdlib/_cli/host.dark b/packages/darklang/stdlib/cli/host.dark similarity index 100% rename from packages/darklang/stdlib/_cli/host.dark rename to packages/darklang/stdlib/cli/host.dark diff --git a/packages/darklang/stdlib/_cli/unix.dark b/packages/darklang/stdlib/cli/unix.dark similarity index 100% rename from packages/darklang/stdlib/_cli/unix.dark rename to packages/darklang/stdlib/cli/unix.dark diff --git a/packages/darklang/stdlib/_cli/zsh.dark b/packages/darklang/stdlib/cli/zsh.dark similarity index 100% rename from packages/darklang/stdlib/_cli/zsh.dark rename to packages/darklang/stdlib/cli/zsh.dark diff --git a/packages/darklang/test/_test.dark b/packages/darklang/test/test.dark similarity index 100% rename from packages/darklang/test/_test.dark rename to packages/darklang/test/test.dark diff --git a/packages/internal/_tests.dark b/packages/internal/tests.dark similarity index 100% rename from packages/internal/_tests.dark rename to packages/internal/tests.dark diff --git a/packages/stachu/_json.dark b/packages/stachu/json.dark similarity index 100% rename from packages/stachu/_json.dark rename to packages/stachu/json.dark diff --git a/packages/stachu/_timespan.dark b/packages/stachu/timespan.dark similarity index 100% rename from packages/stachu/_timespan.dark rename to packages/stachu/timespan.dark From 41991cb4d632859f137b3e8cd472ce3be69881d7 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 19 Sep 2024 11:09:38 -0400 Subject: [PATCH 45/60] rename something --- backend/src/BuiltinCli/Libs/Execution.fs | 16 +- backend/src/BuiltinCli/Libs/File.fs | 2 +- backend/src/BuiltinCliHost/Libs/Cli.fs | 12 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 6 +- backend/src/LibExecution/Interpreter.fs | 2 +- backend/src/LibExecution/ProgramTypes.fs | 2 +- .../ProgramTypesToRuntimeTypes.fs | 7 +- backend/src/LibExecution/RuntimeTypes.fs | 5 +- backend/src/LocalExec/LocalExec.fs | 14 +- backend/tests/TestUtils/TestUtils.fs | 51 ++- backend/tests/Tests/LibParser.Tests.fs | 2 +- backend/tests/Tests/PT2RT.Tests.fs | 22 +- .../darklang/languageTools/programTypes.dark | 3 +- .../darklang/languageTools/runtimeTypes.dark | 414 +++++++++--------- 14 files changed, 283 insertions(+), 275 deletions(-) diff --git a/backend/src/BuiltinCli/Libs/Execution.fs b/backend/src/BuiltinCli/Libs/Execution.fs index 641c0ec8a1..59e2a2c453 100644 --- a/backend/src/BuiltinCli/Libs/Execution.fs +++ b/backend/src/BuiltinCli/Libs/Execution.fs @@ -26,7 +26,7 @@ let fns : List = returnType = TCustomType(Ok executionOutcomeTypeName, []) fn = (function - | _, _, _, [ DString command ] -> + | _, _, _, [ DString command ] -> let command = command.Replace( "$HOME", @@ -38,14 +38,14 @@ let fns : List = "cmd.exe", $"/c {command}" // TODO: run in whatever the default shell is -- not just bash. else - // if - // RuntimeInformation.IsOSPlatform OSPlatform.Linux - // || RuntimeInformation.IsOSPlatform OSPlatform.OSX - //then + // if + // RuntimeInformation.IsOSPlatform OSPlatform.Linux + // || RuntimeInformation.IsOSPlatform OSPlatform.OSX + //then "/bin/bash", $"-c \"{command}\"" - // else - // "Executing CLI commands is not supported for your operating system (Linux, Windows, or Mac not detected)" - // |> raiseUntargetedString + // else + // "Executing CLI commands is not supported for your operating system (Linux, Windows, or Mac not detected)" + // |> raiseUntargetedString let psi = System.Diagnostics.ProcessStartInfo( diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index 68c1c7235d..5dd55384b4 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -204,7 +204,7 @@ let fns : List = "Returns true if a file or directory exists at the specified , or false otherwise" fn = (function - | _, _, _, [ DString path ] -> + | _, _, _, [ DString path ] -> uply { try let exists = diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index 80c1137dda..9120576fe2 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -60,8 +60,8 @@ module CliRuntimeError = DEnum(typeName, typeName, [], caseName, fields) - // let toRuntimeError (e : Error) : RT.RuntimeError = - // Error.toDT e |> RT.RuntimeError.fromDT +// let toRuntimeError (e : Error) : RT.RuntimeError = +// Error.toDT e |> RT.RuntimeError.fromDT @@ -145,8 +145,7 @@ let builtinsToUse : RT.Builtins = let fns : List = - [ - { name = fn "cliParseAndExecuteScript" 0 + [ { name = fn "cliParseAndExecuteScript" 0 typeParams = [] parameters = [ Param.make "filename" TString "" @@ -160,7 +159,10 @@ let fns : List = // let resultOk = Dval.resultOk KTInt64 errType // let resultError = Dval.resultError KTInt64 errType (function - | _exeState, _, [], [ DString _filename; DString _code; DDict(_vtTODO, _symtable) ] -> + | _exeState, + _, + [], + [ DString _filename; DString _code; DDict(_vtTODO, _symtable) ] -> uply { // let exnError (e : exn) : RuntimeError = // let msg = Exception.getMessages e |> String.concat "\n" diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 53f6824309..82bb7a604c 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -438,9 +438,9 @@ let fns : List = |> raiseRTE vm.threadID | _, vm, _, multipleArgs -> - RuntimeError.Unwraps.MultipleArgs multipleArgs - |> RuntimeError.Unwrap - |> raiseRTE vm.threadID) + RuntimeError.Unwraps.MultipleArgs multipleArgs + |> RuntimeError.Unwrap + |> raiseRTE vm.threadID) sqlSpec = NotQueryable previewable = Pure diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 67b54ff441..96d3f7305b 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -402,7 +402,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = registers[lambdaReg] <- { exprId = impl.exprId closedRegisters = - impl.registersToClose + impl.registersToCloseOver |> List.map (fun (parentReg, childReg) -> childReg, registers[parentReg]) argsSoFar = [] } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index 02277c84d8..1e68b0ec7f 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -284,7 +284,7 @@ type Expr = // Allow the user to have arbitrarily big numbers, even if they don't make sense as // floats. The float is split as we want to preserve what the user entered. // Strings are used as numbers lose the leading zeros (eg 7.00007) - | EFloat of id * Sign * whole: string * part: string + | EFloat of id * Sign * whole : string * part : string /// A character is an Extended Grapheme Cluster (hence why we use a string). This /// is equivalent to one screen-visible "character" in Unicode. diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 37842262e2..9897cfccc0 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -871,8 +871,9 @@ module Expr = (pats @ [ pat ], Map.mergeFavoringRight symbols newSymbols, rcAfterPat)) ([], Map.empty, 0) - let (registersToClose, symbolsOfNewFrameAfterOnesOnlyUsedInBoty, rcOfNewFrame) - : (List * Map * int) = + let (registersToCloseOver, + symbolsOfNewFrameAfterOnesOnlyUsedInBoty, + rcOfNewFrame) : (List * Map * int) = symbolsUsedInBodyNotDefinedInPats |> Set.toList |> List.fold @@ -884,7 +885,7 @@ module Expr = let impl : RT.LambdaImpl = { exprId = id patterns = pats |> NEList.ofListUnsafe "" [] - registersToClose = registersToClose + registersToCloseOver = registersToCloseOver instructions = toRT symbolsOfNewFrameAfterOnesOnlyUsedInBoty rcOfNewFrame body } diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 520627e7ea..c68e6f4817 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -478,7 +478,7 @@ and LambdaImpl = /// /// PT2RT has the duty of creating and passing in (PT2RT-only) /// symbtable for the evaluation of the expr on the RHS - registersToClose : List + registersToCloseOver : List // Hmm do these actually belong here, or somewhere else? idk how we get this to work. // do we need to call eval within eval or something? would love to avoid that. @@ -1441,13 +1441,14 @@ and InstrData = } + and VMState = { mutable threadID : uuid mutable callFrames : Map mutable currentFrameID : uuid - sourceInfo : InstrData + sourceInfo : InstrData // probably could be arg of interpreter -- rename to rootInstrData or something mutable lambdas : Map mutable packageFns : Map } diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index 3a15a58c88..368405d0fd 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -36,15 +36,15 @@ module HandleCommand = } - // let reloadDarkPackagesCanvas () : Ply> = - // uply { - // let! (canvasId, toplevels) = - // Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" +// let reloadDarkPackagesCanvas () : Ply> = +// uply { +// let! (canvasId, toplevels) = +// Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" - // print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" +// print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" - // return Ok() - // } +// return Ok() +// } diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index 14e4d2c28b..b3255d1edc 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -619,7 +619,10 @@ module Expect = typeNameEqualityBaseFn path typeName typeName' errorFn check ("caseName" :: path) caseName caseName' - check ("TypeArgsLength" :: path) (List.length typeArgs) (List.length typeArgs') + check + ("TypeArgsLength" :: path) + (List.length typeArgs) + (List.length typeArgs') List.iteri2 (fun i -> checkValueType (string i :: path)) typeArgs typeArgs' check ("fields.Length" :: path) (List.length fields) (List.length fields) @@ -661,7 +664,7 @@ module Expect = | DEnum _, _ | DApplicable _, _ // | DDB _, _ - -> check path actual expected + -> check path actual expected let dvalEquality (left : Dval) (right : Dval) : bool = @@ -670,8 +673,8 @@ module Expect = success let rec equalDval (actual : Dval) (expected : Dval) (msg : string) : unit = - dvalEqualityBaseFn [] actual expected (fun path a e -> - Expect.equal a e (formatMsg msg path actual)) + dvalEqualityBaseFn [] actual expected (fun path a e -> + Expect.equal a e (formatMsg msg path actual)) module PT = open LibExecution.ProgramTypes @@ -756,14 +759,15 @@ module Expect = match actual, expected with | EPipeLambda(_, pats, body), EPipeLambda(_, pats', body') -> NEList.iteri2 - (fun i l r -> letPatternEqualityBaseFn checkIDs (string i :: path) l r errorFn) + (fun i l r -> + letPatternEqualityBaseFn checkIDs (string i :: path) l r errorFn) pats pats' exprEqualityBaseFn checkIDs ("body" :: path) body body' errorFn | EPipeInfix(_, op, e), EPipeInfix(_, op', e') -> check path op op' - exprEqualityBaseFn checkIDs ("expr" :: path) e e' errorFn + exprEqualityBaseFn checkIDs ("expr" :: path) e e' errorFn | EPipeFnCall(_, name, typeArgs, args), EPipeFnCall(_, name', typeArgs', args') -> let path = (string name :: path) @@ -786,7 +790,8 @@ module Expect = // fields // fields' - | EPipeVariable(_, varContainingPipeable, args), EPipeVariable(_, varContainingPipeable', args') -> + | EPipeVariable(_, varContainingPipeable, args), + EPipeVariable(_, varContainingPipeable', args') -> check path varContainingPipeable varContainingPipeable' List.iteri2 (fun i l r -> exprEqualityBaseFn checkIDs (string i :: path) l r errorFn) @@ -1012,24 +1017,24 @@ module Expect = - // let rec equalMatchPattern - // (actual : MatchPattern) - // (expected : MatchPattern) - // (msg : string) - // : unit = - // matchPatternEqualityBaseFn true [] actual expected (fun path a e -> - // Expect.equal a e (formatMsg msg path actual)) +// let rec equalMatchPattern +// (actual : MatchPattern) +// (expected : MatchPattern) +// (msg : string) +// : unit = +// matchPatternEqualityBaseFn true [] actual expected (fun path a e -> +// Expect.equal a e (formatMsg msg path actual)) - // let rec equalMatchPatternIgnoringIDs - // (actual : MatchPattern) - // (expected : MatchPattern) - // : unit = - // matchPatternEqualityBaseFn false [] actual expected (fun path a e -> - // Expect.equal a e (formatMsg "" path actual)) +// let rec equalMatchPatternIgnoringIDs +// (actual : MatchPattern) +// (expected : MatchPattern) +// : unit = +// matchPatternEqualityBaseFn false [] actual expected (fun path a e -> +// Expect.equal a e (formatMsg "" path actual)) - // let rec equalExpr (actual : Expr) (expected : Expr) (msg : string) : unit = - // exprEqualityBaseFn true [] actual expected (fun path a e -> - // Expect.equal a e (formatMsg msg path actual)) +// let rec equalExpr (actual : Expr) (expected : Expr) (msg : string) : unit = +// exprEqualityBaseFn true [] actual expected (fun path a e -> +// Expect.equal a e (formatMsg msg path actual)) diff --git a/backend/tests/Tests/LibParser.Tests.fs b/backend/tests/Tests/LibParser.Tests.fs index 6dba1ee5c0..0b16f6a4b3 100644 --- a/backend/tests/Tests/LibParser.Tests.fs +++ b/backend/tests/Tests/LibParser.Tests.fs @@ -123,7 +123,7 @@ let exprRTs = // ) ] // ) // )) - ] + ] let tests = testList "LibParser" [ exprRTs ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 69a8b3d846..559fd3a102 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -495,7 +495,7 @@ module Expr = 0, { exprId = E.Pipes.pipeID patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 1; instructions = []; resultIn = 0 } } ) RT.LoadVal(1, RT.DInt64 1L) @@ -546,7 +546,7 @@ module Expr = 0, { exprId = E.Pipes.lambdaID patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -576,7 +576,7 @@ module Expr = 0, { exprId = E.Pipes.lambdaID patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -604,7 +604,7 @@ module Expr = 3, { exprId = E.Pipes.pipeID patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -932,7 +932,7 @@ module Expr = 0, { exprId = E.Lambdas.Identity.id patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 1; instructions = []; resultIn = 0 } } ) ], @@ -947,7 +947,7 @@ module Expr = 0, { exprId = E.Lambdas.Identity.id patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 1; instructions = []; resultIn = 0 } } ) @@ -967,7 +967,7 @@ module Expr = 0, { exprId = E.Lambdas.Add.id patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -993,7 +993,7 @@ module Expr = 0, { exprId = E.Lambdas.Add.id patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -1022,7 +1022,7 @@ module Expr = 0, { exprId = E.Lambdas.Add.id patterns = NEList.ofList (RT.LPVariable 0) [ RT.LPVariable 1 ] - registersToClose = [] + registersToCloseOver = [] instructions = { registerCount = 4 instructions = @@ -1067,7 +1067,7 @@ module Expr = 4, { exprId = E.Lambdas.AddToClosedVars.id patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [ (1, 1); (3, 2) ] + registersToCloseOver = [ (1, 1); (3, 2) ] instructions = { registerCount = 7 instructions = @@ -1108,7 +1108,7 @@ module Expr = 4, { exprId = E.Lambdas.AddToClosedVars.id patterns = NEList.ofList (RT.LPVariable 0) [] - registersToClose = [ (1, 1); (3, 2) ] + registersToCloseOver = [ (1, 1); (3, 2) ] instructions = { registerCount = 7 instructions = diff --git a/packages/darklang/languageTools/programTypes.dark b/packages/darklang/languageTools/programTypes.dark index 256657fa1a..b520452e4a 100644 --- a/packages/darklang/languageTools/programTypes.dark +++ b/packages/darklang/languageTools/programTypes.dark @@ -28,8 +28,7 @@ module Darklang = | NotFound of List | InvalidName of List - type NameResolution<'a> = - Stdlib.Result.Result<'a, NameResolutionError> + type NameResolution<'a> = Stdlib.Result.Result<'a, NameResolutionError> /// Darklang's available types (int, List, user-defined types, etc.) diff --git a/packages/darklang/languageTools/runtimeTypes.dark b/packages/darklang/languageTools/runtimeTypes.dark index 48c41ca3ce..80530237c0 100644 --- a/packages/darklang/languageTools/runtimeTypes.dark +++ b/packages/darklang/languageTools/runtimeTypes.dark @@ -61,210 +61,210 @@ module Darklang = | TDict of TypeReference - // type MatchCase = - // { pat: MatchPattern - // whenCondition: Stdlib.Option.Option - // rhs: Expr } - - // type LetPattern = - // | LPVariable of ID * name: String - // | LPTuple of - // ID * - // first: LetPattern * - // second: LetPattern * - // theRest: List - - // type StringSegment = - // | StringText of String - // | StringInterpolation of Expr - - // type MatchPattern = - // | MPVariable of ID * String - // | MPEnum of ID * caseName: String * fieldPatterns: List - // | MPInt64 of ID * Int64 - // | MPUInt64 of ID * UInt64 - // | MPInt8 of ID * Int8 - // | MPUInt8 of ID * UInt8 - // | MPInt16 of ID * Int16 - // | MPUInt16 of ID * UInt16 - // | MPInt32 of ID * Int32 - // | MPUInt32 of ID * UInt32 - // | MPInt128 of ID * Int128 - // | MPUInt128 of ID * UInt128 - // | MPBool of ID * Bool - // | MPChar of ID * String - // | MPString of ID * String - // | MPFloat of ID * Float - // | MPUnit of ID - // | MPTuple of ID * MatchPattern * MatchPattern * List - // | MPList of ID * List - // | MPListCons of ID * head: MatchPattern * tail: MatchPattern - - // type DvalMap = Dict - - // type LambdaImpl = - // { typeSymbolTable: TypeSymbolTable - // symtable: Symtable - // parameters: List - // body: Expr } - - // type FnValImpl = - // | Lambda of LambdaImpl - // | NamedFn of FQFnName.FQFnName - - // type RuntimeError = RuntimeError of Dval.Dval - - // type KnownType = - // | KTUnit - // | KTBool - // | KTInt64 - // | KTUInt64 - // | KTInt8 - // | KTUInt8 - // | KTInt16 - // | KTUInt16 - // | KTInt32 - // | KTUInt32 - // | KTInt128 - // | KTUInt128 - // | KTFloat - // | KTChar - // | KTString - // | KTUuid - // | KTDateTime - // | KTList of ValueType - // | KTTuple of ValueType * ValueType * List - // | KTFn of List * ValueType - - // | KTDB of ValueType - // | KTCustomType of FQTypeName.FQTypeName * typeArgs: List - - // | KTDict of ValueType - - // type ValueType = - // | Unknown - // | Known of KnownType - - - // module Dval = - // type Dval = - // | DUnit - // | DBool of Bool - // | DInt64 of Int64 - // | DUInt64 of UInt64 - // | DInt8 of Int8 - // | DUInt8 of UInt8 - // | DInt16 of Int16 - // | DUInt16 of UInt16 - // | DInt32 of Int32 - // | DUInt32 of UInt32 - // | DInt128 of Int128 - // | DUInt128 of UInt128 - // | DFloat of Float - // | DChar of String - // | DString of String - // | DDateTime of DateTime - // | DUuid of Uuid - - // | DList of ValueType * List - // | DDict of ValueType * DvalMap - // | DTuple of Dval * Dval * List - - // | DFnVal of FnValImpl - - // | DDB of String - - // | DRecord of - // runtimeTypeName: FQTypeName.FQTypeName * - // sourceTypeName: FQTypeName.FQTypeName * - // typeArgs: List * - // fields: DvalMap - - // | DEnum of - // runtimeTypeName: FQTypeName.FQTypeName * - // sourceTypeName: FQTypeName.FQTypeName * - // typeArgs: List * - // caseName: String * - // fields: List - - - // let toValueType (dv: Dval) : ValueType = - // let dvalValueTypeTODO = ValueType.Unknown - - // match dv with - // | DUnit -> ValueType.Known KnownType.KTUnit - // | DBool _ -> ValueType.Known KnownType.KTBool - // | DInt64 _ -> ValueType.Known KnownType.KTInt64 - // | DUInt64 _ -> ValueType.Known KnownType.KTUInt64 - // | DInt8 _ -> ValueType.Known KnownType.KTInt8 - // | DUInt8 _ -> ValueType.Known KnownType.KTUInt8 - // | DInt16 _ -> ValueType.Known KnownType.KTInt16 - // | DUInt16 _ -> ValueType.Known KnownType.KTUInt16 - // | DInt32 _ -> ValueType.Known KnownType.KTInt32 - // | DUInt32 _ -> ValueType.Known KnownType.KTUInt32 - // | DInt128 _ -> ValueType.Known KnownType.KTInt128 - // | DUInt128 _ -> ValueType.Known KnownType.KTUInt128 - // | DFloat _ -> ValueType.Known KnownType.KTFloat - // | DChar _ -> ValueType.Known KnownType.KTChar - // | DString _ -> ValueType.Known KnownType.KTString - // | DUuid _ -> ValueType.Known KnownType.KTUuid - // | DDateTime _ -> ValueType.Known KnownType.KTDateTime - - // | DList(t, _) -> ValueType.Known(KnownType.KTList t) - // | DDict(t, _) -> ValueType.Known(KnownType.KTDict t) - // | DTuple(first, second, theRest) -> - // (KnownType.KTTuple( - // toValueType first, - // toValueType second, - // theRest |> Stdlib.List.map (fun item -> toValueType item) - // )) - // |> ValueType.Known - - // | DRecord(typeName, _, typeArgs, fields) -> - // ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) - - // | DEnum(typeName, _, typeArgs, _caseName, _fields) -> - // ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) - - // | DFnVal fnImpl -> - // match fnImpl with - // | Lambda lambda -> - // let ps = Stdlib.List.map lambda.parameters (fun _ -> ValueType.Unknown) - - // ValueType.Known(KnownType.KTFn(ps, ValueType.Unknown)) - - // // VTTODO look up type, etc? - // | NamedFn _named -> dvalValueTypeTODO - - // // CLEANUP follow up when DDB has a typeReference - // // or look up the type of the DB by name - // | DDB _ -> ValueType.Unknown - - // /// our record of any variable bindings in scope - // /// - // /// i.e. within the execution of `x+y` in - // /// `let x = 1; let y = 2; x + y` - // /// , we would have a Symtable of - // /// `{ "x" => DInt64 1; "y" => DInt64 2 }` - // type Symtable = Dict - - // type TypeSymbolTable = Dict - - - // // Record the source of an incomplete or error. Would be useful to add more - // // information later, such as the iteration count that led to this, or - // // something like a stack trace - // type DvalSource = - // // We do not have context to supply an identifier - // | SourceNone - - // // Caused by an expression of `id` within the given `tlid` - // | SourceID of TLID * ID - - // type BuiltInParam = - // { name: String - // typ: TypeReference - // blockArgs: List - // description: String } - - // type Param = { name: String; typ: TypeReference } \ No newline at end of file +// type MatchCase = +// { pat: MatchPattern +// whenCondition: Stdlib.Option.Option +// rhs: Expr } + +// type LetPattern = +// | LPVariable of ID * name: String +// | LPTuple of +// ID * +// first: LetPattern * +// second: LetPattern * +// theRest: List + +// type StringSegment = +// | StringText of String +// | StringInterpolation of Expr + +// type MatchPattern = +// | MPVariable of ID * String +// | MPEnum of ID * caseName: String * fieldPatterns: List +// | MPInt64 of ID * Int64 +// | MPUInt64 of ID * UInt64 +// | MPInt8 of ID * Int8 +// | MPUInt8 of ID * UInt8 +// | MPInt16 of ID * Int16 +// | MPUInt16 of ID * UInt16 +// | MPInt32 of ID * Int32 +// | MPUInt32 of ID * UInt32 +// | MPInt128 of ID * Int128 +// | MPUInt128 of ID * UInt128 +// | MPBool of ID * Bool +// | MPChar of ID * String +// | MPString of ID * String +// | MPFloat of ID * Float +// | MPUnit of ID +// | MPTuple of ID * MatchPattern * MatchPattern * List +// | MPList of ID * List +// | MPListCons of ID * head: MatchPattern * tail: MatchPattern + +// type DvalMap = Dict + +// type LambdaImpl = +// { typeSymbolTable: TypeSymbolTable +// symtable: Symtable +// parameters: List +// body: Expr } + +// type FnValImpl = +// | Lambda of LambdaImpl +// | NamedFn of FQFnName.FQFnName + +// type RuntimeError = RuntimeError of Dval.Dval + +// type KnownType = +// | KTUnit +// | KTBool +// | KTInt64 +// | KTUInt64 +// | KTInt8 +// | KTUInt8 +// | KTInt16 +// | KTUInt16 +// | KTInt32 +// | KTUInt32 +// | KTInt128 +// | KTUInt128 +// | KTFloat +// | KTChar +// | KTString +// | KTUuid +// | KTDateTime +// | KTList of ValueType +// | KTTuple of ValueType * ValueType * List +// | KTFn of List * ValueType + +// | KTDB of ValueType +// | KTCustomType of FQTypeName.FQTypeName * typeArgs: List + +// | KTDict of ValueType + +// type ValueType = +// | Unknown +// | Known of KnownType + + +// module Dval = +// type Dval = +// | DUnit +// | DBool of Bool +// | DInt64 of Int64 +// | DUInt64 of UInt64 +// | DInt8 of Int8 +// | DUInt8 of UInt8 +// | DInt16 of Int16 +// | DUInt16 of UInt16 +// | DInt32 of Int32 +// | DUInt32 of UInt32 +// | DInt128 of Int128 +// | DUInt128 of UInt128 +// | DFloat of Float +// | DChar of String +// | DString of String +// | DDateTime of DateTime +// | DUuid of Uuid + +// | DList of ValueType * List +// | DDict of ValueType * DvalMap +// | DTuple of Dval * Dval * List + +// | DFnVal of FnValImpl + +// | DDB of String + +// | DRecord of +// runtimeTypeName: FQTypeName.FQTypeName * +// sourceTypeName: FQTypeName.FQTypeName * +// typeArgs: List * +// fields: DvalMap + +// | DEnum of +// runtimeTypeName: FQTypeName.FQTypeName * +// sourceTypeName: FQTypeName.FQTypeName * +// typeArgs: List * +// caseName: String * +// fields: List + + +// let toValueType (dv: Dval) : ValueType = +// let dvalValueTypeTODO = ValueType.Unknown + +// match dv with +// | DUnit -> ValueType.Known KnownType.KTUnit +// | DBool _ -> ValueType.Known KnownType.KTBool +// | DInt64 _ -> ValueType.Known KnownType.KTInt64 +// | DUInt64 _ -> ValueType.Known KnownType.KTUInt64 +// | DInt8 _ -> ValueType.Known KnownType.KTInt8 +// | DUInt8 _ -> ValueType.Known KnownType.KTUInt8 +// | DInt16 _ -> ValueType.Known KnownType.KTInt16 +// | DUInt16 _ -> ValueType.Known KnownType.KTUInt16 +// | DInt32 _ -> ValueType.Known KnownType.KTInt32 +// | DUInt32 _ -> ValueType.Known KnownType.KTUInt32 +// | DInt128 _ -> ValueType.Known KnownType.KTInt128 +// | DUInt128 _ -> ValueType.Known KnownType.KTUInt128 +// | DFloat _ -> ValueType.Known KnownType.KTFloat +// | DChar _ -> ValueType.Known KnownType.KTChar +// | DString _ -> ValueType.Known KnownType.KTString +// | DUuid _ -> ValueType.Known KnownType.KTUuid +// | DDateTime _ -> ValueType.Known KnownType.KTDateTime + +// | DList(t, _) -> ValueType.Known(KnownType.KTList t) +// | DDict(t, _) -> ValueType.Known(KnownType.KTDict t) +// | DTuple(first, second, theRest) -> +// (KnownType.KTTuple( +// toValueType first, +// toValueType second, +// theRest |> Stdlib.List.map (fun item -> toValueType item) +// )) +// |> ValueType.Known + +// | DRecord(typeName, _, typeArgs, fields) -> +// ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) + +// | DEnum(typeName, _, typeArgs, _caseName, _fields) -> +// ValueType.Known(KnownType.KTCustomType(typeName, typeArgs)) + +// | DFnVal fnImpl -> +// match fnImpl with +// | Lambda lambda -> +// let ps = Stdlib.List.map lambda.parameters (fun _ -> ValueType.Unknown) + +// ValueType.Known(KnownType.KTFn(ps, ValueType.Unknown)) + +// // VTTODO look up type, etc? +// | NamedFn _named -> dvalValueTypeTODO + +// // CLEANUP follow up when DDB has a typeReference +// // or look up the type of the DB by name +// | DDB _ -> ValueType.Unknown + +// /// our record of any variable bindings in scope +// /// +// /// i.e. within the execution of `x+y` in +// /// `let x = 1; let y = 2; x + y` +// /// , we would have a Symtable of +// /// `{ "x" => DInt64 1; "y" => DInt64 2 }` +// type Symtable = Dict + +// type TypeSymbolTable = Dict + + +// // Record the source of an incomplete or error. Would be useful to add more +// // information later, such as the iteration count that led to this, or +// // something like a stack trace +// type DvalSource = +// // We do not have context to supply an identifier +// | SourceNone + +// // Caused by an expression of `id` within the given `tlid` +// | SourceID of TLID * ID + +// type BuiltInParam = +// { name: String +// typ: TypeReference +// blockArgs: List +// description: String } + +// type Param = { name: String; typ: TypeReference } \ No newline at end of file From 95d6e045d7a14ff7f7e88bad4f853aaa447aa390 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 19 Sep 2024 11:52:07 -0400 Subject: [PATCH 46/60] tidied RuntimeTypes --- backend/src/LibExecution/Execution.fs | 4 +- backend/src/LibExecution/Interpreter.fs | 23 +- backend/src/LibExecution/RuntimeTypes.fs | 277 +++++++++-------------- backend/tests/Tests/Interpreter.Tests.fs | 11 +- 4 files changed, 132 insertions(+), 183 deletions(-) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index f97f197523..6134d77601 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -36,7 +36,7 @@ let createState program = program - types = { typeSymbolTable = Map.empty; package = packageManager.getType } + types = { package = packageManager.getType } fns = { builtIn = builtins.fns; package = packageManager.getFn } constants = { builtIn = builtins.constants; package = packageManager.getConstant } } @@ -48,7 +48,7 @@ let executeExpr (instrs : RT.Instructions) : Task = task { - let vmState = RT.VMState.fromExpr instrs + let vmState = RT.VMState.create instrs try try // TODO: handle secrets and DBs by explicit references instead of relying on symbol table diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 96d3f7305b..7d4a49311e 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -175,24 +175,25 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = while Map.containsKey vm.currentFrameID vm.callFrames do let currentFrame = Map.findUnsafe vm.currentFrameID vm.callFrames - let mutable counter = currentFrame.pc + let mutable counter = currentFrame.programCounter let registers = currentFrame.registers let! instrData = match currentFrame.context with - | Source -> Ply vm.sourceInfo + | Source -> Ply vm.rootInstrData | Lambda(parentContext, lambdaID) -> let lambda = - Map.findUnsafe (parentContext, lambdaID) vm.lambdas |> _.instructions + Map.findUnsafe (parentContext, lambdaID) vm.lambdaInstrCache + |> _.instructions { instructions = List.toArray lambda.instructions resultReg = lambda.resultIn } |> Ply | PackageFn fn -> uply { - match Map.find fn vm.packageFns with + match Map.find fn vm.packageFnInstrCache with | Some fn -> return fn | None -> match! exeState.fns.package fn with @@ -200,7 +201,8 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = let instrData = { instructions = List.toArray fn.body.instructions resultReg = fn.body.resultIn } - vm.packageFns <- Map.add fn.id instrData vm.packageFns + vm.packageFnInstrCache <- + Map.add fn.id instrData vm.packageFnInstrCache return instrData | None -> return raiseRTE (RTE.FnNotFound(FQFnName.Package fn)) @@ -398,7 +400,8 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | CreateLambda(lambdaReg, impl) -> - vm.lambdas <- Map.add (currentFrame.context, impl.exprId) impl vm.lambdas + vm.lambdaInstrCache <- + Map.add (currentFrame.context, impl.exprId) impl vm.lambdaInstrCache registers[lambdaReg] <- { exprId = impl.exprId closedRegisters = @@ -442,7 +445,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = let foundLambda = Map.findUnsafe (currentFrame.context, applicableLambda.exprId) - vm.lambdas + vm.lambdaInstrCache let allArgs = applicableLambda.argsSoFar @ newArgDvals @@ -456,7 +459,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = frameToPush <- { id = guuid () parent = Some(vm.currentFrameID, putResultIn, counter + 1) - pc = 0 + programCounter = 0 registers = let r = Array.zeroCreate foundLambda.instructions.registerCount @@ -536,7 +539,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = frameToPush <- { id = guuid () parent = Some(vm.currentFrameID, putResultIn, counter + 1) - pc = 0 + programCounter = 0 registers = let r = Array.zeroCreate fn.body.registerCount allArgs |> List.iteri (fun i arg -> r[i] <- arg) @@ -574,7 +577,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = vm.currentFrameID <- parentID let parentFrame = Map.findUnsafe parentID vm.callFrames parentFrame.registers[regOfParentToPutResultInto] <- resultOfFrame - parentFrame.pc <- pcOfParent + parentFrame.programCounter <- pcOfParent | None -> vm.callFrames <- Map.remove vm.currentFrameID vm.callFrames diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index c68e6f4817..ae9b493f57 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -202,15 +202,16 @@ type TypeReference = | TString | TUuid | TDateTime - | TList of TypeReference | TTuple of TypeReference * TypeReference * List + | TList of TypeReference + | TDict of TypeReference // CLEANUP add key type | TFn of NEList * TypeReference - // | TDB of TypeReference - | TVariable of string | TCustomType of NameResolution * typeArgs : List - | TDict of TypeReference // CLEANUP add key type + | TVariable of string + // | TDB of TypeReference + member this.isFn() : bool = match this with @@ -595,7 +596,7 @@ and [] Dval = and DvalTask = Ply -// TODO mayube kill this? +// TODO mayube kill this? in favor of CallFrameContext and ExecutionPoint = /// User is executing some "arbitrary" expression, passed in by a user. /// @@ -613,6 +614,7 @@ and ExecutionPoint = // Executing some lambda //| Lambda of parent: ExecutionPoint * exprId: id + /// Record the source expression of an error. /// This is to show the code that was responsible for it. /// TODO maybe rename to ExprLocation @@ -982,11 +984,6 @@ let raiseUntargetedRTE (rte : RuntimeError.Error) : 'a = raise (RuntimeErrorException(None, rte)) -// // (only?) OK in builtins because we "fill in" the callstack in the Interpreter for such failures -// // CLEANUP maybe (somehow) restrict to only Builtins -// let raiseUntargetedRTE (rte : RuntimeError) : 'a = -// raise (RuntimeErrorException(None, rte)) - /// Internally in the runtime, we allow throwing RuntimeErrorExceptions. At the /// boundary, typically in Execution.fs, we will catch the exception, and return @@ -1072,11 +1069,11 @@ module Dval = | DApplicable applicable -> match applicable with | AppLambda _lambda -> - // KTFn( - // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, - // ValueType.Unknown - // ) - // |> ValueType.Known + // KTFn( + // NEList.map (fun _ -> ValueType.Unknown) lambda.parameters, + // ValueType.Unknown + // ) + // |> ValueType.Known ValueType.Unknown // VTTODO look up type, etc @@ -1088,6 +1085,7 @@ module Dval = + type Const = | CUnit | CBool of bool @@ -1144,6 +1142,54 @@ module PackageFn = body : Instructions } +/// Functionality written in Dark stored and managed outside of user space +/// +/// Note: it may be tempting to think these shouldn't return Options, +/// but if/when Package items may live (for some time) only on local systems, +/// there's a chance some code will be committed, referencing something +/// not yet in the Cloud PM. +/// (though, we'll likely demand deps. in the PM before committing something upstream...) +type PackageManager = + { getType : FQTypeName.Package -> Ply> + getConstant : + FQConstantName.Package -> Ply> + getFn : FQFnName.Package -> Ply> + + init : Ply } + + static member empty = + { getType = (fun _ -> Ply None) + getFn = (fun _ -> Ply None) + getConstant = (fun _ -> Ply None) + + init = uply { return () } } + + /// Allows you to side-load a few 'extras' in-memory, along + /// the normal fetching functionality. (Mostly helpful for tests) + static member withExtras + (types : List) + (constants : List) + (fns : List) + (pm : PackageManager) + : PackageManager = + { getType = + fun id -> + match types |> List.tryFind (fun t -> t.id = id) with + | Some t -> Some t |> Ply + | None -> pm.getType id + getConstant = + fun id -> + match constants |> List.tryFind (fun c -> c.id = id) with + | Some c -> Some c |> Ply + | None -> pm.getConstant id + getFn = + fun id -> + match fns |> List.tryFind (fun f -> f.id = id) with + | Some f -> Some f |> Ply + | None -> pm.getFn id + init = pm.init } + + // // ------------ // // User-/Canvas- Space // // ------------ @@ -1253,31 +1299,19 @@ type BuiltInFn = sqlSpec : SqlSpec fn : BuiltInFnSig } -and Fn = - { - name : FQFnName.FQFnName - typeParams : List - parameters : NEList - returnType : TypeReference - previewable : Previewable - sqlSpec : SqlSpec - - /// - /// May throw an exception, though we're trying to get them to never throw exceptions. - /// - fn : FnImpl - } - and BuiltInFnSig = - // exeState * vmState * typeArgs * fnArgs -> result - // CLEANUP this is sort of a _lot_ to pass into every builtin fn call - reduce? + // (exeState * vmState * typeArgs * fnArgs) -> result (ExecutionState * VMState * List * List) -> DvalTask -and FnImpl = - | BuiltInFunction of BuiltInFnSig - | PackageFunction of FQFnName.Package * Instructions //* localCount: int +/// Functionally written in F# and shipped with the executable +and Builtins = + { constants : Map + fns : Map } + +// Tracing -- TODO: move this into its own module, +// and stop defining it recursively with the other things here and FunctionRecord = Source * FQFnName.FQFnName and TraceDval = id -> Dval -> unit @@ -1290,8 +1324,17 @@ and LoadFnResult = FunctionRecord -> NEList -> Option NEList -> Dval -> unit +/// Set of callbacks used to trace the interpreter, and other context needed to run code +and Tracing = + { traceDval : TraceDval + traceExecutionPoint : TraceExecutionPoint + loadFnResult : LoadFnResult + storeFnResult : StoreFnResult } + + + /// Every part of a user's program -/// CLEANUP rename to 'app'? +/// CLEANUP rename to 'app' or 'canvas'? and Program = { canvasID : CanvasID internalFnsAllowed : bool @@ -1299,12 +1342,7 @@ and Program = //secrets : List } -/// Set of callbacks used to trace the interpreter, and other context needed to run code -and Tracing = - { traceDval : TraceDval - traceExecutionPoint : TraceExecutionPoint - loadFnResult : LoadFnResult - storeFnResult : StoreFnResult } + // Used for testing // TODO: maybe this belongs in Execution rather than RuntimeTypes? @@ -1316,57 +1354,9 @@ and TestContext = mutable expectedExceptionCount : int postTestExecutionHook : TestContext -> unit } -/// Functionally written in F# and shipped with the executable -and Builtins = - { constants : Map - fns : Map } -/// Functionality written in Dark stored and managed outside of user space -/// -/// Note: it may be tempting to think these shouldn't return Options, -/// but if/when Package items may live (for some time) only on local systems, -/// there's a chance some code will be committed, referencing something -/// not yet in the Cloud PM. -/// (though, we'll likely demand deps. in the PM before committing something upstream...) -and PackageManager = - { getType : FQTypeName.Package -> Ply> - getConstant : - FQConstantName.Package -> Ply> - getFn : FQFnName.Package -> Ply> - init : Ply } - static member empty = - { getType = (fun _ -> Ply None) - getFn = (fun _ -> Ply None) - getConstant = (fun _ -> Ply None) - - init = uply { return () } } - - /// Allows you to side-load a few 'extras' in-memory, along - /// the normal fetching functionality. (Mostly helpful for tests) - static member withExtras - (types : List) - (constants : List) - (fns : List) - (pm : PackageManager) - : PackageManager = - { getType = - fun id -> - match types |> List.tryFind (fun t -> t.id = id) with - | Some t -> Some t |> Ply - | None -> pm.getType id - getConstant = - fun id -> - match constants |> List.tryFind (fun c -> c.id = id) with - | Some c -> Some c |> Ply - | None -> pm.getConstant id - getFn = - fun id -> - match fns |> List.tryFind (fun f -> f.id = id) with - | Some f -> Some f |> Ply - | None -> pm.getFn id - init = pm.init } and ExceptionReporter = ExecutionState -> Metadata -> exn -> unit @@ -1388,19 +1378,10 @@ and ExecutionState = /// users are doing, etc. notify : Notifier + // -- Set at the start of an execution -- program : Program // TODO: rename to Canvas? - - // -- Can change over time during execution -- - // (probably move these things to VMState) - - // // Maybe replace this and `builtins` with availTypes, availConsts, availFns? - // // We're doing some ExecutionState -> (those) mappings at runtime on occasion, - // // probably a lot more than we need - // packageManager : PackageManager - // builtins : Builtins - types : Types fns : Functions constants : Constants @@ -1409,27 +1390,30 @@ and ExecutionState = and Registers = Dval array and CallFrameContext = - | Source // from raw expr (for test) or TopLevel + /// from raw expr (for test) or TopLevel + | Source | PackageFn of FQFnName.Package - | Lambda of parent : CallFrameContext * id + | Lambda of parent : CallFrameContext * exprId : id and CallFrame = { id : uuid - /// Id * where to put result in parent * pc of parent + /// (Id * where to put result in parent * pc of parent to return to) parent : Option - // TODO the instructions and resultReg are not in the CallFrame itself - // -- multiple CFs may be operating on the same fn or w/e + // The instructions and resultReg are not in the CallFrame itself. + // Multiple CFs may be operating on the same fn/lambda/etc., // so we keep only one copy of such, in the root of the VMState context : CallFrameContext - /// Program counter (what instruction index we are currently 'at') - mutable pc : int + /// What instruction index we are currently 'at' + mutable programCounter : int - registers : Registers // mutable because array? + registers : Registers + + // TODO: typeSymbolTable (or some version of it) probably belongs here } and InstrData = @@ -1441,39 +1425,38 @@ and InstrData = } - and VMState = { mutable threadID : uuid mutable callFrames : Map mutable currentFrameID : uuid - sourceInfo : InstrData // probably could be arg of interpreter -- rename to rootInstrData or something - mutable lambdas : Map - mutable packageFns : Map } + // The inst data for each fn/lambda/etc. is stored here, so that + // it doesn't have to be copied into each CallFrame. + rootInstrData : InstrData + mutable lambdaInstrCache : Map + mutable packageFnInstrCache : Map } - static member fromExpr(expr : Instructions) : VMState = + static member create(expr : Instructions) : VMState = let callFrameId = System.Guid.NewGuid() let callFrame : CallFrame = { id = callFrameId context = Source - pc = 0 + programCounter = 0 registers = Array.zeroCreate expr.registerCount parent = None } { threadID = System.Guid.NewGuid() currentFrameID = callFrameId callFrames = Map [ callFrameId, callFrame ] - sourceInfo = + rootInstrData = { instructions = List.toArray expr.instructions; resultReg = expr.resultIn } - lambdas = Map.empty - packageFns = Map.empty } + lambdaInstrCache = Map.empty + packageFnInstrCache = Map.empty } -and Types = - { typeSymbolTable : TypeSymbolTable - package : FQTypeName.Package -> Ply> } +and Types = { package : FQTypeName.Package -> Ply> } and Constants = { builtIn : Map @@ -1485,23 +1468,8 @@ and Functions = -// module ExecutionState = -// let availableTypes (state : ExecutionState) : Types = -// { typeSymbolTable = state.typeSymbolTable -// //package = state.packageManager.getType -// } - -// let availableConstants (state : ExecutionState) : Constants = -// { builtIn = state.builtins.constants -// package = state.packageManager.getConstant } - -// let availableFunctions (state : ExecutionState) : Functions = -// { builtIn = state.builtins.fns; package = state.packageManager.getFn } - - - module Types = - let empty = { typeSymbolTable = Map.empty; package = (fun _ -> Ply None) } + let empty = { package = (fun _ -> Ply None) } let find (types : Types) @@ -1551,14 +1519,17 @@ module Types = | TUuid | TDateTime -> typ - | TList t -> TList(substitute t) | TTuple(t1, t2, rest) -> TTuple(substitute t1, substitute t2, List.map substitute rest) + | TList t -> TList(substitute t) + | TDict t -> TDict(substitute t) + | TFn _ -> typ // TYPESTODO - // | TDB _ -> typ // TYPESTODO + | TCustomType(typeName, typeArgs) -> TCustomType(typeName, List.map substitute typeArgs) - | TDict t -> TDict(substitute t) + +// | TDB _ -> typ // TYPESTODO @@ -1570,31 +1541,3 @@ let consoleReporter : ExceptionReporter = let consoleNotifier : Notifier = fun _state msg tags -> print $"A notification happened in the runtime:\n {msg}\n {tags}\n\n" - - -// let builtInParamToParam (p : BuiltInParam) : Param = { name = p.name; typ = p.typ } - -// let builtInFnToFn (fn : BuiltInFn) : Fn = -// { name = FQFnName.Builtin fn.name -// typeParams = fn.typeParams -// parameters = -// fn.parameters -// |> List.map builtInParamToParam -// // We'd like to remove this and use NELists, but it's much too annoying to put -// // this in every builtin fn definition -// |> NEList.ofListUnsafe "builtInFnToFn" [ "name", fn.name ] -// returnType = fn.returnType -// previewable = fn.previewable -// sqlSpec = fn.sqlSpec -// fn = BuiltInFunction fn.fn } - -// let packageFnToFn (fn : PackageFn.PackageFn) : Fn = -// let toParam (p : PackageFn.Parameter) : Param = { name = p.name; typ = p.typ } - -// { name = FQFnName.Package fn.id -// typeParams = fn.typeParams -// parameters = fn.parameters |> NEList.map toParam -// returnType = fn.returnType -// previewable = Impure -// sqlSpec = NotQueryable -// fn = PackageFunction(fn.id, fn.body) } diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 9a4422e3ad..5c54b00adc 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -20,7 +20,7 @@ let tCheckVM (extraVmStateAssertions : RT.VMState -> unit) = testTask name { - let vmState = ptExpr |> PT2RT.Expr.toRT Map.empty 0 |> RT.VMState.fromExpr + let vmState = ptExpr |> PT2RT.Expr.toRT Map.empty 0 |> RT.VMState.create let! exeState = executionStateFor TestValues.pm (System.Guid.NewGuid()) false false @@ -419,7 +419,8 @@ module Lambdas = RT.AppLambda { exprId = E.Lambdas.Identity.id; closedRegisters = []; argsSoFar = [] } )) - (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + (fun vm -> + Expect.isFalse (Map.isEmpty vm.lambdaInstrCache) "no lambdas in VMState") let applied = t "(fn x -> x) 1" E.Lambdas.Identity.applied (RT.DInt64 1L) @@ -434,7 +435,8 @@ module Lambdas = RT.AppLambda { exprId = E.Lambdas.Add.id; closedRegisters = []; argsSoFar = [] } )) - (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + (fun vm -> + Expect.isFalse (Map.isEmpty vm.lambdaInstrCache) "no lambdas in VMState") let partiallyApplied = t @@ -463,7 +465,8 @@ module Lambdas = closedRegisters = [ (1, RT.DInt64 5); (2, RT.DInt64 10) ] argsSoFar = [] } )) - (fun vm -> Expect.isFalse (Map.isEmpty vm.lambdas) "no lambdas in VMState") + (fun vm -> + Expect.isFalse (Map.isEmpty vm.lambdaInstrCache) "no lambdas in VMState") let applied = t From ddc51fef39136f2f059e3d4897925ce6ab4ba004 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 19 Sep 2024 12:04:58 -0400 Subject: [PATCH 47/60] More RT tidying --- backend/src/LibExecution/Execution.fs | 6 +- backend/src/LibExecution/RuntimeTypes.fs | 190 ++++++++++++----------- 2 files changed, 99 insertions(+), 97 deletions(-) diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index 6134d77601..ee77b9672c 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -8,7 +8,7 @@ open Prelude module RT = RuntimeTypes module RTE = RT.RuntimeError -let noTracing : RT.Tracing = +let noTracing : RT.Tracing.Tracing = { traceDval = fun _ _ -> () traceExecutionPoint = fun _ -> () loadFnResult = fun _ _ -> None @@ -24,7 +24,7 @@ let noTestContext : RT.TestContext = let createState (builtins : RT.Builtins) (packageManager : RT.PackageManager) - (tracing : RT.Tracing) + (tracing : RT.Tracing.Tracing) (reportException : RT.ExceptionReporter) (notify : RT.Notifier) (program : RT.Program) @@ -211,7 +211,7 @@ let executeExpr /// Return a function to trace Dvals (add it to state via /// state.tracing.traceDval), and a mutable dictionary which updates when the /// traceFn is used -let traceDvals () : Dictionary.T * RT.TraceDval = +let traceDvals () : Dictionary.T * RT.Tracing.TraceDval = let results = Dictionary.empty () let trace (id : id) (dval : RT.Dval) : unit = diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index ae9b493f57..c605fb6e97 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -1276,6 +1276,98 @@ type SqlSpec = | SqlCallback2 _ -> true +module Tracing = + type FunctionRecord = Source * FQFnName.FQFnName + + type TraceDval = id -> Dval -> unit + + type TraceExecutionPoint = ExecutionPoint -> unit + + // why do we need the Dvals here? those are the args, right - do we really need them? + // ah, because we could call the same fn twice, from the same place, but with different args. hmm. + type LoadFnResult = + FunctionRecord -> NEList -> Option + + type StoreFnResult = FunctionRecord -> NEList -> Dval -> unit + + /// Set of callbacks used to trace the interpreter, and other context needed to run code + type Tracing = + { traceDval : TraceDval + traceExecutionPoint : TraceExecutionPoint + loadFnResult : LoadFnResult + storeFnResult : StoreFnResult } + + +// -- The VM -- +type Registers = Dval array + +type CallFrameContext = + /// from raw expr (for test) or TopLevel + | Source + | PackageFn of FQFnName.Package + | Lambda of parent : CallFrameContext * exprId : id + +type CallFrame = + { + id : uuid + + /// (Id * where to put result in parent * pc of parent to return to) + parent : Option + + // The instructions and resultReg are not in the CallFrame itself. + // Multiple CFs may be operating on the same fn/lambda/etc., + // so we keep only one copy of such, in the root of the VMState + context : CallFrameContext + + /// What instruction index we are currently 'at' + mutable programCounter : int + + registers : Registers + + // TODO: typeSymbolTable (or some version of it) probably belongs here + } + +type InstrData = + { + instructions : Instruction array + + /// The register that the result of the block will be in + resultReg : Register + } + +type VMState = + { mutable threadID : uuid + + mutable callFrames : Map + mutable currentFrameID : uuid + + // The inst data for each fn/lambda/etc. is stored here, so that + // it doesn't have to be copied into each CallFrame. + rootInstrData : InstrData + mutable lambdaInstrCache : Map + mutable packageFnInstrCache : Map } + + static member create(expr : Instructions) : VMState = + let callFrameId = System.Guid.NewGuid() + + let callFrame : CallFrame = + { id = callFrameId + context = Source + programCounter = 0 + registers = Array.zeroCreate expr.registerCount + parent = None } + + { threadID = System.Guid.NewGuid() + currentFrameID = callFrameId + callFrames = Map [ callFrameId, callFrame ] + rootInstrData = + { instructions = List.toArray expr.instructions; resultReg = expr.resultIn } + lambdaInstrCache = Map.empty + packageFnInstrCache = Map.empty } + + + +// -- Builtins -- type BuiltInConstant = { name : FQConstantName.Builtin typ : TypeReference @@ -1283,7 +1375,6 @@ type BuiltInConstant = deprecated : Deprecation body : Dval } - /// A built-in standard library function /// /// (Generally shouldn't be accessed directly, @@ -1310,26 +1401,6 @@ and Builtins = fns : Map } -// Tracing -- TODO: move this into its own module, -// and stop defining it recursively with the other things here -and FunctionRecord = Source * FQFnName.FQFnName - -and TraceDval = id -> Dval -> unit - -and TraceExecutionPoint = ExecutionPoint -> unit - -// why do we need the Dvals here? those are the args, right - do we really need them? -// ah, because we could call the same fn twice, from the same place, but with different args. hmm. -and LoadFnResult = FunctionRecord -> NEList -> Option - -and StoreFnResult = FunctionRecord -> NEList -> Dval -> unit - -/// Set of callbacks used to trace the interpreter, and other context needed to run code -and Tracing = - { traceDval : TraceDval - traceExecutionPoint : TraceExecutionPoint - loadFnResult : LoadFnResult - storeFnResult : StoreFnResult } @@ -1343,7 +1414,6 @@ and Program = } - // Used for testing // TODO: maybe this belongs in Execution rather than RuntimeTypes? // and taken out of ExecutionState, where it's not really used? @@ -1356,16 +1426,15 @@ and TestContext = - - and ExceptionReporter = ExecutionState -> Metadata -> exn -> unit and Notifier = ExecutionState -> string -> Metadata -> unit -/// All state used while running a program +/// All state set when starting an execution; non-changing +/// (as opposed to the VMState, which changes as the execution progresses) and ExecutionState = { // -- Set consistently across a runtime -- - tracing : Tracing + tracing : Tracing.Tracing test : TestContext /// Called to report exceptions @@ -1379,7 +1448,7 @@ and ExecutionState = notify : Notifier - // -- Set at the start of an execution -- + // -- Set per-execution -- program : Program // TODO: rename to Canvas? types : Types @@ -1387,73 +1456,6 @@ and ExecutionState = constants : Constants } -and Registers = Dval array - -and CallFrameContext = - /// from raw expr (for test) or TopLevel - | Source - | PackageFn of FQFnName.Package - | Lambda of parent : CallFrameContext * exprId : id - - -and CallFrame = - { - id : uuid - - /// (Id * where to put result in parent * pc of parent to return to) - parent : Option - - // The instructions and resultReg are not in the CallFrame itself. - // Multiple CFs may be operating on the same fn/lambda/etc., - // so we keep only one copy of such, in the root of the VMState - context : CallFrameContext - - /// What instruction index we are currently 'at' - mutable programCounter : int - - registers : Registers - - // TODO: typeSymbolTable (or some version of it) probably belongs here - } - -and InstrData = - { - instructions : Instruction array - - /// The register that the result of the block will be in - resultReg : Register - } - - -and VMState = - { mutable threadID : uuid - - mutable callFrames : Map - mutable currentFrameID : uuid - - // The inst data for each fn/lambda/etc. is stored here, so that - // it doesn't have to be copied into each CallFrame. - rootInstrData : InstrData - mutable lambdaInstrCache : Map - mutable packageFnInstrCache : Map } - - static member create(expr : Instructions) : VMState = - let callFrameId = System.Guid.NewGuid() - - let callFrame : CallFrame = - { id = callFrameId - context = Source - programCounter = 0 - registers = Array.zeroCreate expr.registerCount - parent = None } - - { threadID = System.Guid.NewGuid() - currentFrameID = callFrameId - callFrames = Map [ callFrameId, callFrame ] - rootInstrData = - { instructions = List.toArray expr.instructions; resultReg = expr.resultIn } - lambdaInstrCache = Map.empty - packageFnInstrCache = Map.empty } and Types = { package : FQTypeName.Package -> Ply> } From 6a8a8936dbe6c1c34d5dbd037afa28dc9ef08d69 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 19 Sep 2024 12:08:52 -0400 Subject: [PATCH 48/60] Build ProdExec (largely commented) --- backend/fsdark.sln | 14 ++++++------ backend/src/ProdExec/ProdExec.fs | 38 ++++++++++++++++---------------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index b6a3fb0272..1d5ef2efc3 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -55,8 +55,8 @@ EndProject #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BwdServer", "src\BwdServer\BwdServer.fsproj", "{B56110F0-2D27-4718-8C80-E7FDE3439A63}" #EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ProdExec", "src\ProdExec\ProdExec.fsproj", "{00488B6E-9BB3-49AA-AE42-C120799D803C}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ProdExec", "src\ProdExec\ProdExec.fsproj", "{00488B6E-9BB3-49AA-AE42-C120799D803C}" +EndProject # CLI stuff #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" @@ -137,10 +137,10 @@ Global #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.Build.0 = Release|Any CPU - #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.Build.0 = Release|Any CPU + {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.Build.0 = Debug|Any CPU + {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.ActiveCfg = Release|Any CPU + {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.Build.0 = Release|Any CPU #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -204,7 +204,7 @@ Global #{36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/ProdExec/ProdExec.fs b/backend/src/ProdExec/ProdExec.fs index 3f5761031a..67b70e5017 100644 --- a/backend/src/ProdExec/ProdExec.fs +++ b/backend/src/ProdExec/ProdExec.fs @@ -93,16 +93,16 @@ let usesDB (options : Options) = | ConvertST2RTAll | Help -> false -let convertToRT (canvasID : CanvasID) : Task = - task { - let! canvas = LibCloud.Canvas.loadAll canvasID - let _program = LibCloud.Canvas.toProgram canvas - let _handlers = - canvas.handlers - |> Map.values - |> List.map (fun h -> LibExecution.ProgramTypesToRuntimeTypes.Handler.toRT h) - return () - } +// let convertToRT (canvasID : CanvasID) : Task = +// task { +// let! canvas = LibCloud.Canvas.loadAll canvasID +// let _program = LibCloud.Canvas.toProgram canvas +// let _handlers = +// canvas.handlers +// |> Map.values +// |> List.map (fun h -> LibExecution.ProgramTypesToRuntimeTypes.Handler.toRT h) +// return () +// } @@ -134,13 +134,13 @@ let run (options : Options) : Task = | TriggerPagingRollbar -> return triggerPagingRollbar () - | ConvertST2RT canvasID -> - do! convertToRT canvasID + | ConvertST2RT _canvasID -> + // do! convertToRT canvasID return 0 | ConvertST2RTAll -> - let! allIDs = LibCloud.Canvas.allCanvasIDs () - do! Task.iterWithConcurrency 25 convertToRT allIDs + // let! allIDs = LibCloud.Canvas.allCanvasIDs () + // do! Task.iterWithConcurrency 25 convertToRT allIDs return 0 | Help -> @@ -158,11 +158,11 @@ let initSerializers () = // we probably don't need most of these, but it's key that ProdExec doesn't ever // fail, so we're extra-cautious, and include _everything_. Json.Vanilla.allow "Canvas.loadJsonFromDisk" - Json.Vanilla.allow - "RoundtrippableSerializationFormatV0.Dval" - Json.Vanilla.allow "eventqueue storage" - Json.Vanilla.allow - "TraceCloudStorageFormat" + // Json.Vanilla.allow + // "RoundtrippableSerializationFormatV0.Dval" + //Json.Vanilla.allow "eventqueue storage" + // Json.Vanilla.allow + // "TraceCloudStorageFormat" Json.Vanilla.allow "Rollbar" // for Pusher.com payloads From 29245615c7196b0dadcf17deaf6ec02b14c4ea2b Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 19 Sep 2024 12:34:43 -0400 Subject: [PATCH 49/60] QW is 'building' --- backend/fsdark.sln | 14 +- .../DvalReprInternalRoundtrippable.fs | 6 +- .../src/LibCloudExecution/CloudExecution.fs | 274 +++++----- backend/src/QueueWorker/QueueWorker.fs | 470 +++++++++--------- scripts/build/compile | 43 +- .../devcontainer/_vscode-post-start-command | 4 +- scripts/run-backend-tests | 22 +- 7 files changed, 417 insertions(+), 416 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index 1d5ef2efc3..4d1c70baf2 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -45,8 +45,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\ EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" #EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Wasm", "src\Wasm\Wasm.fsproj", "{5990939C-7E7B-4CFA-86FF-44CA5756498A}" @@ -125,10 +125,10 @@ Global #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.Build.0 = Debug|Any CPU #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.ActiveCfg = Release|Any CPU #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.Build.0 = Release|Any CPU - #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.Build.0 = Release|Any CPU + {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU + {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU + {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.Build.0 = Release|Any CPU {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -201,7 +201,7 @@ Global {3FC57943-9D51-49AE-9FBD-4A112B4F68D6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {824DD2A5-7F01-4A8A-9ABD-9F91F52582AD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs index c23efd36f0..76ac09729e 100644 --- a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs +++ b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs @@ -67,7 +67,7 @@ module FormatV0 = | KTCustomType of FQTypeName.FQTypeName * typeArgs : List - | KTDB of ValueType + //| KTDB of ValueType let rec toRT (kt : KnownType) : RT.KnownType = match kt with @@ -104,7 +104,7 @@ module FormatV0 = | KTCustomType(typeName, typeArgs) -> RT.KTCustomType(FQTypeName.toRT typeName, List.map ValueType.toRT typeArgs) - | KTDB vt -> RT.KTDB(ValueType.toRT vt) + //| KTDB vt -> RT.KTDB(ValueType.toRT vt) let rec fromRT (kt : RT.KnownType) : KnownType = match kt with @@ -144,7 +144,7 @@ module FormatV0 = List.map ValueType.fromRT typeArgs ) - | RT.KTDB vt -> KTDB(ValueType.fromRT vt) + //| RT.KTDB vt -> KTDB(ValueType.fromRT vt) [] type ValueType = diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 2f9433e12b..094285408e 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -31,34 +31,34 @@ let builtins : RT.Builtins = let createState - (traceID : AT.TraceID.T) + (_traceID : AT.TraceID.T) (program : RT.Program) - (tracing : RT.Tracing) + (tracing : RT.Tracing.Tracing) : Task = task { - let extraMetadata (state : RT.ExecutionState) : Metadata = - let callStack = state.tracing.callStack - - let executionPoint ep = - match ep with - | RT.ExecutionPoint.Script -> "Input script" - | RT.ExecutionPoint.Toplevel tlid -> $"Toplevel {tlid}" - | RT.ExecutionPoint.Function fnName -> - match fnName with - | RT.FQFnName.Package name -> $"Package fn {name}" - | RT.FQFnName.Builtin name -> $"Builtin fn {name}" - - [ ("entrypoint", executionPoint callStack.entrypoint) - ("lastCalled", (executionPoint (fst callStack.lastCalled))) - ("traceID", traceID) - ("canvasID", program.canvasID) ] - - let notify (state : RT.ExecutionState) (msg : string) (metadata : Metadata) = - let metadata = extraMetadata state @ metadata + // let extraMetadata (state : RT.ExecutionState) : Metadata = + // let callStack = state.tracing.callStack + + // let executionPoint ep = + // match ep with + // | RT.ExecutionPoint.Script -> "Input script" + // | RT.ExecutionPoint.Toplevel tlid -> $"Toplevel {tlid}" + // | RT.ExecutionPoint.Function fnName -> + // match fnName with + // | RT.FQFnName.Package name -> $"Package fn {name}" + // | RT.FQFnName.Builtin name -> $"Builtin fn {name}" + + // [ ("entrypoint", executionPoint callStack.entrypoint) + // ("lastCalled", (executionPoint (fst callStack.lastCalled))) + // ("traceID", traceID) + // ("canvasID", program.canvasID) ] + + let notify (_state : RT.ExecutionState) (msg : string) (metadata : Metadata) = + //let metadata = extraMetadata state @ metadata LibService.Rollbar.notify msg metadata - let sendException (state : RT.ExecutionState) (metadata : Metadata) (exn : exn) = - let metadata = extraMetadata state @ metadata + let sendException (_state : RT.ExecutionState) (metadata : Metadata) (exn : exn) = + //let metadata = extraMetadata state @ metadata LibService.Rollbar.sendException None metadata exn return @@ -73,120 +73,120 @@ type ExecutionReason = /// A reexecution is a trace that already exists, being amended with new values | ReExecution -/// Execute handler. -/// This could be -/// - the first execution, which will -/// - have an ExecutionReason of InitialExecution -/// - initialize traces -/// - send pushes -/// - or ReExecution, which will -/// - update existing traces -/// - not send pushes -let executeHandler - (pusherSerializer : Pusher.PusherEventSerializer) - (h : RT.Handler.T) - (program : RT.Program) - (traceID : AT.TraceID.T) - (inputVars : Map) - (reason : ExecutionReason) - : Task = - task { - let tracing = Tracing.create program.canvasID h.tlid traceID - - // Store the inputs of the trace (i.e. the arguments to the handler) - match reason with - | InitialExecution(desc, varname, inputVar) -> - tracing.storeTraceInput desc varname inputVar - | ReExecution -> () - - let! state = createState traceID program tracing.executionTracing - let state = - { state with tracing.callStack.entrypoint = RT.ExecutionPoint.Toplevel h.tlid } - HashSet.add h.tlid tracing.results.tlids - let! result = Exe.executeExpr state inputVars h.ast - - let callStackString = Exe.callStackString state - - let error (msg : string) : RT.Dval = - let typeName = RT.FQTypeName.fqPackage PackageIDs.Type.Stdlib.Http.response - - let fields = - [ ("statusCode", RT.DInt64 500) - ("headers", - [] |> Dval.list (RT.KTTuple(RT.ValueType.string, RT.ValueType.string, []))) - ("body", msg |> UTF8.toBytes |> Dval.byteArrayToDvalList) ] - - RT.DRecord(typeName, typeName, [], Map fields) - - // CLEANUP This is a temporary hack to make it easier to work on local dev - // servers. We should restrict this to dev mode only - let! result = - task { - match result with - | Ok result -> return result - | Error(originalCallStack, originalRTE) -> - let! originalCallStack = callStackString originalCallStack - - match! Exe.runtimeErrorToString state originalRTE with - | Ok(RT.DString msg) -> - let msg = $"Error: {msg}\n\nSource: {originalCallStack}" - return error msg - | Ok result -> return result - | Error(firstErrorCallStack, firstErrorRTE) -> - let! firstErrorCallStack = callStackString firstErrorCallStack - match! Exe.runtimeErrorToString state firstErrorRTE with - | Ok(RT.DString msg) -> - return - error ( - $"An error occured trying to print a runtime error." - + $"\n\nThe formatting error occurred in {firstErrorCallStack}. The error was:\n{msg}" - + $"\n\nThe original error is ({originalCallStack}) {originalRTE}" - ) - | Ok result -> return result - | Error(secondErrorCallStack, secondErrorRTE) -> - let! secondErrorCallStack = callStackString secondErrorCallStack - return - error ( - $"Two errors occured trying to print a runtime error." - + $"\n\nThe 2nd formatting error occurred in {secondErrorCallStack}. The error was:\n{secondErrorRTE}" - + $"\n\nThe first formatting error occurred in {firstErrorCallStack}. The error was:\n{firstErrorRTE}" - + $"\n\nThe original error is ({originalCallStack}) {originalRTE}" - ) - } - - tracing.storeTraceResults () - - match reason with - | ReExecution -> () - | InitialExecution _ -> - if tracing.enabled then - let tlids = HashSet.toList tracing.results.tlids - Pusher.push - pusherSerializer - program.canvasID - (Pusher.NewTrace(traceID, tlids)) - None - - return (result, tracing.results) - } - -/// We call this reexecuteFunction because it always runs in an existing trace. -let reexecuteFunction - (canvasID : CanvasID) - (program : RT.Program) - (traceID : AT.TraceID.T) - (rootTLID : tlid) - (name : RT.FQFnName.FQFnName) - (typeArgs : List) - (args : NEList) - : Task = - task { - let tracing = Tracing.create canvasID rootTLID traceID - let! state = createState traceID program tracing.executionTracing - let! result = Exe.executeFunction state name typeArgs args - tracing.storeTraceResults () - return result, tracing.results - } +// /// Execute handler. +// /// This could be +// /// - the first execution, which will +// /// - have an ExecutionReason of InitialExecution +// /// - initialize traces +// /// - send pushes +// /// - or ReExecution, which will +// /// - update existing traces +// /// - not send pushes +// let executeHandler +// (pusherSerializer : Pusher.PusherEventSerializer) +// (h : RT.Handler.T) +// (program : RT.Program) +// (traceID : AT.TraceID.T) +// (inputVars : Map) +// (reason : ExecutionReason) +// : Task = +// task { +// let tracing = Tracing.create program.canvasID h.tlid traceID + +// // Store the inputs of the trace (i.e. the arguments to the handler) +// match reason with +// | InitialExecution(desc, varname, inputVar) -> +// tracing.storeTraceInput desc varname inputVar +// | ReExecution -> () + +// let! state = createState traceID program tracing.executionTracing +// let state = +// { state with tracing.callStack.entrypoint = RT.ExecutionPoint.Toplevel h.tlid } +// HashSet.add h.tlid tracing.results.tlids +// let! result = Exe.executeExpr state inputVars h.ast + +// let callStackString = Exe.callStackString state + +// let error (msg : string) : RT.Dval = +// let typeName = RT.FQTypeName.fqPackage PackageIDs.Type.Stdlib.Http.response + +// let fields = +// [ ("statusCode", RT.DInt64 500) +// ("headers", +// [] |> Dval.list (RT.KTTuple(RT.ValueType.string, RT.ValueType.string, []))) +// ("body", msg |> UTF8.toBytes |> Dval.byteArrayToDvalList) ] + +// RT.DRecord(typeName, typeName, [], Map fields) + +// // CLEANUP This is a temporary hack to make it easier to work on local dev +// // servers. We should restrict this to dev mode only +// let! result = +// task { +// match result with +// | Ok result -> return result +// | Error(originalCallStack, originalRTE) -> +// let! originalCallStack = callStackString originalCallStack + +// match! Exe.runtimeErrorToString state originalRTE with +// | Ok(RT.DString msg) -> +// let msg = $"Error: {msg}\n\nSource: {originalCallStack}" +// return error msg +// | Ok result -> return result +// | Error(firstErrorCallStack, firstErrorRTE) -> +// let! firstErrorCallStack = callStackString firstErrorCallStack +// match! Exe.runtimeErrorToString state firstErrorRTE with +// | Ok(RT.DString msg) -> +// return +// error ( +// $"An error occured trying to print a runtime error." +// + $"\n\nThe formatting error occurred in {firstErrorCallStack}. The error was:\n{msg}" +// + $"\n\nThe original error is ({originalCallStack}) {originalRTE}" +// ) +// | Ok result -> return result +// | Error(secondErrorCallStack, secondErrorRTE) -> +// let! secondErrorCallStack = callStackString secondErrorCallStack +// return +// error ( +// $"Two errors occured trying to print a runtime error." +// + $"\n\nThe 2nd formatting error occurred in {secondErrorCallStack}. The error was:\n{secondErrorRTE}" +// + $"\n\nThe first formatting error occurred in {firstErrorCallStack}. The error was:\n{firstErrorRTE}" +// + $"\n\nThe original error is ({originalCallStack}) {originalRTE}" +// ) +// } + +// tracing.storeTraceResults () + +// match reason with +// | ReExecution -> () +// | InitialExecution _ -> +// if tracing.enabled then +// let tlids = HashSet.toList tracing.results.tlids +// Pusher.push +// pusherSerializer +// program.canvasID +// (Pusher.NewTrace(traceID, tlids)) +// None + +// return (result, tracing.results) +// } + +// /// We call this reexecuteFunction because it always runs in an existing trace. +// let reexecuteFunction +// (canvasID : CanvasID) +// (program : RT.Program) +// (traceID : AT.TraceID.T) +// (rootTLID : tlid) +// (name : RT.FQFnName.FQFnName) +// (typeArgs : List) +// (args : NEList) +// : Task = +// task { +// let tracing = Tracing.create canvasID rootTLID traceID +// let! state = createState traceID program tracing.executionTracing +// let! result = Exe.executeFunction state name typeArgs args +// tracing.storeTraceResults () +// return result, tracing.results +// } /// Ensure library is ready to be called. Throws if it cannot initialize. diff --git a/backend/src/QueueWorker/QueueWorker.fs b/backend/src/QueueWorker/QueueWorker.fs index 109d49bb50..9410f58271 100644 --- a/backend/src/QueueWorker/QueueWorker.fs +++ b/backend/src/QueueWorker/QueueWorker.fs @@ -10,11 +10,11 @@ open Prelude module PTParser = LibExecution.ProgramTypesParser module AT = LibExecution.AnalysisTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module EQ = LibCloud.Queue +//module EQ = LibCloud.Queue module Pusher = LibCloud.Pusher module CloudExecution = LibCloudExecution.CloudExecution -module Canvas = LibCloud.Canvas -module DvalReprDeveloper = LibExecution.DvalReprDeveloper +//module Canvas = LibCloud.Canvas +//module DvalReprDeveloper = LibExecution.DvalReprDeveloper module LD = LibService.LaunchDarkly module Telemetry = LibService.Telemetry @@ -22,7 +22,7 @@ module Rollbar = LibService.Rollbar module CTPusher = LibClientTypes.Pusher -open LibCloud.Db +//open LibCloud.Db let mutable shouldShutdown = false @@ -31,219 +31,220 @@ type ShouldRetry = | Retry of NodaTime.Duration | NoRetry -/// The algorithm here is described in the chart in `docs/eventsV2.md`. -/// The code below is annotated with names from chart. -/// -/// Notes: -/// - `dequeueAndProcess` will block until it receives a notification. -/// - Returns a Result containing the notification and the -/// event on success, and just the notification and failure reason on failure. -/// - Should not throw on error. -let processNotification - (notification : EQ.Notification) - : Task> = - task { - use _span = Telemetry.createRoot "process" - Telemetry.addTags - [ "event.time_in_queue_ms", notification.timeInQueue.TotalMilliseconds - "event.id", notification.data.id - "event.canvas_id", notification.data.canvasID - "event.delivery_attempt", notification.deliveryAttempt - "event.pubsub.ack_id", notification.pubSubAckID - "event.pubsub.message_id", notification.pubSubMessageID ] - - // Function used to quit this event - let stop - (reason : string) - (retry : ShouldRetry) - : Task> = - task { - Telemetry.addTags - [ "queue.completion_reason", reason - "queue.success", false - "queue.retrying", retry <> NoRetry ] - match retry with - | Retry delay -> return! EQ.requeueEvent notification delay - | NoRetry -> return! EQ.acknowledgeEvent notification - return Error(reason, notification) // no events executed - } - - // ------- - // EventLoad - // ------- - match! EQ.loadEvent notification.data.canvasID notification.data.id with - | None -> return! stop "EventMissing" NoRetry - | Some event -> // EventPresent - Telemetry.addTags - [ "event.handler.name", event.name - "event.handler.modifier", event.modifier - "event.handler.module", event.module' - "event.value.type", (event.value |> DvalReprDeveloper.toTypeName :> obj) - "event.locked_at", event.lockedAt - "event.enqueued_at", event.enqueuedAt ] - - - // ------- - // LockCheck - // ------- - let timeLeft = - match event.lockedAt with - | Some lockedAt -> // LockExpired - let expiryTime = lockedAt.Plus(NodaTime.Duration.FromMinutes 5.0) - // Date math is hard so let's spell it out. `timeLeft` measures how long is - // left until the lock expires. If there is time left until the lock - // expires, `timeLeft` is positive. So - // - // `timeLeft = expiryTime - now` - // - // as that way there is positive `timeLeft` if `expiryTime` is later than - // `now`. - expiryTime - Instant.now () - | None -> NodaTime.Duration.FromSeconds 0.0 // LockNone - - if timeLeft.TotalSeconds > 0 then - // RETRY but it means something else is running it so doesn't matter - return! stop "IsLocked" (Retry timeLeft) - else // LockNone/LockExpired - - // ------- - // RuleCheck - // ------- - match! EQ.getRule notification.data.canvasID event with - | Some rule -> - // Drop the notification - we'll requeue it if someone unpauses - Telemetry.addTags - [ "queue.rule.type", rule.ruleType; "queue.rule.id", rule.id ] - return! stop "RuleCheckPaused/Blocked" NoRetry - | None -> // RuleNone - // ------- - // DeliveryCheck - // Note that this happens after all the other checks, as we might have - // multiple notifications for the same event and we don't want to delete - // one that is being executed or isn't ready. We stop after 4 retries here - // because the retries might happen for a reason that isn't strictly - // retries, such as lockedAt. - // ------- - if notification.deliveryAttempt >= 5 then - // DeliveryTooManyRetries - do! EQ.deleteEvent event - return! stop "DeliveryTooMany" NoRetry - else // DeliveryPermitted - - // ------- - // LockClaim - // ------- - match! EQ.claimLock event notification with - | Error msg -> - // Someone else just claimed the lock! - let retryTime = NodaTime.Duration.FromSeconds 300.0 - return! stop $"LockClaimFailed: {msg}" (Retry retryTime) - | Ok() -> // LockClaimed - - // ------- - // Process - // ------- - let! canvas = - Exception.taskCatch (fun () -> - task { - return! - Canvas.loadForEvent - notification.data.canvasID - event.module' - event.name - event.modifier - }) - match canvas with - | None -> - do! EQ.deleteEvent event - return! stop "MissingCanvas" NoRetry - | Some c -> - let traceID = AT.TraceID.create () - let desc = (event.module', event.name, event.modifier) - Telemetry.addTags [ "canvasID", c.id; "trace_id", traceID ] - - - // CLEANUP switch events and scheduling rules to use TLIDs instead of eventDescs - let h = - c.handlers - |> Map.values - |> List.filter (fun h -> - Some desc = PTParser.Handler.Spec.toEventDesc h.spec) - |> List.head - - match h with - | None -> - // If an event gets put in the queue and there's no handler for it, - // they're probably emiting to a handler they haven't created yet. - // In this case, all they need to build is the trace. So just drop - // this event immediately. - - // TODO: reenable using CloudStorage - // let! timestamp = TI.storeEvent c.id traceID desc event.value - // Pusher.push - // LibClientTypesToCloudTypes.Pusher.eventSerializer - // c.id - // (Pusher.New404( - // event.module', - // event.name, - // event.modifier, - // timestamp, - // traceID - // )) - // None - - do! EQ.deleteEvent event - return! stop "MissingHandler" NoRetry - | Some h -> - - // If we acknowledge the event here, and the machine goes down, - // PubSub will retry this once the ack deadline runs out - do! EQ.extendDeadline notification - - // CLEANUP Set a time limit of 3m - try - let! program = Canvas.toProgram c - let! (result, traceResults) = - CloudExecution.executeHandler - LibClientTypesToCloudTypes.Pusher.eventSerializer - (PT2RT.Handler.toRT h) - program - traceID - (Map [ "event", event.value ]) - (CloudExecution.InitialExecution( - EQ.toEventDesc event, - "event", - event.value - )) - - Telemetry.addTags - [ "result_type", DvalReprDeveloper.toTypeName result - "queue.success", true - "executed_tlids", HashSet.toList traceResults.tlids - "queue.completion_reason", "completed" ] - // ExecutesToCompletion - - // ------- - // Delete - // ------- - do! EQ.deleteEvent event - do! EQ.acknowledgeEvent notification - - // ------- - // End - // ------- - return Ok(event, notification) - with _ -> - // This automatically increments the deliveryAttempt, so it might - // be deleted at the next iteration. - let timeLeft = NodaTime.Duration.FromSeconds 301.0 - return! stop "RetryAllowed" (Retry timeLeft) - } + +// /// The algorithm here is described in the chart in `docs/eventsV2.md`. +// /// The code below is annotated with names from chart. +// /// +// /// Notes: +// /// - `dequeueAndProcess` will block until it receives a notification. +// /// - Returns a Result containing the notification and the +// /// event on success, and just the notification and failure reason on failure. +// /// - Should not throw on error. +// let processNotification +// (notification : EQ.Notification) +// : Task> = +// task { +// use _span = Telemetry.createRoot "process" +// Telemetry.addTags +// [ "event.time_in_queue_ms", notification.timeInQueue.TotalMilliseconds +// "event.id", notification.data.id +// "event.canvas_id", notification.data.canvasID +// "event.delivery_attempt", notification.deliveryAttempt +// "event.pubsub.ack_id", notification.pubSubAckID +// "event.pubsub.message_id", notification.pubSubMessageID ] + +// // Function used to quit this event +// let stop +// (reason : string) +// (retry : ShouldRetry) +// : Task> = +// task { +// Telemetry.addTags +// [ "queue.completion_reason", reason +// "queue.success", false +// "queue.retrying", retry <> NoRetry ] +// match retry with +// | Retry delay -> return! EQ.requeueEvent notification delay +// | NoRetry -> return! EQ.acknowledgeEvent notification +// return Error(reason, notification) // no events executed +// } + +// // ------- +// // EventLoad +// // ------- +// match! EQ.loadEvent notification.data.canvasID notification.data.id with +// | None -> return! stop "EventMissing" NoRetry +// | Some event -> // EventPresent +// Telemetry.addTags +// [ "event.handler.name", event.name +// "event.handler.modifier", event.modifier +// "event.handler.module", event.module' +// "event.value.type", (event.value |> DvalReprDeveloper.toTypeName :> obj) +// "event.locked_at", event.lockedAt +// "event.enqueued_at", event.enqueuedAt ] + + +// // ------- +// // LockCheck +// // ------- +// let timeLeft = +// match event.lockedAt with +// | Some lockedAt -> // LockExpired +// let expiryTime = lockedAt.Plus(NodaTime.Duration.FromMinutes 5.0) +// // Date math is hard so let's spell it out. `timeLeft` measures how long is +// // left until the lock expires. If there is time left until the lock +// // expires, `timeLeft` is positive. So +// // +// // `timeLeft = expiryTime - now` +// // +// // as that way there is positive `timeLeft` if `expiryTime` is later than +// // `now`. +// expiryTime - Instant.now () +// | None -> NodaTime.Duration.FromSeconds 0.0 // LockNone + +// if timeLeft.TotalSeconds > 0 then +// // RETRY but it means something else is running it so doesn't matter +// return! stop "IsLocked" (Retry timeLeft) +// else // LockNone/LockExpired + +// // ------- +// // RuleCheck +// // ------- +// match! EQ.getRule notification.data.canvasID event with +// | Some rule -> +// // Drop the notification - we'll requeue it if someone unpauses +// Telemetry.addTags +// [ "queue.rule.type", rule.ruleType; "queue.rule.id", rule.id ] +// return! stop "RuleCheckPaused/Blocked" NoRetry +// | None -> // RuleNone +// // ------- +// // DeliveryCheck +// // Note that this happens after all the other checks, as we might have +// // multiple notifications for the same event and we don't want to delete +// // one that is being executed or isn't ready. We stop after 4 retries here +// // because the retries might happen for a reason that isn't strictly +// // retries, such as lockedAt. +// // ------- +// if notification.deliveryAttempt >= 5 then +// // DeliveryTooManyRetries +// do! EQ.deleteEvent event +// return! stop "DeliveryTooMany" NoRetry +// else // DeliveryPermitted + +// // ------- +// // LockClaim +// // ------- +// match! EQ.claimLock event notification with +// | Error msg -> +// // Someone else just claimed the lock! +// let retryTime = NodaTime.Duration.FromSeconds 300.0 +// return! stop $"LockClaimFailed: {msg}" (Retry retryTime) +// | Ok() -> // LockClaimed + +// // ------- +// // Process +// // ------- +// let! canvas = +// Exception.taskCatch (fun () -> +// task { +// return! +// Canvas.loadForEvent +// notification.data.canvasID +// event.module' +// event.name +// event.modifier +// }) +// match canvas with +// | None -> +// do! EQ.deleteEvent event +// return! stop "MissingCanvas" NoRetry +// | Some c -> +// let traceID = AT.TraceID.create () +// let desc = (event.module', event.name, event.modifier) +// Telemetry.addTags [ "canvasID", c.id; "trace_id", traceID ] + + +// // CLEANUP switch events and scheduling rules to use TLIDs instead of eventDescs +// let h = +// c.handlers +// |> Map.values +// |> List.filter (fun h -> +// Some desc = PTParser.Handler.Spec.toEventDesc h.spec) +// |> List.head + +// match h with +// | None -> +// // If an event gets put in the queue and there's no handler for it, +// // they're probably emiting to a handler they haven't created yet. +// // In this case, all they need to build is the trace. So just drop +// // this event immediately. + +// // TODO: reenable using CloudStorage +// // let! timestamp = TI.storeEvent c.id traceID desc event.value +// // Pusher.push +// // LibClientTypesToCloudTypes.Pusher.eventSerializer +// // c.id +// // (Pusher.New404( +// // event.module', +// // event.name, +// // event.modifier, +// // timestamp, +// // traceID +// // )) +// // None + +// do! EQ.deleteEvent event +// return! stop "MissingHandler" NoRetry +// | Some h -> + +// // If we acknowledge the event here, and the machine goes down, +// // PubSub will retry this once the ack deadline runs out +// do! EQ.extendDeadline notification + +// // CLEANUP Set a time limit of 3m +// try +// let! program = Canvas.toProgram c +// let! (result, traceResults) = +// CloudExecution.executeHandler +// LibClientTypesToCloudTypes.Pusher.eventSerializer +// (PT2RT.Handler.toRT h) +// program +// traceID +// (Map [ "event", event.value ]) +// (CloudExecution.InitialExecution( +// EQ.toEventDesc event, +// "event", +// event.value +// )) + +// Telemetry.addTags +// [ "result_type", DvalReprDeveloper.toTypeName result +// "queue.success", true +// "executed_tlids", HashSet.toList traceResults.tlids +// "queue.completion_reason", "completed" ] +// // ExecutesToCompletion + +// // ------- +// // Delete +// // ------- +// do! EQ.deleteEvent event +// do! EQ.acknowledgeEvent notification + +// // ------- +// // End +// // ------- +// return Ok(event, notification) +// with _ -> +// // This automatically increments the deliveryAttempt, so it might +// // be deleted at the next iteration. +// let timeLeft = NodaTime.Duration.FromSeconds 301.0 +// return! stop "RetryAllowed" (Retry timeLeft) +// } /// Run in the background, using the semaphore to track completion let runInBackground (semaphore : System.Threading.SemaphoreSlim) - (notification : EQ.Notification) + //(notification : EQ.Notification) : unit = // Ensure we get a lock before the background task starts. We should always get a // lock here, but if something goes awry it's better that we wait rather than fetch @@ -251,7 +252,7 @@ let runInBackground semaphore.Wait() backgroundTask { try - let! (_ : Result<_, _>) = processNotification notification + //let! (_ : Result<_, _>) = processNotification notification return () finally semaphore.Release() |> ignore @@ -272,23 +273,24 @@ let run () : Task = // decided somewhat dynamically by a feature flag. So just pick a high number, // and then use the semaphore to count the events in progress. let initialCount = 100000 // just be a high number - let semaphore = new System.Threading.SemaphoreSlim(initialCount) + let _semaphore = new System.Threading.SemaphoreSlim(initialCount) - let maxEventsFn = LD.queueMaxConcurrentEventsPerWorker + let _maxEventsFn = LD.queueMaxConcurrentEventsPerWorker while not shouldShutdown do - let timeout = System.TimeSpan.FromSeconds 5 + let _timeout = System.TimeSpan.FromSeconds 5 try - // TODO: include memory and CPU usage checks in here - let runningCount = initialCount - semaphore.CurrentCount - let remainingSlots = maxEventsFn () - runningCount - if remainingSlots > 0 then - let! notifications = EQ.dequeue timeout remainingSlots - if notifications = [] then - do! Task.Delay(LD.queueDelayBetweenPullsInMillis ()) - else - List.iter (runInBackground semaphore) notifications - else - do! Task.Delay(LD.queueDelayBetweenPullsInMillis ()) + // // TODO: include memory and CPU usage checks in here + // let runningCount = initialCount - semaphore.CurrentCount + // let remainingSlots = maxEventsFn () - runningCount + // if remainingSlots > 0 then + // // let! notifications = EQ.dequeue timeout remainingSlots + // // if notifications = [] then + // // do! Task.Delay(LD.queueDelayBetweenPullsInMillis ()) + // // else + // List.iter (runInBackground semaphore) //notifications + // else + // do! Task.Delay(LD.queueDelayBetweenPullsInMillis ()) + () with e -> // No matter where else we catch it, this is essential or else the loop won't @@ -304,12 +306,12 @@ let initSerializers () = // universally-serializable types // one-off types used internally - Json.Vanilla.allow - "RoundtrippableSerializationFormatV0.Dval" + // Json.Vanilla.allow + // "RoundtrippableSerializationFormatV0.Dval" Json.Vanilla.allow "Canvas.loadJsonFromDisk" - Json.Vanilla.allow "eventqueue storage" - Json.Vanilla.allow - "TraceCloudStorageFormat" + //Json.Vanilla.allow "eventqueue storage" + // Json.Vanilla.allow + // "TraceCloudStorageFormat" Json.Vanilla.allow "Rollbar" // for Pusher.com payloads @@ -338,7 +340,7 @@ let main _ : int = // Set up healthchecks and shutdown with k8s let port = LibService.Config.queueWorkerKubernetesPort - let healthChecks = [ Canvas.healthCheck ] + let healthChecks = [ ] //Canvas.healthCheck ] LibService.Kubernetes.runKubernetesServer name healthChecks port shutdownCallback |> ignore diff --git a/scripts/build/compile b/scripts/build/compile index b7ba938cb1..9a615b0973 100755 --- a/scripts/build/compile +++ b/scripts/build/compile @@ -319,36 +319,35 @@ def execute(should): # if should.reload_backend_server: # if not reload_backend_server(): success = False - # if should.clear_local_db: - # if not clear_local_db(): success = False - # should.run_migrations |= success - # should.reload_all_packages |= success - - # if should.run_migrations: - # if not run_migrations(): success = False + if should.clear_local_db: + if not clear_local_db(): success = False + should.run_migrations |= success + should.reload_all_packages |= success - # if should.reload_all_packages: - # if not reload_all_packages(): success = False + if should.run_migrations: + if not run_migrations(): success = False - # if should.backend_test: - # if not backend_test(): success = False + if should.reload_all_packages: + if not reload_all_packages(): success = False + if should.backend_test: + if not backend_test(): success = False - # # misc validations and formatting checkers - # if should.circleci_validate: - # if not circleci_validate(): success = False + # misc validations and formatting checkers + if should.circleci_validate: + if not circleci_validate(): success = False - # if should.shellcheck != []: - # all_files = " ".join(should.shellcheck) - # if not shellcheck(all_files): success = False + if should.shellcheck != []: + all_files = " ".join(should.shellcheck) + if not shellcheck(all_files): success = False - # if should.yamllint: - # if not all([yamllint(f) for f in should.yamllint]): - # success = False + if should.yamllint: + if not all([yamllint(f) for f in should.yamllint]): + success = False - # if should.terraform_validate: - # if not terraform_validate(): success = False + if should.terraform_validate: + if not terraform_validate(): success = False return success diff --git a/scripts/devcontainer/_vscode-post-start-command b/scripts/devcontainer/_vscode-post-start-command index 92dee82a90..d7eac61dd4 100755 --- a/scripts/devcontainer/_vscode-post-start-command +++ b/scripts/devcontainer/_vscode-post-start-command @@ -2,8 +2,8 @@ set -euo pipefail -#echo "Fetching and building tree-sitter library" -#./scripts/build/build-tree-sitter.sh +echo "Fetching and building tree-sitter library" +./scripts/build/build-tree-sitter.sh echo "Starting build server" diff --git a/scripts/run-backend-tests b/scripts/run-backend-tests index 79d49dbb17..58f2e1eead 100755 --- a/scripts/run-backend-tests +++ b/scripts/run-backend-tests @@ -34,10 +34,10 @@ killall -9 Tests || true if [[ "$PUBLISHED" == "true" ]]; then EXE=Build/out/Tests/Release/net8.0/linux-x64/Tests - # PRODEXEC=Build/out/ProdExec/Release/net8.0/linux-x64/ProdExec + PRODEXEC=Build/out/ProdExec/Release/net8.0/linux-x64/ProdExec else EXE=Build/out/Tests/Debug/net8.0/Tests - # PRODEXEC=Build/out/ProdExec/Debug/net8.0/ProdExec + PRODEXEC=Build/out/ProdExec/Debug/net8.0/ProdExec fi case "$DB" in @@ -78,15 +78,15 @@ RANDOM_VALUE=$(cat /proc/sys/kernel/random/uuid) grey="\033[1;30m" reset="\033[0m" -# # Run the migrations before the other servers start -# echo -e "Running migrations ${grey}($LOGS/test-migrations.log)${reset}" -# cd backend && \ -# DARK_CONFIG_TELEMETRY_EXPORTER=none \ -# DARK_CONFIG_ROLLBAR_ENABLED=n \ -# DARK_CONFIG_QUEUE_PUBSUB_PROJECT_ID=pubsub-test-${RANDOM_VALUE} \ -# DARK_CONFIG_TRACE_STORAGE_BUCKET_NAME=trace-test-${RANDOM_VALUE} \ -# "${PRODEXEC}" migrations run > "$LOGS/test-migrations.log" 2>&1 -# cd .. +# Run the migrations before the other servers start +echo -e "Running migrations ${grey}($LOGS/test-migrations.log)${reset}" +cd backend && \ + DARK_CONFIG_TELEMETRY_EXPORTER=none \ + DARK_CONFIG_ROLLBAR_ENABLED=n \ + DARK_CONFIG_QUEUE_PUBSUB_PROJECT_ID=pubsub-test-${RANDOM_VALUE} \ + DARK_CONFIG_TRACE_STORAGE_BUCKET_NAME=trace-test-${RANDOM_VALUE} \ + "${PRODEXEC}" migrations run > "$LOGS/test-migrations.log" 2>&1 +cd .. # Reload packages From 5db0234dceb7da06882e94509657544a165df0ec Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 20 Sep 2024 09:10:08 -0400 Subject: [PATCH 50/60] all projects building --- backend/fsdark.sln | 84 ++-- backend/src/BwdServer/Server.fs | 361 +++++++++--------- backend/src/Cli/Cli.fs | 68 ++-- backend/src/CronChecker/CronChecker.fs | 9 +- .../DvalReprInternalRoundtrippable.fs | 6 +- .../src/LibCloudExecution/CloudExecution.fs | 6 +- backend/src/LibExecution/Execution.fs | 63 ++- backend/src/LibHttpMiddleware/Http.fs | 26 +- backend/src/QueueWorker/QueueWorker.fs | 2 +- 9 files changed, 313 insertions(+), 312 deletions(-) diff --git a/backend/fsdark.sln b/backend/fsdark.sln index 4d1c70baf2..922d071b0b 100644 --- a/backend/fsdark.sln +++ b/backend/fsdark.sln @@ -39,30 +39,30 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibService", "src\LibServic EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCloudExecution", "src\BuiltinCloudExecution\BuiltinCloudExecution.fsproj", "{82CA75E9-53BD-4324-B86B-44F280BAF331}" EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloudExecution", "src\LibCloudExecution\LibCloudExecution.fsproj", "{FA55A52D-B880-4931-A121-85C8DAD8DD28}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinDarkInternal", "src\BuiltinDarkInternal\BuiltinDarkInternal.fsproj", "{B6933551-A7A3-4A85-BEF4-43214ABB04DF}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibCloud", "src\LibCloud\LibCloud.fsproj", "{3FC57943-9D51-49AE-9FBD-4A112B4F68D6}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "QueueWorker", "src\QueueWorker\QueueWorker.fsproj", "{36E1611F-55E4-4DFE-BB04-913FEA9950ED}" EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CronChecker", "src\CronChecker\CronChecker.fsproj", "{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}" +EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Wasm", "src\Wasm\Wasm.fsproj", "{5990939C-7E7B-4CFA-86FF-44CA5756498A}" #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 +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 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ProdExec", "src\ProdExec\ProdExec.fsproj", "{00488B6E-9BB3-49AA-AE42-C120799D803C}" EndProject # CLI stuff -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" -#EndProject -#Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}" -#EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}" +EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LibPackageManager", "src\LibPackageManager\LibPackageManager.fsproj", "{A74049E0-AD31-407B-9918-6A6A76C945C9}" EndProject #Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCliHost", "src\BuiltinCliHost\BuiltinCliHost.fsproj", "{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}" @@ -89,10 +89,10 @@ 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 + {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 @@ -121,10 +121,10 @@ Global {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Debug|Any CPU.Build.0 = Debug|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|Any CPU.ActiveCfg = Release|Any CPU {BBFC824F-A0DE-4A28-B82F-49C04EBA7475}.Release|Any CPU.Build.0 = Release|Any CPU - #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.Build.0 = Release|Any CPU + {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Debug|Any CPU.Build.0 = Debug|Any CPU + {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.ActiveCfg = Release|Any CPU + {FA55A52D-B880-4931-A121-85C8DAD8DD28}.Release|Any CPU.Build.0 = Release|Any CPU {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Debug|Any CPU.Build.0 = Debug|Any CPU {36E1611F-55E4-4DFE-BB04-913FEA9950ED}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -133,18 +133,18 @@ Global {82CA75E9-53BD-4324-B86B-44F280BAF331}.Debug|Any CPU.Build.0 = Debug|Any CPU {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.ActiveCfg = Release|Any CPU {82CA75E9-53BD-4324-B86B-44F280BAF331}.Release|Any CPU.Build.0 = Release|Any CPU - #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.Build.0 = Release|Any CPU + {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Debug|Any CPU.Build.0 = Debug|Any CPU + {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.ActiveCfg = Release|Any CPU + {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA}.Release|Any CPU.Build.0 = Release|Any CPU {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {00488B6E-9BB3-49AA-AE42-C120799D803C}.Debug|Any CPU.Build.0 = Debug|Any CPU {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.ActiveCfg = Release|Any CPU {00488B6E-9BB3-49AA-AE42-C120799D803C}.Release|Any CPU.Build.0 = Release|Any CPU - #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.Build.0 = Release|Any CPU + {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Debug|Any CPU.Build.0 = Debug|Any CPU + {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.ActiveCfg = Release|Any CPU + {E30A79CB-BBB2-4B47-9170-A11DF11BD28C}.Release|Any CPU.Build.0 = Release|Any CPU {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {5830D9BF-CA28-47B0-964F-343FAB28751B}.Debug|Any CPU.Build.0 = Debug|Any CPU {5830D9BF-CA28-47B0-964F-343FAB28751B}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -157,10 +157,10 @@ Global {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Debug|Any CPU.Build.0 = Debug|Any CPU {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.ActiveCfg = Release|Any CPU {4D8F42D9-28BA-4D96-A340-52B38E8F47DD}.Release|Any CPU.Build.0 = Release|Any CPU - #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.Build.0 = Release|Any CPU + {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Debug|Any CPU.Build.0 = Debug|Any CPU + {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.ActiveCfg = Release|Any CPU + {DF812CBE-894C-4C90-9EDC-4558983CCDEA}.Release|Any CPU.Build.0 = Release|Any CPU #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Debug|Any CPU.Build.0 = Debug|Any CPU #{5990939C-7E7B-4CFA-86FF-44CA5756498A}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -169,10 +169,10 @@ Global {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Debug|Any CPU.Build.0 = Debug|Any CPU {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.ActiveCfg = Release|Any CPU {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6}.Release|Any CPU.Build.0 = Release|Any CPU - #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU - #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU - #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.Build.0 = Release|Any CPU + {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Debug|Any CPU.Build.0 = Debug|Any CPU + {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.ActiveCfg = Release|Any CPU + {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}.Release|Any CPU.Build.0 = Release|Any CPU {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Debug|Any CPU.Build.0 = Debug|Any CPU {B6933551-A7A3-4A85-BEF4-43214ABB04DF}.Release|Any CPU.ActiveCfg = Release|Any CPU @@ -197,20 +197,20 @@ 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} + {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} - #{FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {FA55A52D-B880-4931-A121-85C8DAD8DD28} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {36E1611F-55E4-4DFE-BB04-913FEA9950ED} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {82CA75E9-53BD-4324-B86B-44F280BAF331} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {DAE2B2E9-40AF-4D99-A5B0-79678F94BFDA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {00488B6E-9BB3-49AA-AE42-C120799D803C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {E30A79CB-BBB2-4B47-9170-A11DF11BD28C} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} - #{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} + {A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} {A74049E0-AD31-407B-9918-6A6A76C945C9} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} #{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470} diff --git a/backend/src/BwdServer/Server.fs b/backend/src/BwdServer/Server.fs index 8c778d472c..f1b55ada82 100644 --- a/backend/src/BwdServer/Server.fs +++ b/backend/src/BwdServer/Server.fs @@ -30,7 +30,7 @@ module RT = LibExecution.RuntimeTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module Account = LibCloud.Account -module Canvas = LibCloud.Canvas +//module Canvas = LibCloud.Canvas module Routing = LibCloud.Routing module Pusher = LibCloud.Pusher @@ -262,178 +262,179 @@ let canonicalizeURL (toHttps : bool) (url : string) = exception NotFoundException of msg : string with override this.Message = this.msg -/// --------------- -/// Handle builtwithdark request -/// --------------- -let runDarkHandler (ctx : HttpContext) : Task = - task { - let domain = Exception.catch (fun () -> ctx.Request.Host.Host) - let! canvasID = - match domain with - | None -> Task.FromResult None - | Some domain -> - ctx.Items["canvasDomain"] <- domain // store for exception tracking - Telemetry.addTags [ "canvas.domain", domain ] - Canvas.canvasIDForDomain domain - - match canvasID with - | Some canvasID -> - let traceID = LibExecution.AnalysisTypes.TraceID.create () - let requestMethod = ctx.Request.Method - let requestPath = ctx.Request.Path.Value |> Routing.sanitizeUrlPath - - // TODO: stop storing all the handler types together... - let desc = ("HTTP", requestPath, requestMethod) - - Telemetry.addTags [ "canvas.id", canvasID; "trace_id", traceID ] - - // redirect HEADs to GET. We pass the actual HEAD method to the engine, - // and leave it to middleware to say what it wants to do with that - let searchMethod = if requestMethod = "HEAD" then "GET" else requestMethod - - // Canvas to process request against, with enough loaded to handle this - // request - let! canvas = Canvas.loadHttpHandlers canvasID requestPath searchMethod - - let url : string = ctx.Request.GetEncodedUrl() |> canonicalizeURL (isHttps ctx) - - // Filter down canvas' handlers to those (hopefully only one) that match - let pages = - Routing.filterMatchingHandlers requestPath (Map.values canvas.handlers) - - match pages with - // matching handler found - process normally - | [ { spec = PT.Handler.HTTP(route = route); tlid = tlid } as handler ] -> - Telemetry.addTags [ "handler.route", route; "handler.tlid", tlid ] - - let routeVars = Routing.routeInputVars route requestPath - - let! reqBody = getBody ctx - let reqHeaders = getHeadersWithoutMergingKeys ctx - - match routeVars with - | Some routeVars -> - Telemetry.addTag "handler.routeVars" routeVars - - // Do request - use _ = Telemetry.child "executeHandler" [] - - let request = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody - let inputVars = routeVars |> Map |> Map.add "request" request - - let! canvas = Canvas.toProgram canvas - let! (result, _) = - CloudExe.executeHandler - LibClientTypesToCloudTypes.Pusher.eventSerializer - (PT2RT.Handler.toRT handler) - canvas - traceID - inputVars - (CloudExe.InitialExecution(desc, "request", request)) - - let result = LibHttpMiddleware.Response.toHttpResponse result - - do! writeResponseToContext ctx result.statusCode result.headers result.body - Telemetry.addTag "http.completion_reason" "success" - - return ctx - - | None -> // vars didn't parse - // TODO: reenable using CloudStorage - // FireAndForget.fireAndForgetTask "store-event" (fun () -> - // let request = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody - // TI.storeEvent canvasID traceID desc request) - - return! unmatchedRouteResponse ctx requestPath route - - | [] when string ctx.Request.Path = "/favicon.ico" -> - return! faviconResponse ctx - - // no matching route found - store as 404 - | [] -> - // TODO: reenable using CloudStorage - // let! reqBody = getBody ctx - // let reqHeaders = getHeadersWithoutMergingKeys ctx - // let event = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody - // let! timestamp = TI.storeEvent canvasID traceID desc event - - // CLEANUP: move pusher into storeEvent - // Send to pusher - do not resolve task, send this into the ether - // Pusher.push - // LibClientTypesToCloudTypes.Pusher.eventSerializer - // canvasID - // (Pusher.New404("HTTP", requestPath, requestMethod, timestamp, traceID)) - // None - - return! noHandlerResponse ctx - | _ -> return! moreThanOneHandlerResponse ctx - | None -> return! canvasNotFoundResponse ctx - } - -// --------------- -// Configure Kestrel/ASP.NET -// --------------- -let configureApp (healthCheckPort : int) (app : IApplicationBuilder) = - let handler (ctx : HttpContext) : Task = - (task { - // The traditional methods of using `UseHsts` and `AddHsts` within BwdServer - // were ineffective. Somehow, the Strict-Transport-Security header was not - // included in HTTP Reponses as a result of these efforts. Here, we manually - // work around this by setting it manually. - // CLEANUP: replace this with the more traditional approach, if possible - // HttpHandlerTODO lowercase keys for Http handler responses - setResponseHeader ctx "Strict-Transport-Security" LibService.HSTS.stringConfig - - setResponseHeader ctx "x-darklang-execution-id" (Telemetry.rootID ()) - setResponseHeader ctx "Server" "darklang" - - try - return! runDarkHandler ctx - with - // These errors are the only ones we want to handle here. We don't want to give - // GrandUsers any info not intended for them. We want the rest to be caught by - // the 500 handler, be reported, and then have a small error message printed - | NotFoundException msg -> return! errorResponse ctx msg 404 - | GrandUserException msg -> - // Messages caused by user input should be displayed to the user - return! errorResponse ctx msg 400 - | e -> - // respond and then reraise to get it to the rollbar middleware - let! (_ : HttpContext) = internalErrorResponse ctx e - return Exception.reraise e - }) - - let rollbarCtxToMetadata (ctx : HttpContext) : Rollbar.Person * Metadata = - let domain = - try - Some(ctx.Items["canvasDomain"]) - with _ -> - None - - let id = - try - Some(ctx.Items["canvasOwnerID"] :?> UserID) - with _ -> - None - - let metadata = - domain |> Option.map (fun d -> [ "canvasDomain", d ]) |> Option.defaultValue [] - - (id, metadata) - - Rollbar.AspNet.addRollbarToApp app rollbarCtxToMetadata None - |> fun app -> app.UseRouting() - // must go after UseRouting - |> Kubernetes.configureApp healthCheckPort - |> Logging.addHttpLogging - |> fun app -> app.Run(RequestDelegate handler) - -let configureServices (services : IServiceCollection) : unit = - services - |> Kubernetes.configureServices [ Canvas.healthCheck ] - |> Rollbar.AspNet.addRollbarToServices - |> Telemetry.AspNet.addTelemetryToServices "BwdServer" Telemetry.TraceDBQueries - |> ignore +// /// --------------- +// /// Handle builtwithdark request +// /// --------------- +// let runDarkHandler (ctx : HttpContext) : Task = +// task { +// let domain = Exception.catch (fun () -> ctx.Request.Host.Host) +// let! canvasID = +// match domain with +// | None -> Task.FromResult None +// | Some domain -> +// ctx.Items["canvasDomain"] <- domain // store for exception tracking +// Telemetry.addTags [ "canvas.domain", domain ] +// Canvas.canvasIDForDomain domain + +// match canvasID with +// | Some canvasID -> +// let traceID = LibExecution.AnalysisTypes.TraceID.create () +// let requestMethod = ctx.Request.Method +// let requestPath = ctx.Request.Path.Value |> Routing.sanitizeUrlPath + +// // TODO: stop storing all the handler types together... +// let desc = ("HTTP", requestPath, requestMethod) + +// Telemetry.addTags [ "canvas.id", canvasID; "trace_id", traceID ] + +// // redirect HEADs to GET. We pass the actual HEAD method to the engine, +// // and leave it to middleware to say what it wants to do with that +// let searchMethod = if requestMethod = "HEAD" then "GET" else requestMethod + +// // Canvas to process request against, with enough loaded to handle this +// // request +// let! canvas = Canvas.loadHttpHandlers canvasID requestPath searchMethod + +// let url : string = ctx.Request.GetEncodedUrl() |> canonicalizeURL (isHttps ctx) + +// // Filter down canvas' handlers to those (hopefully only one) that match +// let pages = +// Routing.filterMatchingHandlers requestPath (Map.values canvas.handlers) + +// match pages with +// // matching handler found - process normally +// | [ { spec = PT.Handler.HTTP(route = route); tlid = tlid } as handler ] -> +// Telemetry.addTags [ "handler.route", route; "handler.tlid", tlid ] + +// let routeVars = Routing.routeInputVars route requestPath + +// let! reqBody = getBody ctx +// let reqHeaders = getHeadersWithoutMergingKeys ctx + +// match routeVars with +// | Some routeVars -> +// Telemetry.addTag "handler.routeVars" routeVars + +// // Do request +// use _ = Telemetry.child "executeHandler" [] + +// let request = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody +// let inputVars = routeVars |> Map |> Map.add "request" request + +// let! canvas = Canvas.toProgram canvas +// let! (result, _) = +// CloudExe.executeHandler +// LibClientTypesToCloudTypes.Pusher.eventSerializer +// (PT2RT.Handler.toRT handler) +// canvas +// traceID +// inputVars +// (CloudExe.InitialExecution(desc, "request", request)) + +// let result = LibHttpMiddleware.Response.toHttpResponse result + +// do! writeResponseToContext ctx result.statusCode result.headers result.body +// Telemetry.addTag "http.completion_reason" "success" + +// return ctx + +// | None -> // vars didn't parse +// // TODO: reenable using CloudStorage +// // FireAndForget.fireAndForgetTask "store-event" (fun () -> +// // let request = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody +// // TI.storeEvent canvasID traceID desc request) + +// return! unmatchedRouteResponse ctx requestPath route + +// | [] when string ctx.Request.Path = "/favicon.ico" -> +// return! faviconResponse ctx + +// // no matching route found - store as 404 +// | [] -> +// // TODO: reenable using CloudStorage +// // let! reqBody = getBody ctx +// // let reqHeaders = getHeadersWithoutMergingKeys ctx +// // let event = LibHttpMiddleware.Request.fromRequest url reqHeaders reqBody +// // let! timestamp = TI.storeEvent canvasID traceID desc event + +// // CLEANUP: move pusher into storeEvent +// // Send to pusher - do not resolve task, send this into the ether +// // Pusher.push +// // LibClientTypesToCloudTypes.Pusher.eventSerializer +// // canvasID +// // (Pusher.New404("HTTP", requestPath, requestMethod, timestamp, traceID)) +// // None + +// return! noHandlerResponse ctx +// | _ -> return! moreThanOneHandlerResponse ctx +// | None -> return! canvasNotFoundResponse ctx +// } + +// // --------------- +// // Configure Kestrel/ASP.NET +// // --------------- +// let configureApp (healthCheckPort : int) (app : IApplicationBuilder) = +// let handler (ctx : HttpContext) : Task = +// (task { +// // The traditional methods of using `UseHsts` and `AddHsts` within BwdServer +// // were ineffective. Somehow, the Strict-Transport-Security header was not +// // included in HTTP Reponses as a result of these efforts. Here, we manually +// // work around this by setting it manually. +// // CLEANUP: replace this with the more traditional approach, if possible +// // HttpHandlerTODO lowercase keys for Http handler responses +// setResponseHeader ctx "Strict-Transport-Security" LibService.HSTS.stringConfig + +// setResponseHeader ctx "x-darklang-execution-id" (Telemetry.rootID ()) +// setResponseHeader ctx "Server" "darklang" + +// try +// return! runDarkHandler ctx +// with +// // These errors are the only ones we want to handle here. We don't want to give +// // GrandUsers any info not intended for them. We want the rest to be caught by +// // the 500 handler, be reported, and then have a small error message printed +// | NotFoundException msg -> return! errorResponse ctx msg 404 +// | GrandUserException msg -> +// // Messages caused by user input should be displayed to the user +// return! errorResponse ctx msg 400 +// | e -> +// // respond and then reraise to get it to the rollbar middleware +// let! (_ : HttpContext) = internalErrorResponse ctx e +// return Exception.reraise e +// }) + +// let rollbarCtxToMetadata (ctx : HttpContext) : Rollbar.Person * Metadata = +// let domain = +// try +// Some(ctx.Items["canvasDomain"]) +// with _ -> +// None + +// let id = +// try +// Some(ctx.Items["canvasOwnerID"] :?> UserID) +// with _ -> +// None + +// let metadata = +// domain |> Option.map (fun d -> [ "canvasDomain", d ]) |> Option.defaultValue [] + +// (id, metadata) + +// Rollbar.AspNet.addRollbarToApp app rollbarCtxToMetadata None +// |> fun app -> app.UseRouting() +// // must go after UseRouting +// |> Kubernetes.configureApp healthCheckPort +// |> Logging.addHttpLogging +// |> fun app -> app.Run(RequestDelegate handler) + + +// let configureServices (services : IServiceCollection) : unit = +// services +// |> Kubernetes.configureServices [ Canvas.healthCheck ] +// |> Rollbar.AspNet.addRollbarToServices +// |> Telemetry.AspNet.addTelemetryToServices "BwdServer" Telemetry.TraceDBQueries +// |> ignore let webserver @@ -444,7 +445,7 @@ let webserver let hcUrl = Kubernetes.url healthCheckPort let builder = WebApplication.CreateBuilder() - configureServices builder.Services + //configureServices builder.Services Kubernetes.registerServerTimeout builder.WebHost builder.WebHost @@ -454,7 +455,7 @@ let webserver |> ignore let app = builder.Build() - configureApp healthCheckPort app + //configureApp healthCheckPort app app let run () : unit = @@ -468,14 +469,14 @@ let initSerializers () = // universally-serializable types // one-off types used internally - Json.Vanilla.allow - "RoundtrippableSerializationFormatV0.Dval" + // Json.Vanilla.allow + // "RoundtrippableSerializationFormatV0.Dval" Json.Vanilla.allow> "Canvas.loadJsonFromDisk" Json.Vanilla.allow "Canvas.loadJsonFromDisk" - Json.Vanilla.allow "eventqueue storage" - Json.Vanilla.allow - "TraceCloudStorageFormat" + // Json.Vanilla.allow "eventqueue storage" + // Json.Vanilla.allow + // "TraceCloudStorageFormat" Json.Vanilla.allow "Rollbar" // for Pusher.com payloads diff --git a/backend/src/Cli/Cli.fs b/backend/src/Cli/Cli.fs index dd5fb0cddd..5006bdf1da 100644 --- a/backend/src/Cli/Cli.fs +++ b/backend/src/Cli/Cli.fs @@ -68,10 +68,11 @@ let state () = let program : RT.Program = { canvasID = System.Guid.NewGuid() internalFnsAllowed = false - dbs = Map.empty - secrets = [] } + //dbs = Map.empty + //secrets = [] + } - let tracing = Exe.noTracing (RT.CallStack.fromEntryPoint RT.Script) + let tracing = Exe.noTracing // (RT.CallStack.fromEntryPoint RT.Script) let notify (_state : RT.ExecutionState) (_msg : string) (_metadata : Metadata) = // let metadata = extraMetadata state @ metadata @@ -86,9 +87,7 @@ let state () = -let execute - (args : List) - : Task * RT.RuntimeError>> = +let execute (args : List) : Task> = task { let state = state () let fnName = RT.FQFnName.fqPackage PackageIDs.Fn.Cli.executeCliCommand @@ -107,46 +106,47 @@ let initSerializers () = () [] -let main (args : string[]) = +let main (_args : string[]) = try initSerializers () packageManagerRT.init.Result - let result = execute (Array.toList args) - let result = result.Result + // let result = execute (Array.toList args) + // let result = result.Result - NonBlockingConsole.wait () + // NonBlockingConsole.wait () - match result with - | Error(callStack, rte) -> - let state = state () + // match result with + // | Error(callStack, rte) -> + // let state = state () - let errorCallStackStr = LibExecution.Execution.callStackString state callStack + // let errorCallStackStr = LibExecution.Execution.callStackString state callStack - match (LibExecution.Execution.runtimeErrorToString state rte).Result with - | Ok(RT.DString s) -> - System.Console.WriteLine $"Error source: {errorCallStackStr}\n {s}" + // match (LibExecution.Execution.runtimeErrorToString state rte).Result with + // | Ok(RT.DString s) -> + // System.Console.WriteLine $"Error source: {errorCallStackStr}\n {s}" - | Ok otherVal -> - System.Console.WriteLine - $"Unexpected value while stringifying error.\nCallStack: {errorCallStackStr}\n" - System.Console.WriteLine $"Original Error: {rte}" - System.Console.WriteLine $"Value is:\n{otherVal}" + // | Ok otherVal -> + // System.Console.WriteLine + // $"Unexpected value while stringifying error.\nCallStack: {errorCallStackStr}\n" + // System.Console.WriteLine $"Original Error: {rte}" + // System.Console.WriteLine $"Value is:\n{otherVal}" - | Error(_, newErr) -> - System.Console.WriteLine - $"Error while stringifying error.\n CallStack: {errorCallStackStr}\n" - System.Console.WriteLine $"Original Error: {rte}" - System.Console.WriteLine $"New Error is:\n{newErr}" + // | Error(_, newErr) -> + // System.Console.WriteLine + // $"Error while stringifying error.\n CallStack: {errorCallStackStr}\n" + // System.Console.WriteLine $"Original Error: {rte}" + // System.Console.WriteLine $"New Error is:\n{newErr}" - 1 - | Ok(RT.DInt64 i) -> (int i) - | Ok dval -> - let output = LibExecution.DvalReprDeveloper.toRepr dval - System.Console.WriteLine - $"Error: main function must return an int (returned {output})" - 1 + // 1 + // | Ok(RT.DInt64 i) -> (int i) + // | Ok dval -> + // let output = LibExecution.DvalReprDeveloper.toRepr dval + // System.Console.WriteLine + // $"Error: main function must return an int (returned {output})" + // 1 + 1 with e -> printException "Error starting Darklang CLI" [] e diff --git a/backend/src/CronChecker/CronChecker.fs b/backend/src/CronChecker/CronChecker.fs index c784cd1d13..b55d13fcf7 100644 --- a/backend/src/CronChecker/CronChecker.fs +++ b/backend/src/CronChecker/CronChecker.fs @@ -15,7 +15,8 @@ let run () : Task = while not shouldShutdown do try use (_span : Telemetry.Span.T) = Telemetry.createRoot "CronChecker.run" - do! LibCloud.Cron.checkAndScheduleWorkForAllCrons () + //do! LibCloud.Cron.checkAndScheduleWorkForAllCrons () + () with e -> // If there's an exception, alert and continue Rollbar.sendException None [] e @@ -24,9 +25,9 @@ let run () : Task = } let initSerializers () = - Json.Vanilla.allow - "RoundtrippableSerializationFormatV0.Dval" - Json.Vanilla.allow "eventqueue storage" + // Json.Vanilla.allow + // "RoundtrippableSerializationFormatV0.Dval" + // Json.Vanilla.allow "eventqueue storage" Json.Vanilla.allow "Rollbar" [] diff --git a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs index 76ac09729e..5a1b528849 100644 --- a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs +++ b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs @@ -67,7 +67,7 @@ module FormatV0 = | KTCustomType of FQTypeName.FQTypeName * typeArgs : List - //| KTDB of ValueType + //| KTDB of ValueType let rec toRT (kt : KnownType) : RT.KnownType = match kt with @@ -104,7 +104,7 @@ module FormatV0 = | KTCustomType(typeName, typeArgs) -> RT.KTCustomType(FQTypeName.toRT typeName, List.map ValueType.toRT typeArgs) - //| KTDB vt -> RT.KTDB(ValueType.toRT vt) + //| KTDB vt -> RT.KTDB(ValueType.toRT vt) let rec fromRT (kt : RT.KnownType) : KnownType = match kt with @@ -144,7 +144,7 @@ module FormatV0 = List.map ValueType.fromRT typeArgs ) - //| RT.KTDB vt -> KTDB(ValueType.fromRT vt) + //| RT.KTDB vt -> KTDB(ValueType.fromRT vt) [] type ValueType = diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 094285408e..8b30d1382e 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -57,7 +57,11 @@ let createState //let metadata = extraMetadata state @ metadata LibService.Rollbar.notify msg metadata - let sendException (_state : RT.ExecutionState) (metadata : Metadata) (exn : exn) = + let sendException + (_state : RT.ExecutionState) + (metadata : Metadata) + (exn : exn) + = //let metadata = extraMetadata state @ metadata LibService.Rollbar.sendException None metadata exn diff --git a/backend/src/LibExecution/Execution.fs b/backend/src/LibExecution/Execution.fs index ee77b9672c..34864ca9f6 100644 --- a/backend/src/LibExecution/Execution.fs +++ b/backend/src/LibExecution/Execution.fs @@ -76,41 +76,34 @@ let executeExpr } -// let executeFunction -// (exeState : RT.ExecutionState) -// (name : RT.FQFnName.FQFnName) -// (typeArgs : List) -// (args : NEList) -// : Task = -// task { -// try -// try -// let exeState = -// { exeState with -// tracing.callStack.entrypoint = RT.ExecutionPoint.Function name } -// let! result = -// Interpreter.call -// exeState -// RT.VMState.empty // ok? -// (RT.DFnVal(RT.NamedFn name)) -// typeArgs -// args -// return Ok result -// with -// | RT.RuntimeErrorException(source, rte) -> return Error(source, rte) -// | ex -> -// let context : Metadata = -// //[ "fn", fnDesc; "args", args; "typeArgs", typeArgs; "id", id ] -// [] -// exeState.reportException exeState context ex -// return -// RT.raiseRTE -// exeState.tracing.callStack -// (RT.RuntimeError.oldError "Unknown error") -// finally -// // Does nothing in non-tests -// exeState.test.postTestExecutionHook exeState.test -// } +let executeFunction + (exeState : RT.ExecutionState) + (name : RT.FQFnName.FQFnName) + (typeArgs : List) + (args : NEList) + : Task = + let resultReg, rc = 0, 1 + + let fnInstr, fnReg, rc = + let namedFn : RT.ApplicableNamedFn = { name = name; argsSoFar = [] } + let applicable = RT.DApplicable(RT.AppNamedFn namedFn) + RT.LoadVal(rc, applicable), rc, rc + 1 + + let argInstrs, argRegs, rc = + args + |> NEList.fold + (fun (instrs, argRegs, rc) arg -> + instrs @ [ RT.LoadVal(rc, arg) ], argRegs @ [ rc ], rc + 1) + ([], [], rc) + + let applyInstr = + RT.Apply(resultReg, fnReg, typeArgs, argRegs |> NEList.ofListUnsafe "" []) + + let instrs : RT.Instructions = + { registerCount = rc + instructions = [ fnInstr ] @ argInstrs @ [ applyInstr ] + resultIn = 0 } + executeExpr exeState instrs // let runtimeErrorToString diff --git a/backend/src/LibHttpMiddleware/Http.fs b/backend/src/LibHttpMiddleware/Http.fs index 365629c7d8..1670e8221a 100644 --- a/backend/src/LibHttpMiddleware/Http.fs +++ b/backend/src/LibHttpMiddleware/Http.fs @@ -9,6 +9,7 @@ open LibExecution.Builtin.Shortcuts module Dval = LibExecution.Dval module RT = LibExecution.RuntimeTypes +module VT = LibExecution.ValueType module Telemetry = LibService.Telemetry module PackageIDs = LibExecution.PackageIDs @@ -24,7 +25,7 @@ module Request = (headers : List) (body : byte array) : RT.Dval = - let headerType = RT.KTTuple(RT.ValueType.string, RT.ValueType.string, []) + let headerType = RT.KTTuple(VT.string, VT.string, []) let headers = headers @@ -94,15 +95,16 @@ module Response = { statusCode = 500 headers = [ "Content-Type", "text/plain; charset=utf-8" ] body = - let typeName = LibExecution.DvalReprDeveloper.toTypeName result - let message = - [ $"Application error: expected a HTTP response, got:" - $"type {typeName}:" - $" {LibExecution.DvalReprDeveloper.toRepr result}" - "\nHTTP handlers should return results in the form:" - " PACKAGE.Darklang.Stdlib.Http.Response {" - " statusCode : Int64" - " headers : List" - " body : Bytes" - " }" ] + // let typeName = LibExecution.DvalReprDeveloper.toTypeName result + // let message = + // [ $"Application error: expected a HTTP response, got:" + // $"type {typeName}:" + // $" {LibExecution.DvalReprDeveloper.toRepr result}" + // "\nHTTP handlers should return results in the form:" + // " PACKAGE.Darklang.Stdlib.Http.Response {" + // " statusCode : Int64" + // " headers : List" + // " body : Bytes" + // " }" ] + let message = [ "TODO" ] message |> String.concat "\n" |> UTF8.toBytes } diff --git a/backend/src/QueueWorker/QueueWorker.fs b/backend/src/QueueWorker/QueueWorker.fs index 9410f58271..0ad7bf118f 100644 --- a/backend/src/QueueWorker/QueueWorker.fs +++ b/backend/src/QueueWorker/QueueWorker.fs @@ -340,7 +340,7 @@ let main _ : int = // Set up healthchecks and shutdown with k8s let port = LibService.Config.queueWorkerKubernetesPort - let healthChecks = [ ] //Canvas.healthCheck ] + let healthChecks = [] //Canvas.healthCheck ] LibService.Kubernetes.runKubernetesServer name healthChecks port shutdownCallback |> ignore From 0ca256d2cd15ae3456aad5f5994894b48a897edb Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 20 Sep 2024 13:00:17 -0400 Subject: [PATCH 51/60] Uncomment more of the codebase --- .../src/BuiltinExecution/Libs/HttpClient.fs | 252 +++++++++--------- .../BuiltinExecution/Libs/LanguageTools.fs | 164 ++++++------ backend/src/LibExecution/DvalDecoder.fs | 86 ------ .../LibExecution/ProgramTypesToDarkTypes.fs | 4 +- backend/src/LibExecution/RuntimeTypes.fs | 4 - backend/src/LibParser/Parser.fs | 11 - .../LibParser/WrittenTypesToProgramTypes.fs | 22 +- backend/src/LocalExec/LocalExec.fs | 22 +- backend/src/Prelude/NEList.fs | 4 +- backend/src/Prelude/Option.fs | 6 - backend/src/Prelude/Prelude.fsproj | 1 - backend/src/Prelude/StringBuilder.fs | 6 - backend/tests/TestUtils/PTShortcuts.fs | 11 - backend/tests/TestUtils/RTShortcuts.fs | 97 ------- backend/tests/TestUtils/TestUtils.fs | 1 - backend/tests/TestUtils/TestUtils.fsproj | 1 - backend/tests/Tests/Builtin.Tests.fs | 3 +- backend/tests/Tests/ProgramTypes.Tests.fs | 1 - packages/darklang/languageTools/common.dark | 15 +- .../darklang/prettyPrinter/programTypes.dark | 6 - scripts/build/compile | 6 +- scripts/build/reload-packages | 28 +- 22 files changed, 260 insertions(+), 491 deletions(-) delete mode 100644 backend/src/Prelude/StringBuilder.fs delete mode 100644 backend/tests/TestUtils/RTShortcuts.fs diff --git a/backend/src/BuiltinExecution/Libs/HttpClient.fs b/backend/src/BuiltinExecution/Libs/HttpClient.fs index 4a1e462650..a39a667750 100644 --- a/backend/src/BuiltinExecution/Libs/HttpClient.fs +++ b/backend/src/BuiltinExecution/Libs/HttpClient.fs @@ -384,133 +384,131 @@ open LibExecution.Builtin.Shortcuts let fns (config : Configuration) : List = - let _httpClient = BaseClient.create config - [ - // { name = fn "httpClientRequest" 0 - // typeParams = [] - // parameters = - // [ Param.make "method" TString "" - // Param.make "uri" TString "" - // Param.make "headers" headersType "" - // Param.make "body" (TList TUInt8) "" ] - // returnType = - // TypeReference.result - // (TCustomType( - // Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response), - // [] - // )) - // (TCustomType( - // Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError), - // [] - // )) - // description = - // "Make blocking HTTP call to . Returns a where - // the response is wrapped in {{ Ok }} if a response was successfully - // received and parsed, and is wrapped in {{ Error }} otherwise" - // fn = - // let typ = FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response - - // let responseType = KTCustomType(typ, []) - // let resultOk = Dval.resultOk responseType KTString - // let typeName = - // FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError - // let resultError = Dval.resultError responseType (KTCustomType(typeName, [])) - // (function - // | _, - // vmState, - // _, - // [ DString method; DString uri; DList(_, reqHeaders); DList(_, reqBody) ] -> - // uply { - // let! (reqHeaders : Result, BadHeader.BadHeader>) = - // reqHeaders - // |> Ply.List.mapSequentially (fun item -> - // uply { - // match item with - // | DTuple(DString k, DString v, []) -> - // let k = String.trim k - // if k = "" then - // // CLEANUP reconsider if we should error here - // return Error BadHeader.BadHeader.EmptyKey - // else - // return Ok((k, v)) - - // | notAPair -> - // return! - // RuntimeError.ValueNotExpectedType( - // notAPair, - // TList(TTuple(TString, TString, [])), - // RTE.TypeChecker.Context.FunctionCallParameter( - // FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, - // ({ name = "headers"; typ = headersType }), - // 2 - // ) - // ) - // |> raiseRTE vmState.callStack - - // }) - // |> Ply.map (Result.collect) - - // let method = - // try - // Some(HttpMethod method) - // with _ -> - // None - - // let! (result : Result) = - // uply { - // match reqHeaders, method with - // | Ok reqHeaders, Some method -> - // let request = - // { url = uri - // method = method - // headers = reqHeaders - // body = Dval.dlistToByteArray reqBody } - - // let! response = makeRequest config httpClient request - - // match response with - // | Ok response -> - // let responseHeaders = - // response.headers - // |> List.map (fun (k, v) -> - // DTuple( - // DString(String.toLowercase k), - // DString(String.toLowercase v), - // [] - // )) - // |> Dval.list (KTTuple(VT.string, VT.string, [])) - - // let typ = - // FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response - - // let fields = - // [ ("statusCode", DInt64(int64 response.statusCode)) - // ("headers", responseHeaders) - // ("body", Dval.byteArrayToDvalList response.body) ] - - // return Ok(DRecord(typ, typ, [], Map fields) |> resultOk) - - // | Error err -> return Error err - - // | Error reqHeadersErr, _ -> - // let reqHeadersErr = reqHeadersErr - // return Error(RequestError.RequestError.BadHeader reqHeadersErr) - - // | _, None -> - // let error = RequestError.RequestError.BadMethod - // return Error error - // } - // match result with - // | Ok result -> return result - // | Error err -> - // let err = RequestError.toDT err - // return resultError err - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Impure - // deprecated = NotDeprecated } - ] + let httpClient = BaseClient.create config + [ { name = fn "httpClientRequest" 0 + typeParams = [] + parameters = + [ Param.make "method" TString "" + Param.make "uri" TString "" + Param.make "headers" headersType "" + Param.make "body" (TList TUInt8) "" ] + returnType = + TypeReference.result + (TCustomType( + Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response), + [] + )) + (TCustomType( + Ok(FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError), + [] + )) + description = + "Make blocking HTTP call to . Returns a where + the response is wrapped in {{ Ok }} if a response was successfully + received and parsed, and is wrapped in {{ Error }} otherwise" + fn = + let typ = FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response + + let responseType = KTCustomType(typ, []) + let resultOk = Dval.resultOk responseType KTString + let typeName = + FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.requestError + let resultError = Dval.resultError responseType (KTCustomType(typeName, [])) + (function + | _, + vm, + _, + [ DString method; DString uri; DList(_, reqHeaders); DList(_, reqBody) ] -> + uply { + let! (reqHeaders : Result, BadHeader.BadHeader>) = + reqHeaders + |> Ply.List.mapSequentially (fun item -> + uply { + match item with + | DTuple(DString k, DString v, []) -> + let k = String.trim k + if k = "" then + // CLEANUP reconsider if we should error here + return Error BadHeader.BadHeader.EmptyKey + else + return Ok((k, v)) + + | notAPair -> + return! + RuntimeError.ValueNotExpectedType( + notAPair, + TList(TTuple(TString, TString, [])), + RTE.TypeChecker.Context.FunctionCallParameter( + FQFnName.fqPackage PackageIDs.Fn.Stdlib.HttpClient.request, + ({ name = "headers"; typ = headersType }), + 2 + ) + ) + |> raiseRTE vm.threadID + + }) + |> Ply.map (Result.collect) + + let method = + try + Some(HttpMethod method) + with _ -> + None + + let! (result : Result) = + uply { + match reqHeaders, method with + | Ok reqHeaders, Some method -> + let request = + { url = uri + method = method + headers = reqHeaders + body = Dval.dlistToByteArray reqBody } + + let! response = makeRequest config httpClient request + + match response with + | Ok response -> + let responseHeaders = + response.headers + |> List.map (fun (k, v) -> + DTuple( + DString(String.toLowercase k), + DString(String.toLowercase v), + [] + )) + |> Dval.list (KTTuple(VT.string, VT.string, [])) + + let typ = + FQTypeName.fqPackage PackageIDs.Type.Stdlib.HttpClient.response + + let fields = + [ ("statusCode", DInt64(int64 response.statusCode)) + ("headers", responseHeaders) + ("body", Dval.byteArrayToDvalList response.body) ] + + return Ok(DRecord(typ, typ, [], Map fields) |> resultOk) + + | Error err -> return Error err + + | Error reqHeadersErr, _ -> + let reqHeadersErr = reqHeadersErr + return Error(RequestError.RequestError.BadHeader reqHeadersErr) + + | _, None -> + let error = RequestError.RequestError.BadMethod + return Error error + } + match result with + | Ok result -> return result + | Error err -> + let err = RequestError.toDT err + return resultError err + } + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Impure + deprecated = NotDeprecated } ] let builtins config = Builtin.make [] (fns config) diff --git a/backend/src/BuiltinExecution/Libs/LanguageTools.fs b/backend/src/BuiltinExecution/Libs/LanguageTools.fs index 75033bfd73..145d9c2802 100644 --- a/backend/src/BuiltinExecution/Libs/LanguageTools.fs +++ b/backend/src/BuiltinExecution/Libs/LanguageTools.fs @@ -8,92 +8,90 @@ module VT = LibExecution.ValueType module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker module PackageIDs = LibExecution.PackageIDs +module RT2DT = LibExecution.RuntimeTypesToDarkTypes let fns : List = - [ - // { name = fn "languageToolsAllBuiltinConstants" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = - // TList( - // TCustomType( - // Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant), - // [] - // ) - // ) - // description = - // "Returns a list of the Builtin constants (usually not to be accessed directly)." - // fn = - // (function - // | exeState, _, _, [ DUnit ] -> - // let constTypeName = - // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant - - // let consts = - // exeState.builtins.constants - // |> Map.toList - // |> List.map (fun (name, data) -> - // let fields = - // [ "name", DString(FQConstantName.builtinToString name) - // "description", DString data.description - // "returnType", DString(typeNameToStr data.typ) ] - - // DRecord(constTypeName, constTypeName, [], Map fields)) - - // DList(VT.customType constTypeName [], consts) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Impure - // deprecated = NotDeprecated } - - - // { name = fn "languageToolsAllBuiltinFns" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = - // TList( - // TCustomType( - // Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn), - // [] - // ) - // ) - // description = - // "Returns a list of the Builtin functions (usually not to be accessed directly)." - // fn = - // (function - // | exeState, _, _, [ DUnit ] -> - // let fnParamTypeName = - // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFnParam - // let fnTypeName = - // FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn - - // let fns = - // exeState.fns.builtIn - // |> Map.toList - // |> List.map (fun (name, data) -> - // let parameters = - // data.parameters - // |> List.map (fun p -> - // let fields = - // [ "name", DString p.name - // "type", DString(typeNameToStr p.typ) ] - // DRecord(fnParamTypeName, fnParamTypeName, [], Map fields)) - // |> Dval.list (KTCustomType(fnParamTypeName, [])) - - // let fields = - // [ "name", DString(FQFnName.builtinToString name) - // "description", DString data.description - // "parameters", parameters - // "returnType", DString(typeNameToStr data.returnType) ] - - // DRecord(fnTypeName, fnTypeName, [], Map fields)) - - // DList(VT.customType fnTypeName [], fns) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Impure - // deprecated = NotDeprecated } + [ { name = fn "languageToolsAllBuiltinConstants" 0 + typeParams = [] + parameters = [ Param.make "unit" TUnit "" ] + returnType = + TCustomType( + Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant), + [] + ) + |> TList + description = + "Returns a list of the Builtin constants (usually not to be accessed directly)." + fn = + (function + | exeState, _, _, [ DUnit ] -> + let constTypeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinConstant + + let consts = + exeState.constants.builtIn + |> Map.toList + |> List.map (fun (name, data) -> + let fields = + [ "name", RT2DT.FQConstantName.Builtin.toDT name + "description", DString data.description + "returnType", RT2DT.TypeReference.toDT data.typ ] + + DRecord(constTypeName, constTypeName, [], Map fields)) + + DList(VT.customType constTypeName [], consts) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Impure + deprecated = NotDeprecated } + + + { name = fn "languageToolsAllBuiltinFns" 0 + typeParams = [] + parameters = [ Param.make "unit" TUnit "" ] + returnType = + TCustomType( + Ok(FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn), + [] + ) + |> TList + description = + "Returns a list of the Builtin functions (usually not to be accessed directly)." + fn = + (function + | exeState, _, _, [ DUnit ] -> + let fnParamTypeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFnParam + let fnTypeName = + FQTypeName.fqPackage PackageIDs.Type.LanguageTools.builtinFn + + let fns = + exeState.fns.builtIn + |> Map.toList + |> List.map (fun (name, data) -> + let parameters = + data.parameters + |> List.map (fun p -> + let fields = + [ "name", DString p.name + "type", RT2DT.TypeReference.toDT p.typ ] + DRecord(fnParamTypeName, fnParamTypeName, [], Map fields)) + |> Dval.list (KTCustomType(fnParamTypeName, [])) + + let fields = + [ "name", RT2DT.FQFnName.Builtin.toDT name + "description", DString data.description + "parameters", parameters + "returnType", RT2DT.TypeReference.toDT data.returnType ] + + DRecord(fnTypeName, fnTypeName, [], Map fields)) + + DList(VT.customType fnTypeName [], fns) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Impure + deprecated = NotDeprecated } // This exists because the above-defined fn returns a big list, diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/LibExecution/DvalDecoder.fs index 3c5d770837..a28908a073 100644 --- a/backend/src/LibExecution/DvalDecoder.fs +++ b/backend/src/LibExecution/DvalDecoder.fs @@ -114,89 +114,3 @@ let field (name : string) (m : DvalMap) : Dval = match m |> Map.get name with | Some dv -> dv | None -> Exception.raiseInternal $"Expected '{name}' field" [] - - -// let listField (name : string) (m : DvalMap) : List = -// m -// |> field name -// |> getList -// |> unwrap $"Expected '{name}' field to be a list" [] - -// let stringListField (name : string) (m : DvalMap) : List = -// m -// |> listField name -// |> List.map (fun s -> -// s |> getString |> unwrap $"Expected string values in '{name}' list" []) - - -// let int8Field (name : string) (m : DvalMap) : int8 = -// m -// |> field name -// |> getInt8 -// |> unwrap $"Expected '{name}' field to be an int8" [] - -// let uint8Field (name : string) (m : DvalMap) : uint8 = -// m -// |> field name -// |> getUInt8 -// |> unwrap $"Expected '{name}' field to be a uint8" [] - -// let int16Field (name : string) (m : DvalMap) : int16 = -// m -// |> field name -// |> getInt16 -// |> unwrap $"Expected '{name}' field to be an int16" [] - -// let uint16Field (name : string) (m : DvalMap) : uint16 = -// m -// |> field name -// |> getUInt16 -// |> unwrap $"Expected '{name}' field to be a uint16" [] - -// let int32Field (name : string) (m : DvalMap) : int32 = -// m -// |> field name -// |> getInt32 -// |> unwrap $"Expected '{name}' field to be an int32" [] - -// let uint32Field (name : string) (m : DvalMap) : uint32 = -// m -// |> field name -// |> getUInt32 -// |> unwrap $"Expected '{name}' field to be a uint32" [] - -// let int64Field (name : string) (m : DvalMap) : int64 = -// m -// |> field name -// |> getInt64 -// |> unwrap $"Expected '{name}' field to be an int64" [] - -// let uint64Field (name : string) (m : DvalMap) : uint64 = -// m -// |> field name -// |> getUInt64 -// |> unwrap $"Expected '{name}' field to be an uint64" [] - -// let int128Field (name : string) (m : DvalMap) : System.Int128 = -// m -// |> field name -// |> getInt128 -// |> unwrap $"Expected '{name}' field to be an int128" [] - -// let uint128Field (name : string) (m : DvalMap) : System.UInt128 = -// m -// |> field name -// |> getUInt128 -// |> unwrap $"Expected '{name}' field to be a uint128" [] - -// let uuidField (name : string) (m : DvalMap) : System.Guid = -// m -// |> field name -// |> getUuid -// |> unwrap $"Expected '{name}' field to be a uuid" [] - -// let dictField (name : string) (m : DvalMap) : Map = -// m -// |> field name -// |> getDict -// |> unwrap $"Expected '{name}' field to be a dict" [] diff --git a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs index 7dd6ccbbf3..e528c9f14b 100644 --- a/backend/src/LibExecution/ProgramTypesToDarkTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToDarkTypes.fs @@ -934,8 +934,8 @@ module Expr = | _ -> []) PT.EMatch(uint64 id, fromDT arg, cases) - // | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> - // PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) + | DEnum(_, _, [], "EPipe", [ DInt64 id; expr; DList(_vtTODO, pipeExprs) ]) -> + PT.EPipe(uint64 id, fromDT expr, List.map (PipeExpr.fromDT fromDT) pipeExprs) // function calls | DEnum(_, _, [], "EInfix", [ DInt64 id; infix; lhs; rhs ]) -> diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index c605fb6e97..badb604bb9 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -62,10 +62,6 @@ module FQConstantName = let fqPackage (id : uuid) : FQConstantName = Package id - let builtinToString (s : Builtin) : string = - let name = s.name - if s.version = 0 then name else $"{name}_v{s.version}" - /// A Fully-Qualified Function Name /// diff --git a/backend/src/LibParser/Parser.fs b/backend/src/LibParser/Parser.fs index 17793764dd..d80e426813 100644 --- a/backend/src/LibParser/Parser.fs +++ b/backend/src/LibParser/Parser.fs @@ -40,17 +40,6 @@ let parseSimple parsePTExpr builtins pm onMissing filename code -// let parseRTExpr -// (builtins : RT.Builtins) -// (pm : PT.PackageManager) -// (onMissing : NR.OnMissing) -// (filename : string) -// (code : string) -// : Ply = -// code -// |> parsePTExpr builtins pm onMissing filename -// |> Ply.map LibExecution.ProgramTypesToRuntimeTypes.Expr.toRT - let parsePackageFile (builtins : RT.Builtins) diff --git a/backend/src/LibParser/WrittenTypesToProgramTypes.fs b/backend/src/LibParser/WrittenTypesToProgramTypes.fs index 5511d044c2..e102daf90f 100644 --- a/backend/src/LibParser/WrittenTypesToProgramTypes.fs +++ b/backend/src/LibParser/WrittenTypesToProgramTypes.fs @@ -173,18 +173,16 @@ module Expr = | WT.EBool(id, b) -> return PT.EBool(id, b) | WT.EUnit id -> return PT.EUnit id | WT.EVariable(id, var) -> - // // This could be a UserConstant - // let! constant = - // NR.resolveConstantName - // (builtins.constants |> Map.keys |> Set) - // pm - // NR.OnMissing.Allow - // currentModule - // (WT.Unresolved(NEList.singleton var)) - // match constant with - // | Ok _ as name -> return PT.EConstant(id, name) - // | Error _ -> - return PT.EVariable(id, var) + let! constant = + NR.resolveConstantName + (builtins.constants |> Map.keys |> Set) + pm + NR.OnMissing.Allow + currentModule + (WT.Unresolved(NEList.singleton var)) + match constant with + | Ok _ as name -> return PT.EConstant(id, name) + | Error _ -> return PT.EVariable(id, var) | WT.ERecordFieldAccess(id, obj, fieldname) -> let! obj = toPT obj return PT.ERecordFieldAccess(id, obj, fieldname) diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index 368405d0fd..340e7b5fb6 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -36,15 +36,15 @@ module HandleCommand = } -// let reloadDarkPackagesCanvas () : Ply> = -// uply { -// let! (canvasId, toplevels) = -// Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" + let reloadDarkPackagesCanvas () : Ply> = + uply { + // let! (canvasId, toplevels) = + // Canvas.loadFromDisk LibCloud.PackageManager.pt "dark-packages" -// print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" + // print $"Loaded canvas {canvasId} with {List.length toplevels} toplevels" -// return Ok() -// } + return Ok() + } @@ -90,10 +90,10 @@ let main (args : string[]) : int = "reading, parsing packages from `packages` directory, and saving to internal SQL tables" (HandleCommand.loadPackagesToInternalSqlTables ()) - // | [ "reload-dark-packages" ] -> - // handleCommand - // $"purging, re-creating, and seeding `dark-packages` canvas" - // (HandleCommand.reloadDarkPackagesCanvas ()) + | [ "reload-dark-packages" ] -> + handleCommand + $"purging, re-creating, and seeding `dark-packages` canvas" + (HandleCommand.reloadDarkPackagesCanvas ()) | _ -> print "Invalid arguments" diff --git a/backend/src/Prelude/NEList.fs b/backend/src/Prelude/NEList.fs index 28804c36e3..ddcbb71615 100644 --- a/backend/src/Prelude/NEList.fs +++ b/backend/src/Prelude/NEList.fs @@ -42,9 +42,7 @@ let map2 (f : 'a -> 'b -> 'c) (l1 : NEList<'a>) (l2 : NEList<'b>) : NEList<'c> = match l1, l2 with | [], [] -> [] | [], _ - | _, [] -> - System.Console.WriteLine((l1, l2)) - Exception.raiseInternal "NEList.map2: lists have different lengths" [] + | _, [] -> Exception.raiseInternal "NEList.map2: lists have different lengths" [] | x1 :: xs1, x2 :: xs2 -> f x1 x2 :: loop xs1 xs2 { head = f l1.head l2.head; tail = loop l1.tail l2.tail } diff --git a/backend/src/Prelude/Option.fs b/backend/src/Prelude/Option.fs index 073fdde917..e4dfdda741 100644 --- a/backend/src/Prelude/Option.fs +++ b/backend/src/Prelude/Option.fs @@ -4,9 +4,3 @@ let unwrap (default' : 'a) (t : Option<'a>) : 'a = match t with | None -> default' | Some value -> value - - -let getUnsafe (msg : string) (metadata : Exception.Metadata) (t : Option<'a>) : 'a = - match t with - | None -> Exception.raiseInternal msg metadata - | Some value -> value diff --git a/backend/src/Prelude/Prelude.fsproj b/backend/src/Prelude/Prelude.fsproj index 747ecff2d0..b8924afba6 100644 --- a/backend/src/Prelude/Prelude.fsproj +++ b/backend/src/Prelude/Prelude.fsproj @@ -18,7 +18,6 @@ - diff --git a/backend/src/Prelude/StringBuilder.fs b/backend/src/Prelude/StringBuilder.fs deleted file mode 100644 index cba4e04334..0000000000 --- a/backend/src/Prelude/StringBuilder.fs +++ /dev/null @@ -1,6 +0,0 @@ -module StringBuilder - -open System.Text - -let append (sb : StringBuilder) (s : string) : unit = - sb.Append s |> ignore diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index 4a00d86436..d913cc2fe5 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -130,14 +130,3 @@ let pVariable id (varName : string) (args : List) : PipeExpr = EPipeVariable(id, varName, args) let ePipe (expr : Expr) (parts : List) : Expr = EPipe(gid (), expr, parts) - - -// let customTypeRecord (fields : List) : TypeDeclaration.T = -// let fields = -// fields -// |> List.map (fun (name, typ) -> -// { name = name; typ = typ } : TypeDeclaration.RecordField) -// match fields with -// | [] -> Exception.raiseInternal "userRecord must have at least one field" [] -// | hd :: rest -> -// { typeParams = []; definition = TypeDeclaration.Record(NEList.ofList hd rest) } diff --git a/backend/tests/TestUtils/RTShortcuts.fs b/backend/tests/TestUtils/RTShortcuts.fs deleted file mode 100644 index 5347f34198..0000000000 --- a/backend/tests/TestUtils/RTShortcuts.fs +++ /dev/null @@ -1,97 +0,0 @@ -/// Collection of helpful "shortcut" functions to create Dark values quickly -module TestUtils.RTShortcuts - -open Prelude -open LibExecution.RuntimeTypes - -module PT = LibExecution.ProgramTypes -module PT2RT = LibExecution.ProgramTypesToRuntimeTypes - -// let eUnit () : Expr = EUnit(gid ()) - -// let eBool (b : bool) : Expr = EBool(gid (), b) - -// let eInt8 (i : int8) : Expr = EInt8(gid (), i) -// let euInt8 (i : uint8) : Expr = EUInt8(gid (), i) -// let eInt16 (i : int16) : Expr = EInt16(gid (), i) -// let euInt16 (i : uint16) : Expr = EUInt16(gid (), i) -// let eInt32 (i : int32) : Expr = EInt32(gid (), i) -// let euInt32 (i : uint32) : Expr = EUInt32(gid (), i) -// let eInt64 (i : int64) : Expr = EInt64(gid (), i) -// let euInt64 (i : uint64) : Expr = EUInt64(gid (), i) -// let eInt128 (i : System.Int128) : Expr = EInt128(gid (), i) -// let euInt128 (i : System.UInt128) : Expr = EUInt128(gid (), i) - -// let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = -// EFloat(gid (), makeFloat sign whole fraction) - -//let eChar (c : string) : Expr = EChar(gid (), c) -// let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) - - - - -// let eList (elems : Expr list) : Expr = EList(gid (), elems) - -// let eVar (name : string) : Expr = EVariable(gid (), name) - -// let eFieldAccess (expr : Expr) (fieldName : string) : Expr = -// ERecordFieldAccess(gid (), expr, fieldName) - -// let eLambda (pats : List) (body : Expr) : Expr = -// let pats = NEList.ofListUnsafe "eLambda" [] pats -// ELambda(gid (), pats, body) - -// let eEnum -// (typeName : FQTypeName.FQTypeName) -// (name : string) -// (args : Expr list) -// : Expr = -// EEnum(gid (), typeName, name, args) - - -// let eBuiltinFnName (name : string) (version : int) : Expr = -// PT.FQFnName.fqBuiltIn name version -// |> PT2RT.FQFnName.toRT -// |> fun x -> EFnName(gid (), x) - - -// let eFn' -// (function_ : string) -// (version : int) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eFn'" [] args -// EApply(gid (), (eBuiltinFnName function_ version), typeArgs, args) - -// let eFn -// (function_ : string) -// (version : int) -// (typeArgs : List) -// (args : List) -// : Expr = -// eFn' function_ version typeArgs args - - -// let eApply -// (target : Expr) -// (typeArgs : List) -// (args : List) -// : Expr = -// let args = NEList.ofListUnsafe "eApply" [] args -// EApply(gid (), target, typeArgs, args) - -// let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = -// ETuple(gid (), first, second, theRest) - - -// let customTypeRecord (fields : List) : TypeDeclaration.T = -// let fields = -// fields -// |> List.map (fun (name, typ) -> -// { name = name; typ = typ } : TypeDeclaration.RecordField) -// match fields with -// | [] -> Exception.raiseInternal "userRecord must have at least one field" [] -// | hd :: rest -> -// { typeParams = []; definition = TypeDeclaration.Record(NEList.ofList hd rest) } diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index b3255d1edc..de8c11a9ee 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -25,7 +25,6 @@ module Exe = LibExecution.Execution // module Account = LibCloud.Account // module Canvas = LibCloud.Canvas -module S = RTShortcuts module PackageIDs = LibExecution.PackageIDs // module C2DT = LibExecution.CommonToDarkTypes diff --git a/backend/tests/TestUtils/TestUtils.fsproj b/backend/tests/TestUtils/TestUtils.fsproj index 401b4db6f1..06ad9fac28 100644 --- a/backend/tests/TestUtils/TestUtils.fsproj +++ b/backend/tests/TestUtils/TestUtils.fsproj @@ -15,7 +15,6 @@ - diff --git a/backend/tests/Tests/Builtin.Tests.fs b/backend/tests/Tests/Builtin.Tests.fs index 2467eecb40..376db74db6 100644 --- a/backend/tests/Tests/Builtin.Tests.fs +++ b/backend/tests/Tests/Builtin.Tests.fs @@ -18,9 +18,10 @@ module Exe = LibExecution.Execution open TestUtils.TestUtils -let builtinToString (name : RT.FQFnName.Builtin) = $"{name.name}_v{name.version}" let oldFunctionsAreDeprecated = + let builtinToString (name : RT.FQFnName.Builtin) = $"{name.name}_v{name.version}" + testTask "old functions are deprecated" { let mutable counts = Map.empty diff --git a/backend/tests/Tests/ProgramTypes.Tests.fs b/backend/tests/Tests/ProgramTypes.Tests.fs index 4d9ebb8099..c87cce7c6d 100644 --- a/backend/tests/Tests/ProgramTypes.Tests.fs +++ b/backend/tests/Tests/ProgramTypes.Tests.fs @@ -9,7 +9,6 @@ module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes //module PT2ST = LibBinarySerialization.ProgramTypesToSerializedTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes -module S = TestUtils.RTShortcuts module PackageIDs = LibExecution.PackageIDs // module PT2DT = LibExecution.ProgramTypesToDarkTypes // module C2DT = LibExecution.CommonToDarkTypes diff --git a/packages/darklang/languageTools/common.dark b/packages/darklang/languageTools/common.dark index c138337c52..eff49249de 100644 --- a/packages/darklang/languageTools/common.dark +++ b/packages/darklang/languageTools/common.dark @@ -9,17 +9,22 @@ module Darklang = | Positive | Negative - type BuiltinFunctionParameter = { name: String; ``type``: String } + type BuiltinFunctionParameter = + { name: String + ``type``: RuntimeTypes.TypeReference } /// A Darklang builtin function type BuiltinFunction = - { name: String + { name: RuntimeTypes.FQFnName.Builtin description: String parameters: List - returnType: String } + returnType: RuntimeTypes.TypeReference } /// A Darklang builtin constant type BuiltinConstant = - { name: String + { name: RuntimeTypes.FQConstantName.Builtin description: String - ``type``: String } \ No newline at end of file + ``type``: RuntimeTypes.TypeReference } + +// TODO: update usages given the updates from `type: String` to `type: RuntimeTypes.TypeReference` +// TODO: and `name` updates \ No newline at end of file diff --git a/packages/darklang/prettyPrinter/programTypes.dark b/packages/darklang/prettyPrinter/programTypes.dark index 26e92c7049..5a16825dfb 100644 --- a/packages/darklang/prettyPrinter/programTypes.dark +++ b/packages/darklang/prettyPrinter/programTypes.dark @@ -16,12 +16,6 @@ module Darklang = // match nr.errorType with // | NotFound names -> Stdlib.String.join names "." // | InvalidPackageName names -> Stdlib.String.join names "." - // | ExpectedEnumButNot -> - // "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedEnumButNot" - // | ExpectedRecordButNot -> - // "Unexpected: stringification of NRE in RT Pretty-Printer for ExpectedRecordButNot" - // | MissingEnumModuleName -> - // "Unexpected: stringification of NRE in RT Pretty-Printer for MissingEnumModuleName" type NameResolutionError = | NotFound of List diff --git a/scripts/build/compile b/scripts/build/compile index 9a615b0973..ce67a2b968 100755 --- a/scripts/build/compile +++ b/scripts/build/compile @@ -259,7 +259,7 @@ class Should: self.fsharp_tool_restore = False self.fsharp_paket_restore = False self.fsharp_paket_install = False - #self.copy_dark_wasm = False TODO + #self.copy_dark_wasm = False self.backend_quick_build = False self.backend_full_build = False self.backend_test = False @@ -316,8 +316,8 @@ def execute(should): # if should.copy_dark_wasm: # if not copy_dark_wasm(): success = False - # if should.reload_backend_server: - # if not reload_backend_server(): success = False + if should.reload_backend_server: + if not reload_backend_server(): success = False if should.clear_local_db: if not clear_local_db(): success = False diff --git a/scripts/build/reload-packages b/scripts/build/reload-packages index cfa6f47b91..4a1feb88d9 100755 --- a/scripts/build/reload-packages +++ b/scripts/build/reload-packages @@ -32,16 +32,18 @@ fi ./scripts/run-local-exec $PUBLISHED_FLAG load-packages-to-internal-sql-tables > $LOG_CANVAS 2>&1 echo -e "Done loading packages to internal SQL tables" -# if [[ "$TEST" != "true" ]]; then -# echo "Waiting for BwdServer to be ready" -# for i in {1..100}; do -# if curl -s -o /dev/null "localhost:${DARK_CONFIG_BWDSERVER_KUBERNETES_PORT}" ; then -# break -# fi -# printf '.' -# sleep 0.1 -# done - -# echo -e "Reloading dark-packages canvas ${grey}($LOG_CANVAS)${reset}" -# ./scripts/run-local-exec $PUBLISHED_FLAG reload-dark-packages >> $LOG_CANVAS 2>&1 -# fi \ No newline at end of file + +if [[ "$TEST" != "true" ]]; then + echo "Waiting for BwdServer to be ready, so we can reload dark-packages canvas" + for i in {1..100}; do + if curl -s -o /dev/null "localhost:${DARK_CONFIG_BWDSERVER_KUBERNETES_PORT}" ; then + break + fi + printf '.' + sleep 0.1 + done + + echo -e "Reloading dark-packages canvas ${grey}($LOG_CANVAS)${reset}" + ./scripts/run-local-exec $PUBLISHED_FLAG reload-dark-packages >> $LOG_CANVAS 2>&1 + echo -e "Done reloading dark-packages canvas" +fi \ No newline at end of file From 510f07137e420e20423164040c41bb1171f75428 Mon Sep 17 00:00:00 2001 From: Ocean Date: Fri, 20 Sep 2024 20:25:06 +0000 Subject: [PATCH 52/60] Move some Builtin functions to package space --- backend/src/BuiltinExecution/Libs/Dict.fs | 181 --------- backend/src/BuiltinExecution/Libs/List.fs | 348 +----------------- backend/src/BuiltinExecution/Libs/String.fs | 41 +-- backend/testfiles/execution/stdlib/dict.dark | 11 +- backend/testfiles/execution/stdlib/list.dark | 8 +- .../testfiles/execution/stdlib/string.dark | 10 +- packages/darklang/stdlib/dict.dark | 22 +- packages/darklang/stdlib/list.dark | 131 ++++++- packages/darklang/stdlib/string.dark | 3 +- 9 files changed, 154 insertions(+), 601 deletions(-) diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index a389afe12b..ea0eb20f23 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -196,187 +196,6 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "dictMap" 0 - // typeParams = [] - // parameters = - // [ Param.make "dict" (TDict varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.ofList TString [ varA ], varB)) - // "" - // [ "key"; "value" ] ] - // returnType = TDict varB - // description = - // "Returns a new dictionary that contains the same keys as the original with values that have been transformed by {{fn}}, which operates on - // each key-value pair. - - // Consider if you also want to drop some of the entries." - // fn = - // (function - // | state, [], [ DDict(_vtTODO, o); DFnVal b ] -> - // uply { - // let mapped = Map.mapWithIndex (fun i v -> (i, v)) o - - // let! result = - // Ply.Map.mapSequentially - // (fun (key, dv) -> - // let args = NEList.ofList (DString key) [ dv ] - // Interpreter.applyFnVal state b [] args) - // mapped - - // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "dictIter" 0 - // typeParams = [] - // parameters = - // [ Param.make "dict" (TDict varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.ofList TString [ varA ], TUnit)) - // "" - // [ "key"; "value" ] ] - // returnType = TUnit - // description = - // "Evaluates {{fn key value}} on every entry in . Returns {{()}}." - // fn = - // (function - // | state, _, _, [ DDict(_, o); DFnVal b ] -> - // uply { - // do! - // Map.toList o - // |> Ply.List.iterSequentially (fun (key, dv) -> - // uply { - // let args = NEList.ofList (DString key) [ dv ] - // match! Interpreter.applyFnVal state b [] args with - // | DUnit -> return () - // | dv -> - // return! - // TypeChecker.raiseFnValResultNotExpectedType - // vmState.callStack - // dv - // TUnit - // }) - // return DUnit - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "dictFilter" 0 - // typeParams = [] - // parameters = - // [ Param.make "dict" (TDict varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.doubleton TString varA, TBool)) - // "" - // [ "key"; "value" ] ] - // returnType = TDict varB - // description = - // "Evaluates {{fn key value}} on every entry in . Returns a that contains only the entries of for which - // returned {{true}}." - // fn = - // (function - // | state, _, _, [ DDict(_vtTODO, o); DFnVal b ] -> - // uply { - // let f (key : string) (data : Dval) : Ply = - // uply { - // let args = NEList.ofList (DString key) [ data ] - // match! Interpreter.applyFnVal state b [] args with - // | DBool v -> return v - // | v -> - // return! - // TypeChecker.raiseFnValResultNotExpectedType - // vmState.callStack - // v - // TBool - // } - // let! result = Ply.Map.filterSequentially f o - // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "dictFilterMap" 0 - // typeParams = [] - // parameters = - // [ Param.make "dict" (TDict varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.ofList TString [ varA ], TypeReference.option varB)) - // "" - // [ "key"; "value" ] ] - // returnType = TDict varB - // description = - // "Calls on every entry in , returning a that drops some entries (filter) and transforms others (map). - // If {{fn key value}} returns {{None}}, does not add or to the new dictionary, dropping the entry. - // If {{fn key value}} returns {{Some newValue}}, adds the entry : to the new dictionary. - // This function combines and ." - // fn = - // (function - // | state, _, _, [ DDict(_vtTODO, o); DFnVal b ] -> - // uply { - // let f (key : string) (data : Dval) : Ply> = - // uply { - // let args = NEList.ofList (DString key) [ data ] - // let! result = Interpreter.applyFnVal state b [] args - - // match result with - // | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "Some", [ o ]) when - // id = PackageIDs.Type.Stdlib.option - // -> - // return Some o - - // | DEnum(FQTypeName.Package id, _, _typeArgsDEnumTODO, "None", []) when - // id = PackageIDs.Type.Stdlib.option - // -> - // return None - - // | v -> - // let expectedType = TypeReference.option varB - // return! - // TypeChecker.raiseFnValResultNotExpectedType - // vmState.callStack - // v - // expectedType - // } - - // let! result = Ply.Map.filterMapSequentially f o - // return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - { name = fn "dictIsEmpty" 0 - typeParams = [] - parameters = [ Param.make "dict" (TDict varA) "" ] - returnType = TBool - description = "Returns {{true}} if the contains no entries" - fn = - (function - | _, _, _, [ DDict(_, dict) ] -> Ply(DBool(Map.isEmpty dict)) - | _ -> incorrectArgs ()) - sqlSpec = NotYetImplemented - previewable = Pure - deprecated = NotDeprecated } - - { name = fn "dictMerge" 0 typeParams = [] parameters = diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index 9f819b8445..0a1c80b5ab 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -289,47 +289,7 @@ let varC = TVariable "c" let fns : List = - [ - // { name = fn "listUniqueBy" 0 - // typeParams = [] - // parameters = - // [ Param.make "list" (TList varA) "" - // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] - // returnType = TList varA - // description = - // "Returns the passed list, with only unique values, where uniqueness is based - // on the result of . Only one of each value will be returned, but the - // order will not be maintained." - // fn = - // (function - // | state, _, _, [ DList(vt, l); DFnVal b ] -> - // uply { - // let! projected = - // Ply.List.mapSequentially - // (fun dv -> - // uply { - // let args = NEList.singleton dv - // let! key = Interpreter.applyFnVal state b [] args - - // // TODO: type check to ensure `varB` is "comparable" - // return (dv, key) - // }) - // l - - // return - // projected - // |> List.distinctBy snd - // |> List.map fst - // |> List.sortWith DvalComparator.compareDval - // |> fun l -> DList(vt, l) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - { name = fn "listLength" 0 + [ { name = fn "listLength" 0 typeParams = [] parameters = [ Param.make "list" (TList varA) "" ] returnType = TInt64 @@ -388,115 +348,6 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "listSortBy" 0 - // typeParams = [] - // parameters = - // [ Param.make "list" (TList varA) "" - // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "val" ] ] - // returnType = TList varA - // description = - // "Returns a copy of , sorted in ascending order, as if each value - // evaluated to {{fn val}}. - - // For example, {{List.sortBy [\"x\",\"jkl\",\"ab\"] \\val -> String.length - // val}} returns {{[ \"x\", \"ab\", \"jkl\" ]}}. - - // Consider if the list values can be directly compared, or if you want more control over the sorting process." - // fn = - // (function - // | state, _, _, [ DList(vt, list); DFnVal b ] -> - // uply { - // let fn dv = - // let args = NEList.singleton dv - // Interpreter.applyFnVal state b [] args - // let! withKeys = - // list - // |> Ply.List.mapSequentially (fun v -> - // uply { - // let! key = fn v - // return (key, v) - // }) - - // return - // withKeys - // |> List.sortWith (fun (k1, _) (k2, _) -> - // DvalComparator.compareDval k1 k2) - // |> List.map snd - // |> fun l -> DList(vt, l) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "listSortByComparator" 0 - // typeParams = [] - // parameters = - // [ Param.make "list" (TList varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.doubleton varA varA, TInt64)) - // "" - // [ "a"; "b" ] ] - // returnType = TypeReference.result varA TString - // description = - // "Returns a copy of , sorted using {{fn a b}} to compare values - // and . - - // must return {{-1}} if should appear before , {{1}} - // if should appear after , and {{0}} if the order of - // and doesn't matter. - - // Consider or if you don't need this level - // of control." - // fn = - - // (function - // | state, _, _, [ DList(vt, list); DFnVal f ] -> - // let okType = VT.unknownTODO - // let resultOk = - // TypeChecker.DvalCreator.resultOk state.tracing.callStack okType VT.string - // let resultError = - // TypeChecker.DvalCreator.resultError - // state.tracing.callStack - // okType - // VT.string - - - // let fn (dv1 : Dval) (dv2 : Dval) : Ply = - // uply { - // let args = NEList.doubleton dv1 dv2 - // let! result = Interpreter.applyFnVal state f [] args - - // match result with - // | DInt64 i when i = 1L || i = 0L || i = -1L -> return int i - // | DInt64 i -> return raise (Sort.InvalidSortComparatorInt i) - // | v -> - // return! - // TypeChecker.raiseFnValResultNotExpectedType - // state.tracing.callStack - // v - // TInt64 - // } - - // uply { - // try - // let array = List.toArray list - // do! Sort.sort fn array - // return array |> Array.toList |> (fun l -> DList(vt, l)) |> resultOk - // with Sort.InvalidSortComparatorInt i -> - // let message = - // $"Expected comparator function to return -1, 0, or 1, but it returned {i}" - // return resultError (DString message) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - { name = fn "listAppend" 0 typeParams = [] parameters = @@ -517,149 +368,6 @@ let fns : List = deprecated = NotDeprecated } - // { name = fn "listIndexedMap" 0 - // typeParams = [] - // parameters = - // [ Param.make "list" (TList varA) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.doubleton TInt64 varA, varB)) - // "" - // [ "index"; "val" ] ] - // returnType = TList varB - // description = - // "Calls on every and its in , - // returning a list of the results of those calls. - - // Consider if you don't need the index." - // fn = - // (function - // | state, _, _, [ DList(_vtTODO, l); DFnVal b ] -> - // uply { - // let list = List.mapi (fun i v -> (i, v)) l - - // let! result = - // Ply.List.mapSequentially - // (fun ((i, dv) : int * Dval) -> - // let args = NEList.doubleton (DInt64(int64 i)) dv - // Interpreter.applyFnVal state b [] args) - // list - - // return - // TypeChecker.DvalCreator.list - // state.tracing.callStack - // VT.unknownTODO - // result - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "listMap2shortest" 0 - // typeParams = [] - // parameters = - // [ Param.make "as" (TList varA) "" - // Param.make "bs" (TList varB) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.doubleton varA varB, varC)) - // "" - // [ "a"; "b" ] ] - // returnType = TList varC - // description = - // "Maps over and in parallel, calling {{fn a - // b}} on every pair of values from and . - - // If the lists differ in length, values from the longer list are dropped. - - // For example, if is {{[1,2]}} and is - // {{[\"x\",\"y\",\"z\"]}}, returns {{[(f 1 \"x\"), (f 2 \"y\")]}} - - // Use if you want to enforce equivalent lengths for - // and ." - // fn = - // (function - // | state, _, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> - // uply { - // let len = min (List.length l1) (List.length l2) - // let l1 = List.take (int len) l1 - // let l2 = List.take (int len) l2 - - // let list = List.zip l1 l2 - - // let! result = - // Ply.List.mapSequentially - // (fun ((dv1, dv2) : Dval * Dval) -> - // let args = NEList.doubleton dv1 dv2 - // Interpreter.applyFnVal state b [] args) - // list - - // return - // TypeChecker.DvalCreator.list - // state.tracing.callStack - // VT.unknownTODO - // result - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "listMap2" 0 - // typeParams = [] - // parameters = - // [ Param.make "as" (TList varA) "" - // Param.make "bs" (TList varB) "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.doubleton varA varB, varC)) - // "" - // [ "a"; "b" ] ] - // returnType = TypeReference.option varC - // description = - // "If the lists are the same length, returns {{Some list}} formed by mapping - // over and in parallel, calling {{fn a b}} on - // every pair of values from and . - - // For example, if is {{[1,2,3]}} and is - // {{[\"x\",\"y\",\"z\"]}}, returns {{[(fn 1 \"x\"), (f 2 \"y\"), (f 3 - // \"z\")]}}. - - // If the lists differ in length, returns {{None}} (consider if you want to drop values from the longer list - // instead)." - // fn = - // let optType = VT.unknownTODO - // (function - // | state, _, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> - // uply { - // if List.length l1 <> List.length l2 then - // return TypeChecker.DvalCreator.optionNone optType - // else - // let list = List.zip l1 l2 - - // let! result = - // Ply.List.mapSequentially - // (fun ((dv1, dv2) : Dval * Dval) -> - // let args = NEList.doubleton dv1 dv2 - // Interpreter.applyFnVal state b [] args) - // list - - // let callStack = state.tracing.callStack - - // return - // TypeChecker.DvalCreator.list callStack VT.unknownTODO result - // |> TypeChecker.DvalCreator.optionSome callStack optType - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - - { name = fn "listRandomElement" 0 typeParams = [] parameters = [ Param.make "list" (TList varA) "" ] @@ -685,59 +393,7 @@ let fns : List = | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure - deprecated = NotDeprecated } - - - // { name = fn "listGroupByWithKey" 0 - // typeParams = [] - // parameters = - // [ Param.make "list" (TList varA) "" - // Param.makeWithArgs "fn" (TFn(NEList.singleton varA, varB)) "" [ "item" ] ] - // returnType = TList(TTuple(varB, TList varA, [])) - // description = - // "Groups into tuples (key, elements), where the key is computed by applying - // to each element in the list. - - // For example, if is {{[1, 2, 3, 4, 5]}} and - // is {{fn item -> Int64.mod item 2}}, returns {{[(1, [1, 3, 5]), (0, [2, 4])]}}. - - // Preserves the order of values and of the keys." - // fn = - // (function - // | state, _, _, [ DList(listType, l); DFnVal fn ] -> - // uply { - // let applyFn (dval : Dval) : DvalTask = - // let args = NEList.singleton dval - // Interpreter.applyFnVal state fn [] args - - // // apply the function to each element in the list - // let! result = - // Ply.List.mapSequentially - // (fun dval -> - // uply { - // let! key = applyFn dval - // return (key, dval) - // }) - // l - - // return - // result - // |> Seq.groupBy fst - // |> Seq.toList - // |> List.map (fun (key, elementsWithKey) -> - // DTuple( - // key, - // DList(listType, Seq.map snd elementsWithKey |> Seq.toList), - // [] - // )) - // |> fun pairs -> - // DList(VT.tuple VT.unknownTODO (VT.list listType) [], pairs) - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotYetImplemented - // previewable = Pure - // deprecated = NotDeprecated } - ] + deprecated = NotDeprecated } ] let builtins = LibExecution.Builtin.make [] fns diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index 3f7d7c6f96..1a0b5bd286 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -19,46 +19,7 @@ module Interpreter = LibExecution.Interpreter let fns : List = - [ - // { name = fn "stringMap" 0 - // typeParams = [] - // parameters = - // [ Param.make "s" TString "" - // Param.makeWithArgs - // "fn" - // (TFn(NEList.singleton TChar, TChar)) - // "" - // [ "character" ] ] - // returnType = TString - // description = - // "Iterate over each Char (EGC, not byte) in the string, performing the - // operation in on each one." - // fn = - // (function - // | state, _, _, [ DString s; DFnVal b ] -> - // (String.toEgcSeq s - // |> Seq.toList - // |> Ply.List.mapSequentially (fun te -> - // let args = NEList.singleton (DChar te) - // Interpreter.applyFnVal state b [] args) - // |> Ply.bind (fun dvals -> - // dvals - // |> Ply.List.mapSequentially (function - // | DChar c -> Ply c - // | dv -> - // TypeChecker.raiseFnValResultNotExpectedType - // state.tracing.callStack - // dv - // TChar) - // |> Ply.map (fun parts -> - // parts |> String.concat "" |> String.normalize |> DString))) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - { name = fn "stringToList" 0 + [ { name = fn "stringToList" 0 typeParams = [] parameters = [ Param.make "s" TString "" ] returnType = TList TChar diff --git a/backend/testfiles/execution/stdlib/dict.dark b/backend/testfiles/execution/stdlib/dict.dark index 2ac13787b7..5fd8b65348 100644 --- a/backend/testfiles/execution/stdlib/dict.dark +++ b/backend/testfiles/execution/stdlib/dict.dark @@ -11,14 +11,15 @@ module FilterMap = else (Stdlib.Option.Option.Some(key ++ value))) = (Dict { c = "cz"; a = "ax" }) + // CLEANUP: it should be a type error on the function not returning a Bool (Stdlib.Dict.filterMap_v0 (Dict { a = "x"; b = "y"; c = "z" }) (fun key value -> if value == "y" then false else Stdlib.Option.Option.Some(key ++ value))) = Builtin.testDerrorMessage - """Function return value should be a PACKAGE.Darklang.Stdlib.Option.Option<'b>. However, a Bool (false) was returned instead. + """PACKAGE.Darklang.Stdlib.Option.map's 1st argument (`option`) should be a PACKAGE.Darklang.Stdlib.Option.Option<'a>. However, a Bool (false) was passed instead. -Expected: PACKAGE.Darklang.Stdlib.Option.Option<'b> +Expected: (option: PACKAGE.Darklang.Stdlib.Option.Option<'a>) Actual: a Bool: false""" @@ -32,11 +33,9 @@ module Filter = Stdlib.Dict.filter (Dict { }) (fun k v -> 0L) = (Dict { }) + // CLEANUP: this should be a type error on the function not returning a Bool Stdlib.Dict.filter (Dict { a = 1L; b = 2L; c = 3L }) (fun k v -> 2L) = Builtin.testDerrorMessage - """Function return value should be a Bool. However, an Int64 (2) was returned instead. - -Expected: Bool -Actual: an Int64: 2""" + "If only supports Booleans" module FromListOverwritingDuplicates = diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/list.dark index 61af9f13c3..83a45162fe 100644 --- a/backend/testfiles/execution/stdlib/list.dark +++ b/backend/testfiles/execution/stdlib/list.dark @@ -296,14 +296,18 @@ Stdlib.List.sort_v0 [ "6"; "2"; "8"; "3" ] = [ "2"; "3"; "6"; "8" ] Stdlib.List.sort_v0 [ 6L; 2L; 8L; 3L ] = [ 2L; 3L; 6L; 8L ] Stdlib.List.sort_v0 [] = [] +// CLEANUP: it should be a type error on the function not returning an Int64 Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 0.1) = Builtin.testDerrorMessage - "Function return value should be an Int64. However, a Float (0.1) was returned instead.\n\nExpected: Int64\nActual: a Float: 0.1" + // "Function return value should be an Int64. However, a Float (0.1) was returned instead.\n\nExpected: Int64\nActual: a Float: 0.1" + "Both values must be the same type" Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 3L) = Stdlib.Result.Result.Error "Expected comparator function to return -1, 0, or 1, but it returned 3" +// CLEANUP: it should be a type error on the function not returning an Int64 Stdlib.List.sortByComparator_v0 [ 1L; 2L; 3L ] (fun a b -> "㧑༷釺") = Builtin.testDerrorMessage - "Function return value should be an Int64. However, a String (\"㧑༷釺\") was returned instead.\n\nExpected: Int64\nActual: a String: \"㧑༷釺\"" + // "Function return value should be an Int64. However, a String (\"㧑༷釺\") was returned instead.\n\nExpected: Int64\nActual: a String: \"㧑༷釺\"" + "Both values must be the same type" Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok diff --git a/backend/testfiles/execution/stdlib/string.dark b/backend/testfiles/execution/stdlib/string.dark index 3bccda1d31..78467716bb 100644 --- a/backend/testfiles/execution/stdlib/string.dark +++ b/backend/testfiles/execution/stdlib/string.dark @@ -162,11 +162,15 @@ module Map = Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 'c') = "cccc" + // CLEANUP: it should be a type error on the function not returning a Char Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 5L) = Builtin.testDerrorMessage - """Function return value should be a Char. However, an Int64 (5) was returned instead. + """PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ 5, 5, ...) was passed instead. + +Expected: (lst: List) +Actual: a List: [ + 5, 5, 5, 5 +]""" -Expected: Char -Actual: an Int64: 5""" // Check that map executes the right number of times (let v = diff --git a/packages/darklang/stdlib/dict.dark b/packages/darklang/stdlib/dict.dark index 990e58864c..e9c15cfbb8 100644 --- a/packages/darklang/stdlib/dict.dark +++ b/packages/darklang/stdlib/dict.dark @@ -62,19 +62,25 @@ module Darklang = /// each key-value pair. /// Consider if you also want to drop some of the entries. let map (dict: Dict<'a>) (fn: String -> 'a -> 'b) : Dict<'b> = - Builtin.dictMap_v0 dict fn + dict + |> Dict.toList + |> List.map (fun (k, v) -> (k, fn k v)) + |> Dict.fromListOverwritingDuplicates /// Evaluates {{fn key value}} on every entry in . Returns {{()}}. let iter (dict: Dict<'a>) (fn: String -> 'a -> Unit) : Unit = - Builtin.dictIter_v0 dict fn + dict |> Dict.toList |> List.iter (fun (k, v) -> fn k v) /// Evaluates {{fn key value}} on every entry in . Returns a that contains only the entries of for which /// returned {{true}}. let filter (dict: Dict<'a>) (fn: String -> 'a -> Bool) : Dict<'a> = - Builtin.dictFilter_v0 dict fn + dict + |> Dict.toList + |> List.filter (fun (k, v) -> fn k v) + |> Dict.fromListOverwritingDuplicates /// Calls on every entry in , returning a that drops some entries (filter) and transforms others (map). @@ -83,13 +89,17 @@ module Darklang = /// This function combines and . let filterMap (dict: Dict<'a>) - (fn: String -> 'a -> Stdlib.Option.Option<'b>) + (fn: String -> 'a -> Option.Option<'b>) : Dict<'b> = - Builtin.dictFilterMap_v0 dict fn + dict + |> Dict.toList + |> List.filterMap (fun (k, v) -> + (fn k v) |> Option.map (fun newValue -> (k, newValue))) + |> Dict.fromListOverwritingDuplicates /// Returns {{true}} if the contains no entries - let isEmpty (dict: Dict<'a>) : Bool = Builtin.dictIsEmpty_v0 dict + let isEmpty (dict: Dict<'a>) : Bool = dict == Dict.empty /// Returns a combined dictionary with both dictionaries' entries. If the same key exists in both and , it will have the value from . diff --git a/packages/darklang/stdlib/list.dark b/packages/darklang/stdlib/list.dark index 4c599e1eff..d0d39d612f 100644 --- a/packages/darklang/stdlib/list.dark +++ b/packages/darklang/stdlib/list.dark @@ -152,16 +152,16 @@ module Darklang = /// on the result of . Only one of each value will be returned, but the /// order will not be maintained. let uniqueBy (list: List<'a>) (fn: 'a -> 'b) : List<'a> = - Builtin.listUniqueBy_v0 list fn + list + |> List.fold ([], []) (fun (unique, seen) value -> + let uniqueValue = fn value - (* - // let uniqueBy' (list: List<'a>) (fn: 'a -> 'b) : List<'a> = - // let projected = map list (fun dv -> (dv, fn dv)) - // projected - // |> List.distinctBy snd - // |> List.map fst - // |> List.sortWith DvalComparator.compareDval - *) + if List.member_v0 seen uniqueValue then + (unique, seen) + else + (List.push unique value, List.push seen uniqueValue)) + |> fun (uniqueValues, _) -> uniqueValues + |> List.sort /// Returns the passed list, with only unique values. @@ -188,7 +188,71 @@ module Darklang = /// Consider if the list values can be directly compared, or if you want more control over the sorting process. let sortBy (list: List<'a>) (fn: 'a -> 'b) : List<'a> = - Builtin.listSortBy_v0 list fn + list + |> List.map (fun x -> (fn x, x)) + |> List.sort + |> List.map (Tuple2.second) + + + // Helper functions for sortByComparator + let validateComparator + (comparator: 'a -> 'a -> Int64) + (x: 'a) + (y: 'a) + : Result.Result = + let result = comparator x y + + if result == -1L || result == 0L || result == 1L then + Result.Result.Ok result + else + Result.Result.Error + $"Expected comparator function to return -1, 0, or 1, but it returned {Int64.toString result}" + + let rec spcHelperMerge + (comparator: 'a -> 'a -> Int64) + (left: List<'a>) + (right: List<'a>) + : Result.Result, String> = + match left, right with + | [], _ -> Result.Result.Ok right + | _, [] -> Result.Result.Ok left + | (x :: xs, y :: ys) -> + match validateComparator comparator x y with + | Error msg -> Result.Result.Error msg + | Ok result -> + if result <= 0L then + match spcHelperMerge comparator xs right with + | Error msg -> Result.Result.Error msg + | Ok merged -> Result.Result.Ok(List.push merged x) + else + match spcHelperMerge comparator left ys with + | Error msg -> Result.Result.Error msg + | Ok merged -> Result.Result.Ok(List.push merged y) + + let spcHelperSplitList (lst: List<'a>) : List<'a> * List<'a> = + match lst with + | [] -> [], [] + | [ x ] -> [ x ], [] + | x :: y :: xs -> + let (left, right) = spcHelperSplitList xs + (List.push left x, List.push right y) + + let rec spcHelperMergeSort + (comparator: 'a -> 'a -> Int64) + (lst: List<'a>) + : Result.Result, String> = + match lst with + | [] -> Result.Result.Ok [] + | [ x ] -> Result.Result.Ok [ x ] + | lst -> + let left, right = spcHelperSplitList lst + + match spcHelperMergeSort comparator left with + | Error msg -> Result.Result.Error msg + | Ok sortedLeft -> + match spcHelperMergeSort comparator right with + | Error msg -> Result.Result.Error msg + | Ok sortedRight -> spcHelperMerge comparator sortedLeft sortedRight /// Returns a copy of , sorted using {{fn a b}} to compare values @@ -202,7 +266,7 @@ module Darklang = (list: List<'a>) (fn: 'a -> 'a -> Int64) : Stdlib.Result.Result, String> = - Builtin.listSortByComparator_v0 list fn + spcHelperMergeSort fn list /// Returns a new list with all values in followed by all values in , @@ -307,10 +371,29 @@ module Darklang = /// Calls on every and its in , /// returning a list of the results of those calls. /// Consider if you don't need the index. - let indexedMap (list: List<'a>) (fn: 'a -> Int64 -> 'b) : List<'b> = - Builtin.listIndexedMap_v0 list fn + let indexedMap (list: List<'a>) (fn: Int64 -> 'a -> 'b) : List<'b> = + list + |> List.fold ([], 0L) (fun (acc, index) item -> + let mappedItem = fn index item + (List.pushBack acc mappedItem, index + 1L)) + |> Tuple2.first + // Helper function for map2shortest + let map2shortestHelper + (as_: List<'a>) + (bs: List<'b>) + (fn: 'a -> 'b -> 'c) + (result: List<'c>) + : List<'c> = + match (as_, bs) with + | ([], _) -> result + | (_, []) -> result + | (a :: restA, b :: restB) -> + let mappedResult = fn a b + let result = List.pushBack result mappedResult + map2shortestHelper restA restB fn result + /// Maps over and in parallel, calling {{fn a /// b}} on every pair of values from and . /// If the lists differ in length, values from the longer list are dropped. @@ -323,7 +406,7 @@ module Darklang = (bs: List<'b>) (fn: 'a -> 'b -> 'c) : List<'c> = - Builtin.listMap2shortest_v0 as_ bs fn + map2shortestHelper as_ bs fn [] /// If the lists are the same length, returns {{Just list}} formed by mapping @@ -340,7 +423,10 @@ module Darklang = (bs: List<'b>) (fn: 'a -> 'b -> 'c) : Stdlib.Option.Option> = - Builtin.listMap2_v0 as_ bs fn + if (List.length as_) != (List.length bs) then + Option.Option.None + else + Option.Option.Some(List.map2shortest as_ bs fn) /// Returns a list of parallel pairs from and . @@ -429,7 +515,20 @@ module Darklang = /// is {{fn item -> Int64.mod_v0 item 2}}, returns {{[(1, [1, 3, 5]), (0, [2, 4])]}}. /// Preserves the order of values and of the keys. let groupByWithKey (list: List<'a>) (fn: 'a -> 'b) : List<('b * List<'a>)> = - Builtin.listGroupByWithKey_v0 list fn + list + // CLEANUP: improve performance + |> List.fold [] (fun groupCollector element -> + let key = fn element + let tryFindGroup = List.findFirst groupCollector (fun (k, _) -> k == key) + + match tryFindGroup with + | Some _ -> + List.map groupCollector (fun (k, elements) -> + if k == key then + (k, List.pushBack elements element) + else + (k, elements)) + | None -> List.pushBack groupCollector (key, [ element ])) /// Calls on every in , splitting the list into diff --git a/packages/darklang/stdlib/string.dark b/packages/darklang/stdlib/string.dark index 58b39d1320..c1cbce8702 100644 --- a/packages/darklang/stdlib/string.dark +++ b/packages/darklang/stdlib/string.dark @@ -40,7 +40,8 @@ module Darklang = /// Iterate over each Char (EGC, not byte) in the string, performing the /// operation in on each one. - let map (s: String) (fn: Char -> Char) : String = Builtin.stringMap s fn + let map (s: String) (fn: Char -> Char) : String = + s |> String.toList |> List.map fn |> String.fromList /// Returns the list of Characters (EGC, not byte) in the string From c5905473e3637c7235e0a70f564e5356d54a9fb5 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 20 Sep 2024 19:57:43 -0400 Subject: [PATCH 53/60] Get some of LibExe tests running; note one failing test --- backend/src/LibCloud/Canvas.fs | 17 +- .../DvalReprInternalRoundtrippable.fs | 117 +++--- backend/src/LibCloud/LibCloud.fsproj | 22 +- backend/src/LibCloud/TraceCloudStorage.fs | 23 +- backend/src/LibCloud/Tracing.fs | 9 +- backend/src/LibExecution/DvalDecoder.fs | 4 +- backend/src/LibExecution/Interpreter.fs | 36 +- backend/src/LibExecution/PackageIDs.fs | 6 +- .../execution/cloud/{db.dark => _db.dark} | 0 .../testfiles/execution/cloud/_events.dark | 4 +- .../cloud/{internal.dark => _internal.dark} | 0 .../language/{big.dark => _big.dark} | 0 .../language/{derror.dark => _derror.dark} | 0 .../language/{elambda.dark => _elambda.dark} | 0 .../{interpreter.dark => _interpreter.dark} | 0 .../{eapply.dark => apply/_eapply.dark} | 0 .../{einfix.dark => apply/_einfix.dark} | 0 .../{evariable.dark => basic/_evariable.dark} | 0 .../language/{ => basic}/dfloat.dark | 0 .../execution/language/basic/eand.dark | 17 + .../execution/language/basic/elet.dark | 92 +++++ .../execution/language/basic/eor.dark | 17 + .../execution/language/basic/estring.dark | 18 + .../{dlist.dark => collections/_dlist.dark} | 0 .../{dtuple.dark => collections/_dtuple.dark} | 0 .../{edict.dark => collections/_edict.dark} | 0 .../_econstant.dark} | 0 .../_efieldaccess.dark} | 0 .../_type-alias.dark} | 0 .../_type-enum.dark} | 0 .../_type-record.dark} | 0 .../testfiles/execution/language/eand.dark | 17 - .../testfiles/execution/language/elet.dark | 92 ----- backend/testfiles/execution/language/eor.dark | 17 - .../testfiles/execution/language/estring.dark | 18 - .../{eif.dark => flow-control/_eif.dark} | 0 .../_ematch.dark} | 0 .../{epipe.dark => flow-control/_epipe.dark} | 0 .../stdlib/{alt-json.dark => _alt-json.dark} | 0 .../stdlib/{base64.dark => _base64.dark} | 0 .../stdlib/{bool.dark => _bool.dark} | 0 .../stdlib/{bytes.dark => _bytes.dark} | 0 .../stdlib/{char.dark => _char.dark} | 0 .../stdlib/{crypto.dark => _crypto.dark} | 0 .../stdlib/{date.dark => _date.dark} | 0 .../stdlib/{dict.dark => _dict.dark} | 0 .../stdlib/{float.dark => _float.dark} | 0 .../stdlib/{html.dark => _html.dark} | 0 .../stdlib/{http.dark => _http.dark} | 0 .../{httpclient.dark => _httpclient.dark} | 0 .../stdlib/{json.dark => _json.dark} | 0 .../stdlib/{list.dark => _list.dark} | 0 .../stdlib/{math.dark => _math.dark} | 0 .../stdlib/{nomodule.dark => _nomodule.dark} | 0 .../stdlib/{option.dark => _option.dark} | 0 .../stdlib/{parser.dark => _parser.dark} | 0 .../stdlib/{result.dark => _result.dark} | 0 ...zation.dark => _semanticTokenization.dark} | 0 .../stdlib/{string.dark => _string.dark} | 0 .../stdlib/{tuple.dark => _tuple.dark} | 0 .../stdlib/{uuid.dark => _uuid.dark} | 0 .../stdlib/{x509.dark => _x509.dark} | 0 .../stdlib/{int128.dark => ints/_int128.dark} | 0 .../stdlib/{int16.dark => ints/_int16.dark} | 0 .../stdlib/{int32.dark => ints/_int32.dark} | 0 .../stdlib/{int64.dark => ints/_int64.dark} | 0 .../stdlib/{int8.dark => ints/_int8.dark} | 0 .../{uint128.dark => ints/_uint128.dark} | 0 .../stdlib/{uint16.dark => ints/_uint16.dark} | 0 .../stdlib/{uint32.dark => ints/_uint32.dark} | 0 .../stdlib/{uint64.dark => ints/_uint64.dark} | 0 .../stdlib/{uint8.dark => ints/_uint8.dark} | 0 backend/tests/TestUtils/LibTest.fs | 335 +++++++++--------- backend/tests/TestUtils/TestUtils.fs | 100 +++--- backend/tests/Tests/HttpClient.Tests.fs | 4 +- backend/tests/Tests/LibExecution.Tests.fs | 189 +++++----- backend/tests/Tests/StorageTraces.Tests.fs | 2 - backend/tests/Tests/Tests.fs | 18 +- backend/tests/Tests/Tests.fsproj | 12 +- scripts/run-backend-tests | 18 +- 80 files changed, 628 insertions(+), 576 deletions(-) rename backend/testfiles/execution/cloud/{db.dark => _db.dark} (100%) rename backend/testfiles/execution/cloud/{internal.dark => _internal.dark} (100%) rename backend/testfiles/execution/language/{big.dark => _big.dark} (100%) rename backend/testfiles/execution/language/{derror.dark => _derror.dark} (100%) rename backend/testfiles/execution/language/{elambda.dark => _elambda.dark} (100%) rename backend/testfiles/execution/language/{interpreter.dark => _interpreter.dark} (100%) rename backend/testfiles/execution/language/{eapply.dark => apply/_eapply.dark} (100%) rename backend/testfiles/execution/language/{einfix.dark => apply/_einfix.dark} (100%) rename backend/testfiles/execution/language/{evariable.dark => basic/_evariable.dark} (100%) rename backend/testfiles/execution/language/{ => basic}/dfloat.dark (100%) create mode 100644 backend/testfiles/execution/language/basic/eand.dark create mode 100644 backend/testfiles/execution/language/basic/elet.dark create mode 100644 backend/testfiles/execution/language/basic/eor.dark create mode 100644 backend/testfiles/execution/language/basic/estring.dark rename backend/testfiles/execution/language/{dlist.dark => collections/_dlist.dark} (100%) rename backend/testfiles/execution/language/{dtuple.dark => collections/_dtuple.dark} (100%) rename backend/testfiles/execution/language/{edict.dark => collections/_edict.dark} (100%) rename backend/testfiles/execution/language/{econstant.dark => custom-data/_econstant.dark} (100%) rename backend/testfiles/execution/language/{efieldaccess.dark => custom-data/_efieldaccess.dark} (100%) rename backend/testfiles/execution/language/{type-alias.dark => custom-data/_type-alias.dark} (100%) rename backend/testfiles/execution/language/{type-enum.dark => custom-data/_type-enum.dark} (100%) rename backend/testfiles/execution/language/{type-record.dark => custom-data/_type-record.dark} (100%) delete mode 100644 backend/testfiles/execution/language/eand.dark delete mode 100644 backend/testfiles/execution/language/elet.dark delete mode 100644 backend/testfiles/execution/language/eor.dark delete mode 100644 backend/testfiles/execution/language/estring.dark rename backend/testfiles/execution/language/{eif.dark => flow-control/_eif.dark} (100%) rename backend/testfiles/execution/language/{ematch.dark => flow-control/_ematch.dark} (100%) rename backend/testfiles/execution/language/{epipe.dark => flow-control/_epipe.dark} (100%) rename backend/testfiles/execution/stdlib/{alt-json.dark => _alt-json.dark} (100%) rename backend/testfiles/execution/stdlib/{base64.dark => _base64.dark} (100%) rename backend/testfiles/execution/stdlib/{bool.dark => _bool.dark} (100%) rename backend/testfiles/execution/stdlib/{bytes.dark => _bytes.dark} (100%) rename backend/testfiles/execution/stdlib/{char.dark => _char.dark} (100%) rename backend/testfiles/execution/stdlib/{crypto.dark => _crypto.dark} (100%) rename backend/testfiles/execution/stdlib/{date.dark => _date.dark} (100%) rename backend/testfiles/execution/stdlib/{dict.dark => _dict.dark} (100%) rename backend/testfiles/execution/stdlib/{float.dark => _float.dark} (100%) rename backend/testfiles/execution/stdlib/{html.dark => _html.dark} (100%) rename backend/testfiles/execution/stdlib/{http.dark => _http.dark} (100%) rename backend/testfiles/execution/stdlib/{httpclient.dark => _httpclient.dark} (100%) rename backend/testfiles/execution/stdlib/{json.dark => _json.dark} (100%) rename backend/testfiles/execution/stdlib/{list.dark => _list.dark} (100%) rename backend/testfiles/execution/stdlib/{math.dark => _math.dark} (100%) rename backend/testfiles/execution/stdlib/{nomodule.dark => _nomodule.dark} (100%) rename backend/testfiles/execution/stdlib/{option.dark => _option.dark} (100%) rename backend/testfiles/execution/stdlib/{parser.dark => _parser.dark} (100%) rename backend/testfiles/execution/stdlib/{result.dark => _result.dark} (100%) rename backend/testfiles/execution/stdlib/{semanticTokenization.dark => _semanticTokenization.dark} (100%) rename backend/testfiles/execution/stdlib/{string.dark => _string.dark} (100%) rename backend/testfiles/execution/stdlib/{tuple.dark => _tuple.dark} (100%) rename backend/testfiles/execution/stdlib/{uuid.dark => _uuid.dark} (100%) rename backend/testfiles/execution/stdlib/{x509.dark => _x509.dark} (100%) rename backend/testfiles/execution/stdlib/{int128.dark => ints/_int128.dark} (100%) rename backend/testfiles/execution/stdlib/{int16.dark => ints/_int16.dark} (100%) rename backend/testfiles/execution/stdlib/{int32.dark => ints/_int32.dark} (100%) rename backend/testfiles/execution/stdlib/{int64.dark => ints/_int64.dark} (100%) rename backend/testfiles/execution/stdlib/{int8.dark => ints/_int8.dark} (100%) rename backend/testfiles/execution/stdlib/{uint128.dark => ints/_uint128.dark} (100%) rename backend/testfiles/execution/stdlib/{uint16.dark => ints/_uint16.dark} (100%) rename backend/testfiles/execution/stdlib/{uint32.dark => ints/_uint32.dark} (100%) rename backend/testfiles/execution/stdlib/{uint64.dark => ints/_uint64.dark} (100%) rename backend/testfiles/execution/stdlib/{uint8.dark => ints/_uint8.dark} (100%) diff --git a/backend/src/LibCloud/Canvas.fs b/backend/src/LibCloud/Canvas.fs index 9735a28530..2eaad4b6a5 100644 --- a/backend/src/LibCloud/Canvas.fs +++ b/backend/src/LibCloud/Canvas.fs @@ -464,17 +464,18 @@ let healthCheck : LibService.Kubernetes.HealthCheck = let toProgram (c : T) : Ply = uply { - let dbs = - c.dbs - |> Map.values - |> List.map (fun db -> (db.name, PT2RT.DB.toRT db)) - |> Map.ofList + // let dbs = + // c.dbs + // |> Map.values + // |> List.map (fun db -> (db.name, PT2RT.DB.toRT db)) + // |> Map.ofList - let secrets = c.secrets |> Map.values |> List.map PT2RT.Secret.toRT + // let secrets = c.secrets |> Map.values |> List.map PT2RT.Secret.toRT return { canvasID = c.id internalFnsAllowed = List.contains c.id Config.allowedDarkInternalCanvasIDs - dbs = dbs - secrets = secrets } + //dbs = dbs + //secrets = secrets + } } diff --git a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs index 5a1b528849..e96b67aa46 100644 --- a/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs +++ b/backend/src/LibCloud/DvalReprInternalRoundtrippable.fs @@ -42,31 +42,37 @@ module FormatV0 = module KnownType = type KnownType = | KTUnit + | KTBool - | KTInt64 - | KTUInt64 + | KTInt8 | KTUInt8 | KTInt16 | KTUInt16 | KTInt32 | KTUInt32 + | KTInt64 + | KTUInt64 | KTInt128 | KTUInt128 + | KTFloat + | KTChar | KTString + | KTUuid + | KTDateTime - | KTList of ValueType | KTTuple of ValueType * ValueType * List + | KTList of ValueType | KTDict of ValueType - | KTFn of NEList * ValueType - | KTCustomType of FQTypeName.FQTypeName * typeArgs : List + | KTFn of NEList * ValueType + //| KTDB of ValueType let rec toRT (kt : KnownType) : RT.KnownType = @@ -168,28 +174,26 @@ module FormatV0 = type DvalMap = Map and Dval = - | DInt64 of int64 - | DUInt64 of uint64 + | DUnit + | DBool of bool | DInt8 of int8 | DUInt8 of uint8 | DInt16 of int16 | DUInt16 of uint16 | DInt32 of int32 | DUInt32 of uint32 + | DInt64 of int64 + | DUInt64 of uint64 | DInt128 of System.Int128 | DUInt128 of System.UInt128 | DFloat of double - | DBool of bool - | DUnit - | DString of string | DChar of string - | DList of ValueType.ValueType * List - | DTuple of Dval * Dval * List - | DLambda // See docs/dblock-serialization.md - | DDict of ValueType.ValueType * DvalMap - | DDB of string + | DString of string | DDateTime of NodaTime.LocalDateTime | DUuid of System.Guid + | DTuple of Dval * Dval * List + | DList of ValueType.ValueType * List + | DDict of ValueType.ValueType * DvalMap | DRecord of runtimeTypeName : FQTypeName.FQTypeName * sourceTypeName : FQTypeName.FQTypeName * @@ -201,40 +205,44 @@ module FormatV0 = typeArgs : List * caseName : string * fields : List + | DLambda // See docs/dblock-serialization.md + //| DDB of string let rec toRT (dv : Dval) : RT.Dval = match dv with - | DString s -> RT.DString s - | DChar c -> RT.DChar c - | DInt64 i -> RT.DInt64 i - | DUInt64 i -> RT.DUInt64 i + | DUnit -> RT.DUnit + + | DBool b -> RT.DBool b + | DInt8 i -> RT.DInt8 i | DUInt8 i -> RT.DUInt8 i | DInt16 i -> RT.DInt16 i | DUInt16 i -> RT.DUInt16 i | DInt32 i -> RT.DInt32 i | DUInt32 i -> RT.DUInt32 i + | DInt64 i -> RT.DInt64 i + | DUInt64 i -> RT.DUInt64 i | DInt128 i -> RT.DInt128 i | DUInt128 i -> RT.DUInt128 i - | DBool b -> RT.DBool b + | DFloat f -> RT.DFloat f - | DUnit -> RT.DUnit - | DLambda -> - RT.DFnVal( - RT.Lambda - { typeSymbolTable = Map [] - symtable = Map [] - parameters = NEList.singleton (RT.LPVariable(gid (), "var")) - body = RT.Expr.EUnit 0UL } - ) + + | DChar c -> RT.DChar c + | DString s -> RT.DString s + | DDateTime d -> RT.DDateTime d - | DDB name -> RT.DDB name + | DUuid uuid -> RT.DUuid uuid - | DList(typ, l) -> RT.DList(ValueType.toRT typ, List.map toRT l) + | DTuple(first, second, theRest) -> RT.DTuple(toRT first, toRT second, List.map toRT theRest) + + | DList(typ, l) -> RT.DList(ValueType.toRT typ, List.map toRT l) + | DDict(typ, entries) -> RT.DDict(ValueType.toRT typ, Map.map toRT entries) + + | DRecord(typeName, original, typeArgs, o) -> RT.DRecord( FQTypeName.toRT typeName, @@ -242,6 +250,7 @@ module FormatV0 = List.map ValueType.toRT typeArgs, Map.map toRT o ) + | DEnum(typeName, original, typeArgs, caseName, fields) -> RT.DEnum( FQTypeName.toRT typeName, @@ -251,33 +260,46 @@ module FormatV0 = List.map toRT fields ) + | DLambda -> + RT.DApplicable( + RT.AppLambda { exprId = gid (); closedRegisters = []; argsSoFar = [] } + ) + + //| DDB name -> RT.DDB name + let rec fromRT (dv : RT.Dval) : Dval = match dv with - | RT.DString s -> DString s - | RT.DChar c -> DChar c - | RT.DInt64 i -> DInt64 i - | RT.DUInt64 i -> DUInt64 i + | RT.DUnit -> DUnit + + | RT.DBool b -> DBool b + | RT.DInt8 i -> DInt8 i | RT.DUInt8 i -> DUInt8 i | RT.DInt16 i -> DInt16 i | RT.DUInt16 i -> DUInt16 i | RT.DInt32 i -> DInt32 i | RT.DUInt32 i -> DUInt32 i + | RT.DInt64 i -> DInt64 i + | RT.DUInt64 i -> DUInt64 i | RT.DInt128 i -> DInt128 i | RT.DUInt128 i -> DUInt128 i - | RT.DBool b -> DBool b + | RT.DFloat f -> DFloat f - | RT.DUnit -> DUnit - | RT.DFnVal _ -> DLambda + + | RT.DChar c -> DChar c + | RT.DString s -> DString s + | RT.DDateTime d -> DDateTime d - | RT.DDB name -> DDB name + | RT.DUuid uuid -> DUuid uuid - | RT.DList(typ, l) -> DList(ValueType.fromRT typ, List.map fromRT l) + | RT.DTuple(first, second, theRest) -> DTuple(fromRT first, fromRT second, List.map fromRT theRest) + | RT.DList(typ, l) -> DList(ValueType.fromRT typ, List.map fromRT l) | RT.DDict(typ, entries) -> DDict(ValueType.fromRT typ, Map.map fromRT entries) + | RT.DRecord(typeName, original, typeArgs, o) -> DRecord( FQTypeName.fromRT typeName, @@ -285,6 +307,7 @@ module FormatV0 = List.map ValueType.fromRT typeArgs, Map.map fromRT o ) + | RT.DEnum(typeName, original, typeArgs, caseName, fields) -> DEnum( FQTypeName.fromRT typeName, @@ -294,6 +317,10 @@ module FormatV0 = List.map fromRT fields ) + | RT.DApplicable _ -> DLambda + +// | RT.DDB name -> DDB name + let toJsonV0 (dv : RT.Dval) : string = dv |> FormatV0.fromRT |> Json.Vanilla.serialize @@ -333,8 +360,7 @@ module Test = | RT.DUuid _ | RT.DDateTime _ -> true - | RT.DEnum(_typeName, _, _typeArgsDEnumTODO, _caseName, fields) -> - List.all isRoundtrippableDval fields + | RT.DTuple(v1, v2, rest) -> List.all isRoundtrippableDval (v1 :: v2 :: rest) | RT.DList(_, dvals) -> List.all isRoundtrippableDval dvals @@ -342,8 +368,9 @@ module Test = | RT.DRecord(_, _, _, map) -> map |> Map.values |> List.all isRoundtrippableDval - | RT.DTuple(v1, v2, rest) -> List.all isRoundtrippableDval (v1 :: v2 :: rest) + | RT.DEnum(_typeName, _, _typeArgsDEnumTODO, _caseName, fields) -> + List.all isRoundtrippableDval fields - | RT.DDB _ -> true + | RT.DApplicable _ -> false // not supported - | RT.DFnVal _ -> false // not supported +//| RT.DDB _ -> true diff --git a/backend/src/LibCloud/LibCloud.fsproj b/backend/src/LibCloud/LibCloud.fsproj index ddf2be86a9..af1bbf9617 100644 --- a/backend/src/LibCloud/LibCloud.fsproj +++ b/backend/src/LibCloud/LibCloud.fsproj @@ -18,9 +18,13 @@ - - + + + + + + @@ -28,18 +32,16 @@ - - - + - + - - - - + + + + diff --git a/backend/src/LibCloud/TraceCloudStorage.fs b/backend/src/LibCloud/TraceCloudStorage.fs index 5a2a5fd290..601bd03267 100644 --- a/backend/src/LibCloud/TraceCloudStorage.fs +++ b/backend/src/LibCloud/TraceCloudStorage.fs @@ -249,20 +249,21 @@ let storeToCloudStorage (traceID : AT.TraceID.T) (touchedTLIDs : List) (inputVars : List) - (functionResults : Dictionary.T) + (_functionResults : Dictionary.T) : Task = task { let functionResults = - functionResults - |> Dictionary.toList - |> List.map (fun ((tlid, fnName, id, hash), (dval, _)) -> - // TODO do we really want to parse and unparse fnName? - tlid, - id, - RT.FQFnName.toString fnName, - LibExecution.DvalReprInternalHash.currentHashVersion, - hash, - Roundtrippable.fromRT dval) + // functionResults + // |> Dictionary.toList + // |> List.map (fun ((tlid, fnName, id, hash), (dval, _)) -> + // // TODO do we really want to parse and unparse fnName? + // tlid, + // id, + // RT.FQFnName.toString fnName, + // LibExecution.DvalReprInternalHash.currentHashVersion, + // hash, + // Roundtrippable.fromRT dval) + [] let inputVars = inputVars |> List.map (fun (name, dval) -> (name, Roundtrippable.fromRT dval)) diff --git a/backend/src/LibCloud/Tracing.fs b/backend/src/LibCloud/Tracing.fs index 70ea0e658d..cac2e03156 100644 --- a/backend/src/LibCloud/Tracing.fs +++ b/backend/src/LibCloud/Tracing.fs @@ -112,7 +112,7 @@ type T = storeTraceResults : unit -> unit /// The functions to run tracing during execution - executionTracing : RT.Tracing + executionTracing : RT.Tracing.Tracing /// Results of the execution results : TraceResults.T @@ -202,9 +202,10 @@ let createNonTracer (_canvasID : CanvasID) (_traceID : AT.TraceID.T) : T = { enabled = false results = results executionTracing = - LibExecution.Execution.noTracing ( - RT.CallStack.fromEntryPoint RT.ExecutionPoint.Script - ) + LibExecution.Execution.noTracing + // ( + // RT.CallStack.fromEntryPoint RT.ExecutionPoint.Script + // ) storeTraceResults = fun () -> () storeTraceInput = fun _ _ _ -> () } diff --git a/backend/src/LibExecution/DvalDecoder.fs b/backend/src/LibExecution/DvalDecoder.fs index a28908a073..59f17f920d 100644 --- a/backend/src/LibExecution/DvalDecoder.fs +++ b/backend/src/LibExecution/DvalDecoder.fs @@ -85,9 +85,6 @@ let string (dv : Dval) : string = | DString s -> s | _ -> f "string" dv - - - let tuple2 (dv : Dval) : Dval * Dval = match dv with | DTuple(first, second, _) -> (first, second) @@ -114,3 +111,4 @@ let field (name : string) (m : DvalMap) : Dval = match m |> Map.get name with | Some dv -> dv | None -> Exception.raiseInternal $"Expected '{name}' field" [] + diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 7d4a49311e..d5d9941fdf 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -222,17 +222,41 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | CopyVal(copyTo, copyFrom) -> registers[copyTo] <- registers[copyFrom] | Or(createTo, left, right) -> - match registers[left], registers[right] with - | DBool l, DBool r -> registers[createTo] <- DBool(l || r) - | l, r -> + // match registers[left], registers[right] with + // | DBool l, DBool r -> registers[createTo] <- DBool(l || r) + // | l, r -> + // RTE.Bools.OrOnlySupportsBooleans(Dval.toValueType l, Dval.toValueType r) + // |> RTE.Bool + // |> raiseRTE + match registers[left] with + | DBool true -> registers[createTo] <- DBool true + | DBool false -> + match registers[right] with + | DBool true -> registers[createTo] <- DBool true + | DBool false -> registers[createTo] <- DBool false + | r -> + RTE.Bools.OrOnlySupportsBooleans(VT.bool, Dval.toValueType r) + |> RTE.Bool + |> raiseRTE + | l -> + let r = registers[right] RTE.Bools.OrOnlySupportsBooleans(Dval.toValueType l, Dval.toValueType r) |> RTE.Bool |> raiseRTE | And(createTo, left, right) -> - match registers[left], registers[right] with - | DBool l, DBool r -> registers[createTo] <- DBool(l && r) - | l, r -> + match registers[left] with + | DBool false -> registers[createTo] <- DBool false + | DBool true -> + match registers[right] with + | DBool true -> registers[createTo] <- DBool true + | DBool false -> registers[createTo] <- DBool false + | r -> + RTE.Bools.AndOnlySupportsBooleans(VT.bool, Dval.toValueType r) + |> RTE.Bool + |> raiseRTE + | l -> + let r = registers[right] RTE.Bools.AndOnlySupportsBooleans(Dval.toValueType l, Dval.toValueType r) |> RTE.Bool |> raiseRTE diff --git a/backend/src/LibExecution/PackageIDs.fs b/backend/src/LibExecution/PackageIDs.fs index ccb293cc7c..e801b4b2e3 100644 --- a/backend/src/LibExecution/PackageIDs.fs +++ b/backend/src/LibExecution/PackageIDs.fs @@ -127,9 +127,9 @@ module Type = let private p addl = p ("Lists" :: addl) let error = p [] "Error" "f327ad98-ec15-4cfe-bcfe-6f0f5a444349" - // module Error = - // let errorMessage = - // p [ "Error" ] "ErrorMessage" "3e526964-304f-46a8-919c-6d65bb6ff167" + module Error = + let errorMessage = + p [ "Error" ] "ErrorMessage" "3e526964-304f-46a8-919c-6d65bb6ff167" module NameResolution = let private p addl = p ("NameResolution" :: addl) diff --git a/backend/testfiles/execution/cloud/db.dark b/backend/testfiles/execution/cloud/_db.dark similarity index 100% rename from backend/testfiles/execution/cloud/db.dark rename to backend/testfiles/execution/cloud/_db.dark diff --git a/backend/testfiles/execution/cloud/_events.dark b/backend/testfiles/execution/cloud/_events.dark index 6f7f8d8718..6ffa83a3e0 100644 --- a/backend/testfiles/execution/cloud/_events.dark +++ b/backend/testfiles/execution/cloud/_events.dark @@ -17,5 +17,5 @@ Builtin.testGetQueue_v0 "TestWorker" = [] let _ = Builtin.emit (FruitRecord { fruits = [ "apple"; "banana" ] }) "TestWorker" let queue = Builtin.testGetQueue_v0 "TestWorker" Stdlib.List.sort queue) = [ "\"value\"" - "1" - "FruitRecord {\n fruits: [\n \"apple\", \"banana\"\n ]\n}" ] \ No newline at end of file + "1" + "FruitRecord {\n fruits: [\n \"apple\", \"banana\"\n ]\n}" ] \ No newline at end of file diff --git a/backend/testfiles/execution/cloud/internal.dark b/backend/testfiles/execution/cloud/_internal.dark similarity index 100% rename from backend/testfiles/execution/cloud/internal.dark rename to backend/testfiles/execution/cloud/_internal.dark diff --git a/backend/testfiles/execution/language/big.dark b/backend/testfiles/execution/language/_big.dark similarity index 100% rename from backend/testfiles/execution/language/big.dark rename to backend/testfiles/execution/language/_big.dark diff --git a/backend/testfiles/execution/language/derror.dark b/backend/testfiles/execution/language/_derror.dark similarity index 100% rename from backend/testfiles/execution/language/derror.dark rename to backend/testfiles/execution/language/_derror.dark diff --git a/backend/testfiles/execution/language/elambda.dark b/backend/testfiles/execution/language/_elambda.dark similarity index 100% rename from backend/testfiles/execution/language/elambda.dark rename to backend/testfiles/execution/language/_elambda.dark diff --git a/backend/testfiles/execution/language/interpreter.dark b/backend/testfiles/execution/language/_interpreter.dark similarity index 100% rename from backend/testfiles/execution/language/interpreter.dark rename to backend/testfiles/execution/language/_interpreter.dark diff --git a/backend/testfiles/execution/language/eapply.dark b/backend/testfiles/execution/language/apply/_eapply.dark similarity index 100% rename from backend/testfiles/execution/language/eapply.dark rename to backend/testfiles/execution/language/apply/_eapply.dark diff --git a/backend/testfiles/execution/language/einfix.dark b/backend/testfiles/execution/language/apply/_einfix.dark similarity index 100% rename from backend/testfiles/execution/language/einfix.dark rename to backend/testfiles/execution/language/apply/_einfix.dark diff --git a/backend/testfiles/execution/language/evariable.dark b/backend/testfiles/execution/language/basic/_evariable.dark similarity index 100% rename from backend/testfiles/execution/language/evariable.dark rename to backend/testfiles/execution/language/basic/_evariable.dark diff --git a/backend/testfiles/execution/language/dfloat.dark b/backend/testfiles/execution/language/basic/dfloat.dark similarity index 100% rename from backend/testfiles/execution/language/dfloat.dark rename to backend/testfiles/execution/language/basic/dfloat.dark diff --git a/backend/testfiles/execution/language/basic/eand.dark b/backend/testfiles/execution/language/basic/eand.dark new file mode 100644 index 0000000000..75a3550984 --- /dev/null +++ b/backend/testfiles/execution/language/basic/eand.dark @@ -0,0 +1,17 @@ +(true && true) = true +(true && false) = false +(false && true) = false +(false && false) = false +// (true && Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage "msg" +// (true && 5L) = Builtin.testDerrorMessage "&& only supports Booleans" +// (false && Builtin.testRuntimeError "msg") = false +(false && 5L) = false + +// (Builtin.testRuntimeError "msg" && Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage +// "msg" + +// (5 && true) = Builtin.testDerrorMessage "&& only supports Booleans" +(true |> (&&) true) = true +(true |> (&&) false) = false +(false |> (&&) true) = false +(false |> (&&) false) = false \ No newline at end of file diff --git a/backend/testfiles/execution/language/basic/elet.dark b/backend/testfiles/execution/language/basic/elet.dark new file mode 100644 index 0000000000..22e389fb85 --- /dev/null +++ b/backend/testfiles/execution/language/basic/elet.dark @@ -0,0 +1,92 @@ +// (let x = Builtin.testRuntimeError "a" in 5L) = Builtin.testDerrorMessage "a" + +// (let x = Builtin.testRuntimeError "a" in Builtin.testRuntimeError "b") = Builtin.testDerrorMessage +// "a" + +module Variables = + (let x = 5L in x) = 5L + +module Unit = + (let () = Stdlib.Tuple2.first ((), 5L) in 5L) = 5L + +module Tuples = + (let (a, b) = (1L, 2L) in 2L) = 2L + (let (a, b) = (1L, 2L) in b) = 2L + (let (a, b) = (1L, 2L) in (b, a)) = (2L, 1L) + (let (d, d) = (2L, 1L) in d) = 1L + (let (_, _) = (1L, 2L) in 2L) = 2L + + (let (a, b, c) = (1L, 2L, 3L) in b) = 2L + (let (a, b, c) = (1L, 2L, 3L) in (b, a)) = (2L, 1L) + (let (d, d, d) = (2L, 1L, 3L) in d) = 3L + (let (_, _, _) = (1L, 2L, 3L) in 2L) = 2L + + // (let (_, _, _) = (1L, 2L, Builtin.testRuntimeError "test") in 2L) = Builtin.testDerrorMessage + // "test" + + // (let (_, _, _) = + // (Builtin.testRuntimeError "test1", 2L, Builtin.testRuntimeError "test2") + + // 2L) = Builtin.testDerrorMessage "test1" + + // With multiple levels of nested destructuring + (let ((a, ((b, (c, d)), e)), f) = ((1L, ((2L, (3L, 4L)), 5L)), 6L) in c) = 3L + (let ((a, ((b, cd), e)), f) = ((1L, ((2L, (3L, 4L)), 5L)), 6L) in cd) = (3L, 4L) + + +module Nesting = + (let x = + let y = 1L + let z = 2L + y + z + + x) = 3L + + +module Shadowing = + (let x = 5L + let x = 6L + x) = 6L + + + (let x = 35L + + match 6L with + | x -> x) = 6L + + + (let x = 35L + + match Stdlib.Result.Result.Ok 6L with + | Ok x -> x) = 6L + + + (let x = 35L in Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L)) = [ 3L + 4L + 5L + 6L ] + + + // (let x = 35L + + // match Stdlib.Result.Result.Ok 6L with + // | Ok x -> (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L))) = [ 3L + // 4L + // 5L + // 6L ] + + + // (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> + // (let x = 35L + + // match Stdlib.Result.Result.Ok 6L with + // | Ok x -> x + 2L))) = [ 8L; 8L; 8L; 8L ] + + + // (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> + // match Stdlib.Result.Result.Ok 6L with + // | Ok x -> let x = 9L in x + 2L)) = [ 11L; 11L; 11L; 11L ] + + // (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> + // (match Stdlib.Result.Result.Ok(Stdlib.Result.Result.Ok 6L) with + // | Ok(Ok x) -> let x = 9L in x + 2L))) = [ 11L; 11L; 11L; 11L ] \ No newline at end of file diff --git a/backend/testfiles/execution/language/basic/eor.dark b/backend/testfiles/execution/language/basic/eor.dark new file mode 100644 index 0000000000..3221eb8ee1 --- /dev/null +++ b/backend/testfiles/execution/language/basic/eor.dark @@ -0,0 +1,17 @@ +(true || true) = true +(true || false) = true +(false || true) = true +(false || false) = false +// (true || Builtin.testRuntimeError "msg") = true +(true || 5L) = true +// (false || Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage "msg" +// (false || 5L) = Builtin.testDerrorMessage "|| only supports Booleans" + +// (Builtin.testRuntimeError "msg1" || Builtin.testRuntimeError "msg2") = Builtin.testDerrorMessage +// "msg1" + +// (5L || true) = Builtin.testDerrorMessage "|| only supports Booleans" +(true |> (||) true) = true +(true |> (||) false) = true +(false |> (||) true) = true +(false |> (||) false) = false \ No newline at end of file diff --git a/backend/testfiles/execution/language/basic/estring.dark b/backend/testfiles/execution/language/basic/estring.dark new file mode 100644 index 0000000000..40ce483e25 --- /dev/null +++ b/backend/testfiles/execution/language/basic/estring.dark @@ -0,0 +1,18 @@ +$"""test {"1"}""" = "test 1" + +(let one = "1" in $"test {one}") = "test 1" + +// (let one = 1.0 in $"test {one}") = Builtin.testDerrorMessage +// "Expected String in string interpolation, got 1.0" + +// (let one = 1L in $"test {one}") = Builtin.testDerrorMessage +// "Expected String in string interpolation, got 1" + +(let name = "John" + let age = "30" + $"Name: {name}, Age: {age} years old.") = "Name: John, Age: 30 years old." + +// (let two = 2L in "test 1" == $"test {one}") = Builtin.testDerrorMessage +// "There is no variable named: one" + +(let one = 1L in $"test {Stdlib.Int64.toString one}") = "test 1" \ No newline at end of file diff --git a/backend/testfiles/execution/language/dlist.dark b/backend/testfiles/execution/language/collections/_dlist.dark similarity index 100% rename from backend/testfiles/execution/language/dlist.dark rename to backend/testfiles/execution/language/collections/_dlist.dark diff --git a/backend/testfiles/execution/language/dtuple.dark b/backend/testfiles/execution/language/collections/_dtuple.dark similarity index 100% rename from backend/testfiles/execution/language/dtuple.dark rename to backend/testfiles/execution/language/collections/_dtuple.dark diff --git a/backend/testfiles/execution/language/edict.dark b/backend/testfiles/execution/language/collections/_edict.dark similarity index 100% rename from backend/testfiles/execution/language/edict.dark rename to backend/testfiles/execution/language/collections/_edict.dark diff --git a/backend/testfiles/execution/language/econstant.dark b/backend/testfiles/execution/language/custom-data/_econstant.dark similarity index 100% rename from backend/testfiles/execution/language/econstant.dark rename to backend/testfiles/execution/language/custom-data/_econstant.dark diff --git a/backend/testfiles/execution/language/efieldaccess.dark b/backend/testfiles/execution/language/custom-data/_efieldaccess.dark similarity index 100% rename from backend/testfiles/execution/language/efieldaccess.dark rename to backend/testfiles/execution/language/custom-data/_efieldaccess.dark diff --git a/backend/testfiles/execution/language/type-alias.dark b/backend/testfiles/execution/language/custom-data/_type-alias.dark similarity index 100% rename from backend/testfiles/execution/language/type-alias.dark rename to backend/testfiles/execution/language/custom-data/_type-alias.dark diff --git a/backend/testfiles/execution/language/type-enum.dark b/backend/testfiles/execution/language/custom-data/_type-enum.dark similarity index 100% rename from backend/testfiles/execution/language/type-enum.dark rename to backend/testfiles/execution/language/custom-data/_type-enum.dark diff --git a/backend/testfiles/execution/language/type-record.dark b/backend/testfiles/execution/language/custom-data/_type-record.dark similarity index 100% rename from backend/testfiles/execution/language/type-record.dark rename to backend/testfiles/execution/language/custom-data/_type-record.dark diff --git a/backend/testfiles/execution/language/eand.dark b/backend/testfiles/execution/language/eand.dark deleted file mode 100644 index 2680f6087e..0000000000 --- a/backend/testfiles/execution/language/eand.dark +++ /dev/null @@ -1,17 +0,0 @@ -(true && true) = true -(true && false) = false -(false && true) = false -(false && false) = false -(true && Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage "msg" -(true && 5L) = Builtin.testDerrorMessage "&& only supports Booleans" -(false && Builtin.testRuntimeError "msg") = false -(false && 5L) = false - -(Builtin.testRuntimeError "msg" && Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage - "msg" - -(5 && true) = Builtin.testDerrorMessage "&& only supports Booleans" -(true |> (&&) true) = true -(true |> (&&) false) = false -(false |> (&&) true) = false -(false |> (&&) false) = false \ No newline at end of file diff --git a/backend/testfiles/execution/language/elet.dark b/backend/testfiles/execution/language/elet.dark deleted file mode 100644 index 57ef6879ed..0000000000 --- a/backend/testfiles/execution/language/elet.dark +++ /dev/null @@ -1,92 +0,0 @@ -(let x = Builtin.testRuntimeError "a" in 5L) = Builtin.testDerrorMessage "a" - -(let x = Builtin.testRuntimeError "a" in Builtin.testRuntimeError "b") = Builtin.testDerrorMessage - "a" - -module Variables = - (let x = 5L in x) = 5L - -module Unit = - (let () = Stdlib.Tuple2.first ((), 5L) in 5L) = 5L - -module Tuples = - (let (a, b) = (1L, 2L) in 2L) = 2L - (let (a, b) = (1L, 2L) in b) = 2L - (let (a, b) = (1L, 2L) in (b, a)) = (2L, 1L) - (let (d, d) = (2L, 1L) in d) = 1L - (let (_, _) = (1L, 2L) in 2L) = 2L - - (let (a, b, c) = (1L, 2L, 3L) in b) = 2L - (let (a, b, c) = (1L, 2L, 3L) in (b, a)) = (2L, 1L) - (let (d, d, d) = (2L, 1L, 3L) in d) = 3L - (let (_, _, _) = (1L, 2L, 3L) in 2L) = 2L - - (let (_, _, _) = (1L, 2L, Builtin.testRuntimeError "test") in 2L) = Builtin.testDerrorMessage - "test" - - (let (_, _, _) = - (Builtin.testRuntimeError "test1", 2L, Builtin.testRuntimeError "test2") - - 2L) = Builtin.testDerrorMessage "test1" - - // With multiple levels of nested destructuring - (let ((a, ((b, (c, d)), e)), f) = ((1L, ((2L, (3L, 4L)), 5L)), 6L) in c) = 3L - (let ((a, ((b, cd), e)), f) = ((1L, ((2L, (3L, 4L)), 5L)), 6L) in cd) = (3L, 4L) - - -module Nesting = - (let x = - let y = 1L - let z = 2L - y + z - - x) = 3L - - -module Shadowing = - (let x = 5L - let x = 6L - x) = 6L - - - (let x = 35L - - match 6L with - | x -> x) = 6L - - - (let x = 35L - - match Stdlib.Result.Result.Ok 6L with - | Ok x -> x) = 6L - - - (let x = 35L in Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L)) = [ 3L - 4L - 5L - 6L ] - - - (let x = 35L - - match Stdlib.Result.Result.Ok 6L with - | Ok x -> (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L))) = [ 3L - 4L - 5L - 6L ] - - - (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> - (let x = 35L - - match Stdlib.Result.Result.Ok 6L with - | Ok x -> x + 2L))) = [ 8L; 8L; 8L; 8L ] - - - (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> - match Stdlib.Result.Result.Ok 6L with - | Ok x -> let x = 9L in x + 2L)) = [ 11L; 11L; 11L; 11L ] - - (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> - (match Stdlib.Result.Result.Ok(Stdlib.Result.Result.Ok 6L) with - | Ok(Ok x) -> let x = 9L in x + 2L))) = [ 11L; 11L; 11L; 11L ] \ No newline at end of file diff --git a/backend/testfiles/execution/language/eor.dark b/backend/testfiles/execution/language/eor.dark deleted file mode 100644 index 07638dab40..0000000000 --- a/backend/testfiles/execution/language/eor.dark +++ /dev/null @@ -1,17 +0,0 @@ -(true || true) = true -(true || false) = true -(false || true) = true -(false || false) = false -(true || Builtin.testRuntimeError "msg") = true -(true || 5L) = true -(false || Builtin.testRuntimeError "msg") = Builtin.testDerrorMessage "msg" -(false || 5L) = Builtin.testDerrorMessage "|| only supports Booleans" - -(Builtin.testRuntimeError "msg1" || Builtin.testRuntimeError "msg2") = Builtin.testDerrorMessage - "msg1" - -(5L || true) = Builtin.testDerrorMessage "|| only supports Booleans" -(true |> (||) true) = true -(true |> (||) false) = true -(false |> (||) true) = true -(false |> (||) false) = false \ No newline at end of file diff --git a/backend/testfiles/execution/language/estring.dark b/backend/testfiles/execution/language/estring.dark deleted file mode 100644 index aa89aca3f6..0000000000 --- a/backend/testfiles/execution/language/estring.dark +++ /dev/null @@ -1,18 +0,0 @@ -$"""test {"1"}""" = "test 1" - -(let one = "1" in $"test {one}") = "test 1" - -(let one = 1.0 in $"test {one}") = Builtin.testDerrorMessage - "Expected String in string interpolation, got 1.0" - -(let one = 1L in $"test {one}") = Builtin.testDerrorMessage - "Expected String in string interpolation, got 1" - -(let name = "John" - let age = "30" - $"Name: {name}, Age: {age} years old.") = "Name: John, Age: 30 years old." - -(let two = 2L in "test 1" == $"test {one}") = Builtin.testDerrorMessage - "There is no variable named: one" - -(let one = 1L in $"test {Stdlib.Int64.toString one}") = "test 1" \ No newline at end of file diff --git a/backend/testfiles/execution/language/eif.dark b/backend/testfiles/execution/language/flow-control/_eif.dark similarity index 100% rename from backend/testfiles/execution/language/eif.dark rename to backend/testfiles/execution/language/flow-control/_eif.dark diff --git a/backend/testfiles/execution/language/ematch.dark b/backend/testfiles/execution/language/flow-control/_ematch.dark similarity index 100% rename from backend/testfiles/execution/language/ematch.dark rename to backend/testfiles/execution/language/flow-control/_ematch.dark diff --git a/backend/testfiles/execution/language/epipe.dark b/backend/testfiles/execution/language/flow-control/_epipe.dark similarity index 100% rename from backend/testfiles/execution/language/epipe.dark rename to backend/testfiles/execution/language/flow-control/_epipe.dark diff --git a/backend/testfiles/execution/stdlib/alt-json.dark b/backend/testfiles/execution/stdlib/_alt-json.dark similarity index 100% rename from backend/testfiles/execution/stdlib/alt-json.dark rename to backend/testfiles/execution/stdlib/_alt-json.dark diff --git a/backend/testfiles/execution/stdlib/base64.dark b/backend/testfiles/execution/stdlib/_base64.dark similarity index 100% rename from backend/testfiles/execution/stdlib/base64.dark rename to backend/testfiles/execution/stdlib/_base64.dark diff --git a/backend/testfiles/execution/stdlib/bool.dark b/backend/testfiles/execution/stdlib/_bool.dark similarity index 100% rename from backend/testfiles/execution/stdlib/bool.dark rename to backend/testfiles/execution/stdlib/_bool.dark diff --git a/backend/testfiles/execution/stdlib/bytes.dark b/backend/testfiles/execution/stdlib/_bytes.dark similarity index 100% rename from backend/testfiles/execution/stdlib/bytes.dark rename to backend/testfiles/execution/stdlib/_bytes.dark diff --git a/backend/testfiles/execution/stdlib/char.dark b/backend/testfiles/execution/stdlib/_char.dark similarity index 100% rename from backend/testfiles/execution/stdlib/char.dark rename to backend/testfiles/execution/stdlib/_char.dark diff --git a/backend/testfiles/execution/stdlib/crypto.dark b/backend/testfiles/execution/stdlib/_crypto.dark similarity index 100% rename from backend/testfiles/execution/stdlib/crypto.dark rename to backend/testfiles/execution/stdlib/_crypto.dark diff --git a/backend/testfiles/execution/stdlib/date.dark b/backend/testfiles/execution/stdlib/_date.dark similarity index 100% rename from backend/testfiles/execution/stdlib/date.dark rename to backend/testfiles/execution/stdlib/_date.dark diff --git a/backend/testfiles/execution/stdlib/dict.dark b/backend/testfiles/execution/stdlib/_dict.dark similarity index 100% rename from backend/testfiles/execution/stdlib/dict.dark rename to backend/testfiles/execution/stdlib/_dict.dark diff --git a/backend/testfiles/execution/stdlib/float.dark b/backend/testfiles/execution/stdlib/_float.dark similarity index 100% rename from backend/testfiles/execution/stdlib/float.dark rename to backend/testfiles/execution/stdlib/_float.dark diff --git a/backend/testfiles/execution/stdlib/html.dark b/backend/testfiles/execution/stdlib/_html.dark similarity index 100% rename from backend/testfiles/execution/stdlib/html.dark rename to backend/testfiles/execution/stdlib/_html.dark diff --git a/backend/testfiles/execution/stdlib/http.dark b/backend/testfiles/execution/stdlib/_http.dark similarity index 100% rename from backend/testfiles/execution/stdlib/http.dark rename to backend/testfiles/execution/stdlib/_http.dark diff --git a/backend/testfiles/execution/stdlib/httpclient.dark b/backend/testfiles/execution/stdlib/_httpclient.dark similarity index 100% rename from backend/testfiles/execution/stdlib/httpclient.dark rename to backend/testfiles/execution/stdlib/_httpclient.dark diff --git a/backend/testfiles/execution/stdlib/json.dark b/backend/testfiles/execution/stdlib/_json.dark similarity index 100% rename from backend/testfiles/execution/stdlib/json.dark rename to backend/testfiles/execution/stdlib/_json.dark diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/_list.dark similarity index 100% rename from backend/testfiles/execution/stdlib/list.dark rename to backend/testfiles/execution/stdlib/_list.dark diff --git a/backend/testfiles/execution/stdlib/math.dark b/backend/testfiles/execution/stdlib/_math.dark similarity index 100% rename from backend/testfiles/execution/stdlib/math.dark rename to backend/testfiles/execution/stdlib/_math.dark diff --git a/backend/testfiles/execution/stdlib/nomodule.dark b/backend/testfiles/execution/stdlib/_nomodule.dark similarity index 100% rename from backend/testfiles/execution/stdlib/nomodule.dark rename to backend/testfiles/execution/stdlib/_nomodule.dark diff --git a/backend/testfiles/execution/stdlib/option.dark b/backend/testfiles/execution/stdlib/_option.dark similarity index 100% rename from backend/testfiles/execution/stdlib/option.dark rename to backend/testfiles/execution/stdlib/_option.dark diff --git a/backend/testfiles/execution/stdlib/parser.dark b/backend/testfiles/execution/stdlib/_parser.dark similarity index 100% rename from backend/testfiles/execution/stdlib/parser.dark rename to backend/testfiles/execution/stdlib/_parser.dark diff --git a/backend/testfiles/execution/stdlib/result.dark b/backend/testfiles/execution/stdlib/_result.dark similarity index 100% rename from backend/testfiles/execution/stdlib/result.dark rename to backend/testfiles/execution/stdlib/_result.dark diff --git a/backend/testfiles/execution/stdlib/semanticTokenization.dark b/backend/testfiles/execution/stdlib/_semanticTokenization.dark similarity index 100% rename from backend/testfiles/execution/stdlib/semanticTokenization.dark rename to backend/testfiles/execution/stdlib/_semanticTokenization.dark diff --git a/backend/testfiles/execution/stdlib/string.dark b/backend/testfiles/execution/stdlib/_string.dark similarity index 100% rename from backend/testfiles/execution/stdlib/string.dark rename to backend/testfiles/execution/stdlib/_string.dark diff --git a/backend/testfiles/execution/stdlib/tuple.dark b/backend/testfiles/execution/stdlib/_tuple.dark similarity index 100% rename from backend/testfiles/execution/stdlib/tuple.dark rename to backend/testfiles/execution/stdlib/_tuple.dark diff --git a/backend/testfiles/execution/stdlib/uuid.dark b/backend/testfiles/execution/stdlib/_uuid.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uuid.dark rename to backend/testfiles/execution/stdlib/_uuid.dark diff --git a/backend/testfiles/execution/stdlib/x509.dark b/backend/testfiles/execution/stdlib/_x509.dark similarity index 100% rename from backend/testfiles/execution/stdlib/x509.dark rename to backend/testfiles/execution/stdlib/_x509.dark diff --git a/backend/testfiles/execution/stdlib/int128.dark b/backend/testfiles/execution/stdlib/ints/_int128.dark similarity index 100% rename from backend/testfiles/execution/stdlib/int128.dark rename to backend/testfiles/execution/stdlib/ints/_int128.dark diff --git a/backend/testfiles/execution/stdlib/int16.dark b/backend/testfiles/execution/stdlib/ints/_int16.dark similarity index 100% rename from backend/testfiles/execution/stdlib/int16.dark rename to backend/testfiles/execution/stdlib/ints/_int16.dark diff --git a/backend/testfiles/execution/stdlib/int32.dark b/backend/testfiles/execution/stdlib/ints/_int32.dark similarity index 100% rename from backend/testfiles/execution/stdlib/int32.dark rename to backend/testfiles/execution/stdlib/ints/_int32.dark diff --git a/backend/testfiles/execution/stdlib/int64.dark b/backend/testfiles/execution/stdlib/ints/_int64.dark similarity index 100% rename from backend/testfiles/execution/stdlib/int64.dark rename to backend/testfiles/execution/stdlib/ints/_int64.dark diff --git a/backend/testfiles/execution/stdlib/int8.dark b/backend/testfiles/execution/stdlib/ints/_int8.dark similarity index 100% rename from backend/testfiles/execution/stdlib/int8.dark rename to backend/testfiles/execution/stdlib/ints/_int8.dark diff --git a/backend/testfiles/execution/stdlib/uint128.dark b/backend/testfiles/execution/stdlib/ints/_uint128.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uint128.dark rename to backend/testfiles/execution/stdlib/ints/_uint128.dark diff --git a/backend/testfiles/execution/stdlib/uint16.dark b/backend/testfiles/execution/stdlib/ints/_uint16.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uint16.dark rename to backend/testfiles/execution/stdlib/ints/_uint16.dark diff --git a/backend/testfiles/execution/stdlib/uint32.dark b/backend/testfiles/execution/stdlib/ints/_uint32.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uint32.dark rename to backend/testfiles/execution/stdlib/ints/_uint32.dark diff --git a/backend/testfiles/execution/stdlib/uint64.dark b/backend/testfiles/execution/stdlib/ints/_uint64.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uint64.dark rename to backend/testfiles/execution/stdlib/ints/_uint64.dark diff --git a/backend/testfiles/execution/stdlib/uint8.dark b/backend/testfiles/execution/stdlib/ints/_uint8.dark similarity index 100% rename from backend/testfiles/execution/stdlib/uint8.dark rename to backend/testfiles/execution/stdlib/ints/_uint8.dark diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index f3df406eb0..5525b4aefc 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -6,8 +6,8 @@ module TestUtils.LibTest open System.Threading.Tasks open FSharp.Control.Tasks -// open Npgsql.FSharp -// open Npgsql +open Npgsql.FSharp +open Npgsql open Prelude open LibExecution.RuntimeTypes @@ -19,11 +19,11 @@ module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs -//open LibCloud.Db +open LibCloud.Db -// let varA = TVariable "a" -//let varB = TVariable "b" +let varA = TVariable "a" +let varB = TVariable "b" let constants : List = @@ -47,29 +47,29 @@ let constants : List = let fns : List = [ - // { name = fn "testDerrorMessage" 0 - // typeParams = [] - // parameters = [ Param.make "errorMessage" TString "" ] - // returnType = - // TCustomType( - // Ok( - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // ), - // [] - // ) - // description = "Return a value representing a runtime type error" - // fn = - // (function - // | _, _, [ DString error ] -> - // let typeName = - // FQTypeName.Package - // PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage - // DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "testDerrorMessage" 0 + typeParams = [] + parameters = [ Param.make "errorMessage" TString "" ] + returnType = + TCustomType( + Ok( + FQTypeName.Package + PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + ), + [] + ) + description = "Return a value representing a runtime type error" + fn = + (function + | _, _, _, [ DString error ] -> + let typeName = + FQTypeName.Package + PackageIDs.Type.LanguageTools.RuntimeError.Error.errorMessage + DEnum(typeName, typeName, [], "ErrorString", [ DString error ]) |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } // // CLEANUP consider renaming to `oldError` or something more clear // { name = fn "testRuntimeError" 0 @@ -86,6 +86,7 @@ let fns : List = // previewable = Pure // deprecated = NotDeprecated } + // { name = fn "testDerrorSqlMessage" 0 // typeParams = [] // parameters = [ Param.make "errorString" TString "" ] @@ -111,100 +112,100 @@ let fns : List = // previewable = Pure // deprecated = NotDeprecated } - // { name = fn "testToChar" 0 - // typeParams = [] - // parameters = [ Param.make "c" TString "" ] - // returnType = TypeReference.option TChar - // description = "Turns a string of length 1 into a character" - // fn = - // (function - // | _, _, [ DString s ] -> - // let chars = String.toEgcSeq s - - // if Seq.length chars = 1 then - // chars - // |> Seq.toList - // |> (fun l -> l[0]) - // |> DChar - // |> Dval.optionSome KTChar - // |> Ply - // else - // Dval.optionNone KTChar |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testIncrementSideEffectCounter" 0 - // typeParams = [] - // parameters = - // [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] - // returnType = TVariable "a" - // description = - // "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." - // fn = - // (function - // | state, _, [ arg ] -> - // state.test.sideEffectCount <- state.test.sideEffectCount + 1 - // Ply(arg) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testSideEffectCount" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = TInt64 - // description = "Return the value of the side-effect counter" - // fn = - // (function - // | state, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testInspect" 0 - // typeParams = [] - // parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] - // returnType = varA - // description = "Prints the value into stdout" - // fn = - // (function - // | _, _, [ v; DString msg ] -> - // print $"{msg}: {v}" - // Ply v - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testDeleteUser" 0 - // typeParams = [] - // parameters = [ Param.make "username" TString "" ] - // returnType = TypeReference.result TUnit varB - // description = "Delete a user (test only)" - // fn = - // (function - // | _, _, [ DString username ] -> - // uply { - // do! - // // This is unsafe. A user has canvases, and canvases have traces. It - // // will either break or cascade (haven't checked) - // Sql.query "DELETE FROM accounts_v0 WHERE username = @username" - // |> Sql.parameters [ "username", Sql.string (string username) ] - // |> Sql.executeStatementAsync - // return DUnit - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "testToChar" 0 + typeParams = [] + parameters = [ Param.make "c" TString "" ] + returnType = TypeReference.option TChar + description = "Turns a string of length 1 into a character" + fn = + (function + | _, _, _, [ DString s ] -> + let chars = String.toEgcSeq s + + if Seq.length chars = 1 then + chars + |> Seq.toList + |> (fun l -> l[0]) + |> DChar + |> Dval.optionSome KTChar + |> Ply + else + Dval.optionNone KTChar |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testIncrementSideEffectCounter" 0 + typeParams = [] + parameters = + [ Param.make "passThru" (TVariable "a") "Ply which will be returned" ] + returnType = TVariable "a" + description = + "Increases the side effect counter by one, to test real-world side-effects. Returns its argument." + fn = + (function + | state, _, _, [ arg ] -> + state.test.sideEffectCount <- state.test.sideEffectCount + 1 + Ply(arg) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testSideEffectCount" 0 + typeParams = [] + parameters = [ Param.make "unit" TUnit "" ] + returnType = TInt64 + description = "Return the value of the side-effect counter" + fn = + (function + | state, _, _, [ DUnit ] -> Ply(Dval.int64 state.test.sideEffectCount) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testInspect" 0 + typeParams = [] + parameters = [ Param.make "var" varA ""; Param.make "msg" TString "" ] + returnType = varA + description = "Prints the value into stdout" + fn = + (function + | _, _, _, [ v; DString msg ] -> + print $"{msg}: {v}" + Ply v + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testDeleteUser" 0 + typeParams = [] + parameters = [ Param.make "username" TString "" ] + returnType = TypeReference.result TUnit varB + description = "Delete a user (test only)" + fn = + (function + | _, _, _, [ DString username ] -> + uply { + do! + // This is unsafe. A user has canvases, and canvases have traces. It + // will either break or cascade (haven't checked) + Sql.query "DELETE FROM accounts_v0 WHERE username = @username" + |> Sql.parameters [ "username", Sql.string (string username) ] + |> Sql.executeStatementAsync + return DUnit + } + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } // { name = fn "testGetQueue" 0 @@ -214,7 +215,7 @@ let fns : List = // description = "Fetch a queue (test only)" // fn = // (function - // | state, _, [ DString eventName ] -> + // | state, _, _, [ DString eventName ] -> // uply { // let canvasID = state.program.canvasID // let! results = @@ -231,50 +232,50 @@ let fns : List = // deprecated = NotDeprecated } - // { name = fn "testRaiseException" 0 - // typeParams = [] - // parameters = [ Param.make "message" TString "" ] - // returnType = TVariable "a" - // description = "A function that raises an F# exception" - // fn = - // (function - // | _, _, [ DString message ] -> raise (System.Exception(message)) - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testGetCanvasID" 0 - // typeParams = [] - // parameters = [ Param.make "unit" TUnit "" ] - // returnType = TUuid - // description = "Get the name of the canvas that's running" - // fn = - // (function - // | state, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } - - - // { name = fn "testSetExpectedExceptionCount" 0 - // typeParams = [] - // parameters = [ Param.make "count" TInt64 "" ] - // returnType = TUnit - // description = "Set the expected exception count for the current test" - // fn = - // (function - // | state, _, [ DInt64 count ] -> - // uply { - // state.test.expectedExceptionCount <- int count - // return DUnit - // } - // | _ -> incorrectArgs ()) - // sqlSpec = NotQueryable - // previewable = Pure - // deprecated = NotDeprecated } + { name = fn "testRaiseException" 0 + typeParams = [] + parameters = [ Param.make "message" TString "" ] + returnType = TVariable "a" + description = "A function that raises an F# exception" + fn = + (function + | _, _, _, [ DString message ] -> raise (System.Exception(message)) + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testGetCanvasID" 0 + typeParams = [] + parameters = [ Param.make "unit" TUnit "" ] + returnType = TUuid + description = "Get the name of the canvas that's running" + fn = + (function + | state, _, _, [ DUnit ] -> state.program.canvasID |> DUuid |> Ply + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } + + + { name = fn "testSetExpectedExceptionCount" 0 + typeParams = [] + parameters = [ Param.make "count" TInt64 "" ] + returnType = TUnit + description = "Set the expected exception count for the current test" + fn = + (function + | state, _, _, [ DInt64 count ] -> + uply { + state.test.expectedExceptionCount <- int count + return DUnit + } + | _ -> incorrectArgs ()) + sqlSpec = NotQueryable + previewable = Pure + deprecated = NotDeprecated } ] let builtins = LibExecution.Builtin.make constants fns diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index de8c11a9ee..afbb00299b 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -23,16 +23,16 @@ module D = LibExecution.DvalDecoder module PackageIDs = LibExecution.PackageIDs module Exe = LibExecution.Execution -// module Account = LibCloud.Account -// module Canvas = LibCloud.Canvas +module Account = LibCloud.Account +module Canvas = LibCloud.Canvas module PackageIDs = LibExecution.PackageIDs -// module C2DT = LibExecution.CommonToDarkTypes -// module PT2DT = LibExecution.ProgramTypesToDarkTypes +module C2DT = LibExecution.CommonToDarkTypes +module PT2DT = LibExecution.ProgramTypesToDarkTypes //let pmPT = LibCloud.PackageManager.pt -//let testOwner : Lazy> = lazy (Account.createUser ()) +let testOwner : Lazy> = lazy (Account.createUser ()) let nameToTestDomain (name : string) : string = let name = @@ -47,27 +47,27 @@ let nameToTestDomain (name : string) : string = |> FsRegEx.replace "[-_]+" "-" |> fun s -> $"{s}.dlio.localhost" -// let initializeCanvasForOwner -// (ownerID : UserID) -// (name : string) -// : Task = -// task { -// let domain = nameToTestDomain name -// let! canvasID = Canvas.create ownerID domain -// return (canvasID, domain) -// } +let initializeCanvasForOwner + (ownerID : UserID) + (name : string) + : Task = + task { + let domain = nameToTestDomain name + let! canvasID = Canvas.create ownerID domain + return (canvasID, domain) + } -// let initializeTestCanvas' (name : string) : Task = -// task { -// let! owner = testOwner.Force() -// return! initializeCanvasForOwner owner name -// } +let initializeTestCanvas' (name : string) : Task = + task { + let! owner = testOwner.Force() + return! initializeCanvasForOwner owner name + } -// let initializeTestCanvas (name : string) : Task = -// task { -// let! (canvasID, _domain) = initializeTestCanvas' name -// return canvasID -// } +let initializeTestCanvas (name : string) : Task = + task { + let! (canvasID, _domain) = initializeTestCanvas' name + return canvasID + } // let testHttpRouteHandler @@ -1601,29 +1601,29 @@ module Http = // } // |> Ply.toTask -// module Internal = -// module Test = -// type PTTest = -// { name : string; lineNumber : int; actual : PT.Expr; expected : PT.Expr } - -// type RTTest = -// { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } - -// let typeName = FQTypeName.fqPackage PackageIDs.Type.Internal.Test.ptTest - -// let toDt (t : PTTest) : Dval = -// let fields = -// [ "name", DString t.name -// "lineNumber", DInt64 t.lineNumber -// "actual", PT2DT.Expr.toDT t.actual -// "expected", PT2DT.Expr.toDT t.expected ] -// DRecord(typeName, typeName, [], Map fields) - -// let fromDT (d : Dval) : PTTest = -// match d with -// | DRecord(_, _, _, fields) -> -// { name = fields |> D.stringField "name" -// lineNumber = fields |> D.int32Field "lineNumber" -// actual = fields |> D.field "actual" |> PT2DT.Expr.fromDT -// expected = fields |> D.field "expected" |> PT2DT.Expr.fromDT } -// | _ -> Exception.raiseInternal "Invalid Test" [] +module Internal = + module Test = + type PTTest = + { name : string; lineNumber : int; actual : PT.Expr; expected : PT.Expr } + + // type RTTest = + // { name : string; lineNumber : int; actual : RT.Expr; expected : RT.Expr } + + // let typeName = FQTypeName.fqPackage PackageIDs.Type.Internal.Test.ptTest + + // let toDt (t : PTTest) : Dval = + // let fields = + // [ "name", DString t.name + // "lineNumber", DInt64 t.lineNumber + // "actual", PT2DT.Expr.toDT t.actual + // "expected", PT2DT.Expr.toDT t.expected ] + // DRecord(typeName, typeName, [], Map fields) + + let fromDT (d : Dval) : PTTest = + match d with + | DRecord(_, _, _, fields) -> + { name = fields |> D.field "name" |> D.string + lineNumber = fields |> D.field "lineNumber" |> D.int32 + actual = fields |> D.field "actual" |> PT2DT.Expr.fromDT + expected = fields |> D.field "expected" |> PT2DT.Expr.fromDT } + | _ -> Exception.raiseInternal "Invalid Test" [] diff --git a/backend/tests/Tests/HttpClient.Tests.fs b/backend/tests/Tests/HttpClient.Tests.fs index 66322f0b21..efcdb04786 100644 --- a/backend/tests/Tests/HttpClient.Tests.fs +++ b/backend/tests/Tests/HttpClient.Tests.fs @@ -97,7 +97,7 @@ let parseSingleTestFromFile uply { let! (state : RT.ExecutionState) = let canvasID = System.Guid.NewGuid() - executionStateFor pmPT canvasID false false Map.empty + executionStateFor pmPT canvasID false false //Map.empty let name = RT.FQFnName.FQFnName.Package @@ -108,7 +108,7 @@ let parseSingleTestFromFile match execResult with | Ok dval -> return Internal.Test.fromDT dval - | Error(_, rte) -> + | Error(rte) -> let! rteString = Exe.rteToString state rte return Exception.raiseInternal diff --git a/backend/tests/Tests/LibExecution.Tests.fs b/backend/tests/Tests/LibExecution.Tests.fs index 3cee57e058..7160ad516e 100644 --- a/backend/tests/Tests/LibExecution.Tests.fs +++ b/backend/tests/Tests/LibExecution.Tests.fs @@ -40,19 +40,19 @@ let setupWorkers (canvasID : CanvasID) (workers : List) : Task = do! Canvas.saveTLIDs canvasID tls } -let setupDBs (canvasID : CanvasID) (dbs : List) : Task = - task { - let tls = dbs |> List.map (fun db -> PT.Toplevel.TLDB db, Serialize.NotDeleted) - do! Canvas.saveTLIDs canvasID tls - } +// let setupDBs (canvasID : CanvasID) (dbs : List) : Task = +// task { +// let tls = dbs |> List.map (fun db -> PT.Toplevel.TLDB db, Serialize.NotDeleted) +// do! Canvas.saveTLIDs canvasID tls +// } let t (internalFnsAllowed : bool) (canvasName : string) (pmPT : PT.PackageManager) - (actualExpr : PT.Expr) - (expectedExpr : PT.Expr) + (actual : PT.Expr) + (expected : PT.Expr) (filename : string) (lineNumber : int) (dbs : List) @@ -68,11 +68,11 @@ let t else System.Guid.NewGuid() |> Task.FromResult - let rtDBs = - dbs |> List.map (fun db -> (db.name, PT2RT.DB.toRT db)) |> Map.ofList + // let rtDBs = + // dbs |> List.map (fun db -> (db.name, PT2RT.DB.toRT db)) |> Map.ofList let! (state : RT.ExecutionState) = - executionStateFor pmPT canvasID internalFnsAllowed false rtDBs + executionStateFor pmPT canvasID internalFnsAllowed false //rtDBs let red = "\u001b[31m" let green = "\u001b[32m" @@ -81,20 +81,20 @@ let t let reset = "\u001b[0m" let rhsMsg = - $"{underline}Right-hand-side test code{reset} (aka {bold}\"expected\"{reset}):\n{green}\n{expectedExpr}\n{reset}" + $"{underline}Right-hand-side test code{reset} (aka {bold}\"expected\"{reset}):\n{green}\n{expected}\n{reset}" let lhsMsg = - $"{underline}Left-hand-side test code{reset} (aka {bold}\"actual\"{reset}):\n{red}\n{actualExpr}\n{reset}" + $"{underline}Left-hand-side test code{reset} (aka {bold}\"actual\"{reset}):\n{red}\n{actual}\n{reset}" let msg = $"\n\n{rhsMsg}\n\n{lhsMsg}\n\nTest location: {bold}{underline}{filename}:{lineNumber}{reset}" - let expectedExpr = PT2RT.Expr.toRT expectedExpr - let! expected = Exe.executeExpr state Map.empty expectedExpr + let expected = expected |> PT2RT.Expr.toRT Map.empty 0 + let! expected = Exe.executeExpr state expected // Initialize if workers <> [] then do! setupWorkers canvasID workers - if dbs <> [] then do! setupDBs canvasID dbs + //if dbs <> [] then do! setupDBs canvasID dbs let results, traceDvalFn = Exe.traceDvals () let state = @@ -104,8 +104,8 @@ let t state // Run the actual program (left-hand-side of the =) - let actualExpr = PT2RT.Expr.toRT actualExpr - let! actual = Exe.executeExpr state Map.empty actualExpr + let actual = actual |> PT2RT.Expr.toRT Map.empty 0 + let! actual = Exe.executeExpr state actual if System.Environment.GetEnvironmentVariable "DEBUG" <> null then debuGList "results" (Dictionary.toList results |> List.sortBy fst) @@ -121,81 +121,81 @@ let t debugDval actual |> debuG "not canonicalized" Expect.isTrue canonical "expected is canonicalized" - // CLEANUP consider not doing the toErrorMessage call - // just test the actual RuntimeError Dval, - // and have separate tests around pretty-printing the error - let! actual = - uply { - match actual with - | Ok _ -> return actual - // "alleged" because sometimes we incorrectly construct an RTE... (should be rare, and only during big refactors) - | Error(_, allegedRTE) -> - let actual = RT.RuntimeError.toDT allegedRTE - let errorMessageFn = - RT.FQFnName.fqPackage - PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage - - let! typeChecked = - let expected = - RT.TCustomType( - Ok( - RT.FQTypeName.fqPackage - PackageIDs.Type.LanguageTools.RuntimeError.error - ), - [] - ) - - let context = - LibExecution.TypeChecker.Context.FunctionCallParameter( - errorMessageFn, - { name = ""; typ = expected }, - 0 - ) - let types = RT.ExecutionState.availableTypes state - LibExecution.TypeChecker.unify context types Map.empty expected actual - - match typeChecked with - | Ok _ -> - // The result was correctly a RuntimeError, try to stringify it - let! result = - LibExecution.Execution.executeFunction - state - errorMessageFn - [] - (NEList.ofList actual []) - - match result with - | Error(_, result) -> - let result = RT.RuntimeError.toDT result - print $"{state.test.exceptionReports}" - return - Exception.raiseInternal - ("We received an RTE, and when trying to stringify it, there was another RTE error. - There is probably a bug in Darklang.LanguageTools.RuntimeErrors.Error.toString") - [ "originalError", LibExecution.DvalReprDeveloper.toRepr actual - "stringified", LibExecution.DvalReprDeveloper.toRepr result ] - | Ok(RT.DEnum(_, _, [], "ErrorString", [ RT.DString _ ])) -> - return result - | Ok _ -> - return - Exception.raiseInternal - "We received an RTE, and when trying to stringify it, got a non-ErrorString response. Instead we got" - [ "result", result ] - - | Error e -> - debuG "Alleged RTE was not an RTE" e - // The result was not a RuntimeError, try to stringify the typechecker error - return! - LibExecution.Execution.executeFunction - state - errorMessageFn - [] - (NEList.ofList (RT.RuntimeError.toDT e) []) - } - |> Ply.toTask + // // CLEANUP consider not doing the toErrorMessage call + // // just test the actual RuntimeError Dval, + // // and have separate tests around pretty-printing the error + // let! actual = + // uply { + // match actual with + // | Ok _ -> return actual + // // "alleged" because sometimes we incorrectly construct an RTE... (should be rare, and only during big refactors) + // | Error(_, allegedRTE) -> + // let actual = RT.RuntimeError.toDT allegedRTE + // let errorMessageFn = + // RT.FQFnName.fqPackage + // PackageIDs.Fn.LanguageTools.RuntimeErrors.Error.toErrorMessage + + // let! typeChecked = + // let expected = + // RT.TCustomType( + // Ok( + // RT.FQTypeName.fqPackage + // PackageIDs.Type.LanguageTools.RuntimeError.error + // ), + // [] + // ) + + // let context = + // LibExecution.TypeChecker.Context.FunctionCallParameter( + // errorMessageFn, + // { name = ""; typ = expected }, + // 0 + // ) + // let types = RT.ExecutionState.availableTypes state + // LibExecution.TypeChecker.unify context types Map.empty expected actual + + // match typeChecked with + // | Ok _ -> + // // The result was correctly a RuntimeError, try to stringify it + // let! result = + // LibExecution.Execution.executeFunction + // state + // errorMessageFn + // [] + // (NEList.ofList actual []) + + // match result with + // | Error(_, result) -> + // let result = RT.RuntimeError.toDT result + // print $"{state.test.exceptionReports}" + // return + // Exception.raiseInternal + // ("We received an RTE, and when trying to stringify it, there was another RTE error. + // There is probably a bug in Darklang.LanguageTools.RuntimeErrors.Error.toString") + // [ "originalError", LibExecution.DvalReprDeveloper.toRepr actual + // "stringified", LibExecution.DvalReprDeveloper.toRepr result ] + // | Ok(RT.DEnum(_, _, [], "ErrorString", [ RT.DString _ ])) -> + // return result + // | Ok _ -> + // return + // Exception.raiseInternal + // "We received an RTE, and when trying to stringify it, got a non-ErrorString response. Instead we got" + // [ "result", result ] + + // | Error e -> + // debuG "Alleged RTE was not an RTE" e + // // The result was not a RuntimeError, try to stringify the typechecker error + // return! + // LibExecution.Execution.executeFunction + // state + // errorMessageFn + // [] + // (NEList.ofList (RT.RuntimeError.toDT e) []) + // } + // |> Ply.toTask match actual, expected with - | Ok actual, Ok expected -> return Expect.equalDval actual expected msg + | Ok actual, Ok expected -> return Expect.RT.equalDval actual expected msg | _ -> return Expect.equal actual expected msg with | :? Expecto.AssertException as e -> Exception.reraise e @@ -227,7 +227,7 @@ let fileTests () : Test = NR.OnMissing.Allow fileName - System.IO.Directory.GetDirectories(baseDir, "*") + System.IO.Directory.GetDirectories(baseDir, "*", System.IO.SearchOption.AllDirectories) |> Array.map (fun dir -> System.IO.Directory.GetFiles(dir, "*.dark") |> Array.toList @@ -235,7 +235,7 @@ let fileTests () : Test = let filename = System.IO.Path.GetFileName file let testName = System.IO.Path.GetFileNameWithoutExtension file let initializeCanvas = testName = "internal" - let shouldSkip = String.startsWith "_" filename + let shouldSkip = filename |> String.contains "_" if shouldSkip then testList $"skipped - {testName}" [] @@ -245,13 +245,12 @@ let fileTests () : Test = $"{dir}/{filename}" |> parseTestFile |> (fun ply -> ply.Result) let pm = - PT.PackageManager.withExtras - pmPT + pmPT + |> PT.PackageManager.withExtras (modules |> List.collect _.types) (modules |> List.collect _.constants) (modules |> List.collect _.fns) - let tests = modules |> List.map (fun m -> diff --git a/backend/tests/Tests/StorageTraces.Tests.fs b/backend/tests/Tests/StorageTraces.Tests.fs index 967d16ee6f..25cc2b388a 100644 --- a/backend/tests/Tests/StorageTraces.Tests.fs +++ b/backend/tests/Tests/StorageTraces.Tests.fs @@ -12,8 +12,6 @@ open TestUtils.TestUtils open LibExecution.RuntimeTypes -module Shortcuts = TestUtils.RTShortcuts - module Canvas = LibCloud.Canvas module AT = LibExecution.AnalysisTypes module PT = LibExecution.ProgramTypes diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index 4bf04f62a7..c2571c7dfe 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -8,26 +8,26 @@ open System.Threading.Tasks open Prelude module PT = LibExecution.ProgramTypes -//module Telemetry = LibService.Telemetry +module Telemetry = LibService.Telemetry let initSerializers () = - //BwdServer.Server.initSerializers () + BwdServer.Server.initSerializers () // These are serializers used in the tests that are not used in the main program Json.Vanilla.allow> "tests" Json.Vanilla.allow "testTraceData" - // Json.Vanilla.allow "Canvas.loadJsonFromDisk" - // Json.Vanilla.allow "Canvas.loadJsonFromDisk" + Json.Vanilla.allow "Canvas.loadJsonFromDisk" + Json.Vanilla.allow "Canvas.loadJsonFromDisk" Json.Vanilla.allow "Canvas.loadJsonFromDisk" [] let main (args : string array) : int = try - //let name = "Tests" - // LibService.Init.init name - // (LibCloud.Init.init LibCloud.Init.WaitForDB name).Result - //(LibCloudExecution.Init.init name).Result + let name = "Tests" + LibService.Init.init name + (LibCloud.Init.init LibCloud.Init.WaitForDB name).Result + (LibCloudExecution.Init.init name).Result initSerializers () @@ -63,7 +63,7 @@ let main (args : string array) : int = // Tests.StorageTraces.tests // cross-cutting - // Tests.LibExecution.tests.Force() + Tests.LibExecution.tests.Force() ] let cancelationTokenSource = new System.Threading.CancellationTokenSource() diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 1ad1b76451..342714ba98 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -23,15 +23,15 @@ - - - + + + - + @@ -50,10 +50,10 @@ - + - + diff --git a/scripts/run-backend-tests b/scripts/run-backend-tests index 58f2e1eead..044d723bc1 100755 --- a/scripts/run-backend-tests +++ b/scripts/run-backend-tests @@ -90,15 +90,15 @@ cd .. # Reload packages -# if [[ -v CI ]]; then -# echo "Running backend server" -# ./scripts/run-backend-server $PUBLISHED_FLAG -# echo "Reloading packages" -# ./scripts/build/reload-packages $PUBLISHED_FLAG -# else -# echo "Reloading packages" -# ./scripts/build/reload-packages --test $PUBLISHED_FLAG -# fi +if [[ -v CI ]]; then + echo "Running backend server" + ./scripts/run-backend-server $PUBLISHED_FLAG + echo "Reloading packages" + ./scripts/build/reload-packages $PUBLISHED_FLAG +else + echo "Reloading packages" + ./scripts/build/reload-packages --test $PUBLISHED_FLAG +fi JUNIT_FILE="${DARK_CONFIG_RUNDIR}/test_results/backend.xml" From 9c24686ef816038283673bccfba3382c77023474 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 20 Sep 2024 20:57:55 -0400 Subject: [PATCH 54/60] 700 tests running+passing now --- .../testfiles/execution/language/_derror.dark | 66 --- .../execution/language/basic/_evariable.dark | 2 - .../execution/language/basic/elet.dark | 8 +- .../execution/language/basic/evariable.dark | 2 + .../language/collections/_dlist.dark | 8 - .../language/collections/_edict.dark | 5 - .../execution/language/collections/dlist.dark | 8 + .../collections/{_dtuple.dark => dtuple.dark} | 6 +- .../execution/language/collections/edict.dark | 5 + .../language/custom-data/_efieldaccess.dark | 16 - .../language/custom-data/_type-alias.dark | 46 +- .../language/custom-data/_type-enum.dark | 205 ------- .../language/custom-data/_type-record.dark | 111 ---- .../{_econstant.dark => econstant.dark} | 2 +- .../language/custom-data/efieldaccess.dark | 16 + .../language/custom-data/type-enum.dark | 205 +++++++ .../language/custom-data/type-record.dark | 111 ++++ .../testfiles/execution/language/derror.dark | 66 +++ .../execution/language/flow-control/_eif.dark | 35 -- .../execution/language/flow-control/eif.dark | 35 ++ .../{_ematch.dark => ematch.dark} | 422 +++++++------- .../flow-control/{_epipe.dark => epipe.dark} | 52 +- .../{_interpreter.dark => interpreter.dark} | 0 backend/testfiles/execution/stdlib/_list.dark | 515 ------------------ .../testfiles/execution/stdlib/_nomodule.dark | 2 - .../stdlib/{_bool.dark => bool.dark} | 0 .../stdlib/{_char.dark => char.dark} | 50 +- .../execution/stdlib/ints/_int8.dark | 36 +- backend/testfiles/execution/stdlib/list.dark | 515 ++++++++++++++++++ .../stdlib/{_math.dark => math.dark} | 16 +- 30 files changed, 1272 insertions(+), 1294 deletions(-) delete mode 100644 backend/testfiles/execution/language/_derror.dark delete mode 100644 backend/testfiles/execution/language/basic/_evariable.dark create mode 100644 backend/testfiles/execution/language/basic/evariable.dark delete mode 100644 backend/testfiles/execution/language/collections/_dlist.dark delete mode 100644 backend/testfiles/execution/language/collections/_edict.dark create mode 100644 backend/testfiles/execution/language/collections/dlist.dark rename backend/testfiles/execution/language/collections/{_dtuple.dark => dtuple.dark} (51%) create mode 100644 backend/testfiles/execution/language/collections/edict.dark delete mode 100644 backend/testfiles/execution/language/custom-data/_efieldaccess.dark delete mode 100644 backend/testfiles/execution/language/custom-data/_type-enum.dark delete mode 100644 backend/testfiles/execution/language/custom-data/_type-record.dark rename backend/testfiles/execution/language/custom-data/{_econstant.dark => econstant.dark} (97%) create mode 100644 backend/testfiles/execution/language/custom-data/efieldaccess.dark create mode 100644 backend/testfiles/execution/language/custom-data/type-enum.dark create mode 100644 backend/testfiles/execution/language/custom-data/type-record.dark create mode 100644 backend/testfiles/execution/language/derror.dark delete mode 100644 backend/testfiles/execution/language/flow-control/_eif.dark create mode 100644 backend/testfiles/execution/language/flow-control/eif.dark rename backend/testfiles/execution/language/flow-control/{_ematch.dark => ematch.dark} (61%) rename backend/testfiles/execution/language/flow-control/{_epipe.dark => epipe.dark} (53%) rename backend/testfiles/execution/language/{_interpreter.dark => interpreter.dark} (100%) delete mode 100644 backend/testfiles/execution/stdlib/_list.dark rename backend/testfiles/execution/stdlib/{_bool.dark => bool.dark} (100%) rename backend/testfiles/execution/stdlib/{_char.dark => char.dark} (86%) create mode 100644 backend/testfiles/execution/stdlib/list.dark rename backend/testfiles/execution/stdlib/{_math.dark => math.dark} (78%) diff --git a/backend/testfiles/execution/language/_derror.dark b/backend/testfiles/execution/language/_derror.dark deleted file mode 100644 index 8b84d561b3..0000000000 --- a/backend/testfiles/execution/language/_derror.dark +++ /dev/null @@ -1,66 +0,0 @@ -module Error = - Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x y -> x) = Builtin.testDerrorMessage - "Expected 2 arguments, got 1" - - Stdlib.Option.map2_v0 - (Stdlib.Option.Option.Some 10L) - "not an option" - (fun (a, b) -> "1") = (Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.Option.map2's 2nd argument (`option2`) should be a PACKAGE.Darklang.Stdlib.Option.Option<'b>. However, a String (\"not an op...) was passed instead. - -Expected: (option2: PACKAGE.Darklang.Stdlib.Option.Option<'b>) -Actual: a String: \"not an option\"") - - -// Check we get previous errors before later ones -(Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> Builtin.testRuntimeError "X")) -|> Stdlib.List.fakeFunction = Builtin.testDerrorMessage "X" - - - -module ErrorPropagation = - type EPRec = - { i: Int64 - m: Int64 - j: Int64 - n: Int64 } - - Stdlib.List.head (Builtin.testRuntimeError "test") = Builtin.testDerrorMessage - "test" - - (if Builtin.testRuntimeError "test" then 5L else 6L) = Builtin.testDerrorMessage - "test" - - (Stdlib.List.head (Builtin.testRuntimeError "test")).field = Builtin.testDerrorMessage - "test" - - [ 5L; 6L; Stdlib.List.head (Builtin.testRuntimeError "test") ] = Builtin.testDerrorMessage - "test" - - [ 5L; 6L; Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage "test" - - EPRec - { i = Builtin.testRuntimeError "1" - m = 5L - j = Stdlib.List.head (Builtin.testRuntimeError "2") - n = 6L } = Builtin.testDerrorMessage "1" - - 5L |> (+) (Builtin.testRuntimeError "test") |> (+) 3564L = Builtin.testDerrorMessage - "test" - - 5L |> (+) (Builtin.testRuntimeError "test") = Builtin.testDerrorMessage "test" - - ("test" |> Builtin.testRuntimeError) = Builtin.testDerrorMessage "test" - - Stdlib.Option.Option.Some(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage - "test" - - Stdlib.Result.Result.Error(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage - "test" - - Stdlib.Result.Result.Ok(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage - "test" - - - // pipe into error - ("test" |> Builtin.testRuntimeError |> (++) "3") = Builtin.testDerrorMessage "test" \ No newline at end of file diff --git a/backend/testfiles/execution/language/basic/_evariable.dark b/backend/testfiles/execution/language/basic/_evariable.dark deleted file mode 100644 index 1c01fa089f..0000000000 --- a/backend/testfiles/execution/language/basic/_evariable.dark +++ /dev/null @@ -1,2 +0,0 @@ -myvar = Builtin.testDerrorMessage "There is no variable named: myvar" -(let x = 5L in x) = 5L \ No newline at end of file diff --git a/backend/testfiles/execution/language/basic/elet.dark b/backend/testfiles/execution/language/basic/elet.dark index 22e389fb85..f1a127c8aa 100644 --- a/backend/testfiles/execution/language/basic/elet.dark +++ b/backend/testfiles/execution/language/basic/elet.dark @@ -61,10 +61,10 @@ module Shadowing = | Ok x -> x) = 6L - (let x = 35L in Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L)) = [ 3L - 4L - 5L - 6L ] + // (let x = 35L in Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x + 2L)) = [ 3L + // 4L + // 5L + // 6L ] // (let x = 35L diff --git a/backend/testfiles/execution/language/basic/evariable.dark b/backend/testfiles/execution/language/basic/evariable.dark new file mode 100644 index 0000000000..fc9b89ea2b --- /dev/null +++ b/backend/testfiles/execution/language/basic/evariable.dark @@ -0,0 +1,2 @@ +// myvar = Builtin.testDerrorMessage "There is no variable named: myvar" +(let x = 5L in x) = 5L \ No newline at end of file diff --git a/backend/testfiles/execution/language/collections/_dlist.dark b/backend/testfiles/execution/language/collections/_dlist.dark deleted file mode 100644 index f6e16b99a2..0000000000 --- a/backend/testfiles/execution/language/collections/_dlist.dark +++ /dev/null @@ -1,8 +0,0 @@ -[] = [] -[ 1L ] = [ 1L ] -[ 1L; 2L ] = [ 1L; 2L ] -[ 5L; Stdlib.Int64.add_v0 1L 5L; 0L ] = [ 5L; 6L; 0L ] -[ 5L; Builtin.testRuntimeError "test"; 0L ] = Builtin.testDerrorMessage "test" - -[ 5L; Builtin.testRuntimeError "1"; Builtin.testRuntimeError "2" ] = Builtin.testDerrorMessage - "1" \ No newline at end of file diff --git a/backend/testfiles/execution/language/collections/_edict.dark b/backend/testfiles/execution/language/collections/_edict.dark deleted file mode 100644 index 3cb6ac0f03..0000000000 --- a/backend/testfiles/execution/language/collections/_edict.dark +++ /dev/null @@ -1,5 +0,0 @@ -((Dict { a = 5L }) |> Stdlib.Dict.get "a") = Stdlib.Option.Option.Some 5L - -((Dict { ___ = 5L }) |> Stdlib.Dict.get "") = Stdlib.Option.Option.Some 5L - -((Dict { a = 5L }) |> Stdlib.Dict.get "b") = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/language/collections/dlist.dark b/backend/testfiles/execution/language/collections/dlist.dark new file mode 100644 index 0000000000..ec82c404a5 --- /dev/null +++ b/backend/testfiles/execution/language/collections/dlist.dark @@ -0,0 +1,8 @@ +[] = [] +[ 1L ] = [ 1L ] +[ 1L; 2L ] = [ 1L; 2L ] +[ 5L; Stdlib.Int64.add_v0 1L 5L; 0L ] = [ 5L; 6L; 0L ] +// [ 5L; Builtin.testRuntimeError "test"; 0L ] = Builtin.testDerrorMessage "test" + +// [ 5L; Builtin.testRuntimeError "1"; Builtin.testRuntimeError "2" ] = Builtin.testDerrorMessage +// "1" \ No newline at end of file diff --git a/backend/testfiles/execution/language/collections/_dtuple.dark b/backend/testfiles/execution/language/collections/dtuple.dark similarity index 51% rename from backend/testfiles/execution/language/collections/_dtuple.dark rename to backend/testfiles/execution/language/collections/dtuple.dark index ea2e5e89b4..c10ee892aa 100644 --- a/backend/testfiles/execution/language/collections/_dtuple.dark +++ b/backend/testfiles/execution/language/collections/dtuple.dark @@ -5,7 +5,7 @@ // note: there is no upper limit set on Tuple size (1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L) = (1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L) -(1L, Builtin.testRuntimeError "test", 3L) = Builtin.testDerrorMessage "test" +// (1L, Builtin.testRuntimeError "test", 3L) = Builtin.testDerrorMessage "test" -(1L, Builtin.testRuntimeError "error1", Builtin.testRuntimeError "error2") = Builtin.testDerrorMessage - "error1" \ No newline at end of file +// (1L, Builtin.testRuntimeError "error1", Builtin.testRuntimeError "error2") = Builtin.testDerrorMessage +// "error1" \ No newline at end of file diff --git a/backend/testfiles/execution/language/collections/edict.dark b/backend/testfiles/execution/language/collections/edict.dark new file mode 100644 index 0000000000..77e618a674 --- /dev/null +++ b/backend/testfiles/execution/language/collections/edict.dark @@ -0,0 +1,5 @@ +// ((Dict { a = 5L }) |> Stdlib.Dict.get "a") = Stdlib.Option.Option.Some 5L + +// ((Dict { ___ = 5L }) |> Stdlib.Dict.get "") = Stdlib.Option.Option.Some 5L + +// ((Dict { a = 5L }) |> Stdlib.Dict.get "b") = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/_efieldaccess.dark b/backend/testfiles/execution/language/custom-data/_efieldaccess.dark deleted file mode 100644 index 997c6479a9..0000000000 --- a/backend/testfiles/execution/language/custom-data/_efieldaccess.dark +++ /dev/null @@ -1,16 +0,0 @@ -type MyRecord = { col1: Int64 } - -(let x = MyRecord { col1 = 1L } in x.col1) = 1L - -module Errors = - - (let x = MyRecord { col1 = 1L } in x.___) = Builtin.testDerrorMessage - "Field name is empty" - - (let x = MyRecord { col1 = 1L } in x.fieldName) = Builtin.testDerrorMessage - "No field named `fieldName` in MyRecord record" - - (Builtin.testRuntimeError "error").fieldName = Builtin.testDerrorMessage "error" - - (let x = 6L in x.fieldName) = Builtin.testDerrorMessage - "Attempting to access field `fieldName` of a Int64 (field access only works with records)" \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/_type-alias.dark b/backend/testfiles/execution/language/custom-data/_type-alias.dark index f4b5cbb0d6..f6998a5656 100644 --- a/backend/testfiles/execution/language/custom-data/_type-alias.dark +++ b/backend/testfiles/execution/language/custom-data/_type-alias.dark @@ -4,9 +4,9 @@ type Id = String type Something = { ID: Id; Data: String } Something { ID = "2"; Data = "test" } = Something { ID = "2"; Data = "test" } -// TODO: would be better if this indicated that it was an Id originally -Something { ID = 2L; Data = "test" } = Builtin.testDerrorMessage - "Something's `ID` field should be a String. However, an Int64 (2) was passed instead.\n\nExpected: ({ ID: Id; ... })\nActual: an Int64: 2" +// // TODO: would be better if this indicated that it was an Id originally +// Something { ID = 2L; Data = "test" } = Builtin.testDerrorMessage +// "Something's `ID` field should be a String. However, an Int64 (2) was passed instead.\n\nExpected: ({ ID: Id; ... })\nActual: an Int64: 2" module SimpleRecordAlias = @@ -40,8 +40,8 @@ module NestedAlias = getUserID (("Alice", "EMP123")) = "EMP123" - getUserID (("Alice", 123L)) = Builtin.testDerrorMessage - "NestedAlias.getUserID's return value should be a String. However, an Int64 (123) was returned instead.\n\nExpected: Id\nActual: an Int64: 123" + // getUserID (("Alice", 123L)) = Builtin.testDerrorMessage + // "NestedAlias.getUserID's return value should be a String. However, an Int64 (123) was returned instead.\n\nExpected: Id\nActual: an Int64: 123" type UserProfile = { credential: UserCredential @@ -86,14 +86,14 @@ module RecordWithTypeArgs = Outer1 { a = "test"; b = 5L } = Inner { a = "test"; b = 5L } Outer1 { a = "test"; b = 5L } = Outer2 { a = "test"; b = 5L } - Outer2 { a = 5L; b = 6L } = Builtin.testDerrorMessage - "RecordWithTypeArgs.Outer2's `a` field should be a String. However, an Int64 (5) was passed instead.\n\nExpected: ({ a: String; ... })\nActual: an Int64: 5" + // Outer2 { a = 5L; b = 6L } = Builtin.testDerrorMessage + // "RecordWithTypeArgs.Outer2's `a` field should be a String. However, an Int64 (5) was passed instead.\n\nExpected: ({ a: String; ... })\nActual: an Int64: 5" - Outer1 { a = "a"; b = "b" } = Builtin.testDerrorMessage - "RecordWithTypeArgs.Outer1's `b` field should be an Int64. However, a String (\"b\") was passed instead.\n\nExpected: ({ b: Int64; ... })\nActual: a String: \"b\"" + // Outer1 { a = "a"; b = "b" } = Builtin.testDerrorMessage + // "RecordWithTypeArgs.Outer1's `b` field should be an Int64. However, a String (\"b\") was passed instead.\n\nExpected: ({ b: Int64; ... })\nActual: a String: \"b\"" - Outer2 { a = 5L; b = 6L } = Builtin.testDerrorMessage - "RecordWithTypeArgs.Outer2's `a` field should be a String. However, an Int64 (5) was passed instead.\n\nExpected: ({ a: String; ... })\nActual: an Int64: 5" + // Outer2 { a = 5L; b = 6L } = Builtin.testDerrorMessage + // "RecordWithTypeArgs.Outer2's `a` field should be a String. However, an Int64 (5) was passed instead.\n\nExpected: ({ a: String; ... })\nActual: an Int64: 5" module RecordWithTypeArgsDifferentName = type Inner<'a, 'b> = { a: 'a; b: 'b } @@ -104,11 +104,11 @@ module RecordWithTypeArgsDifferentName = MostOutest { a = 5L; b = "string" } = Inner { a = 5L; b = "string" } - MostOutest { a = "not allowed"; b = "string" } = Builtin.testDerrorMessage - "RecordWithTypeArgsDifferentName.MostOutest's `a` field should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: ({ a: Int64; ... })\nActual: a String: \"not allowed\"" + // MostOutest { a = "not allowed"; b = "string" } = Builtin.testDerrorMessage + // "RecordWithTypeArgsDifferentName.MostOutest's `a` field should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: ({ a: Int64; ... })\nActual: a String: \"not allowed\"" - MostOutest { a = 5L; b = 6L } = Builtin.testDerrorMessage - "RecordWithTypeArgsDifferentName.MostOutest's `b` field should be a String. However, an Int64 (6) was passed instead.\n\nExpected: ({ b: String; ... })\nActual: an Int64: 6" + // MostOutest { a = 5L; b = 6L } = Builtin.testDerrorMessage + // "RecordWithTypeArgsDifferentName.MostOutest's `b` field should be a String. However, an Int64 (6) was passed instead.\n\nExpected: ({ b: String; ... })\nActual: an Int64: 6" module RecordWithRecursiveTypeArgs = @@ -171,11 +171,11 @@ module EnumWithTypeArgs = Outer2.A "str" = Outer1.A "str" Outer2.B 5L = Outer1.B 5L - Outer1.B "b" = Builtin.testDerrorMessage - "EnumWithTypeArgs.Outer1.B's 1st argument should be an Int64. However, a String (\"b\") was passed instead.\n\nExpected: EnumWithTypeArgs.Outer1.B (Int64)\nActual: EnumWithTypeArgs.Outer1.B (String)" + // Outer1.B "b" = Builtin.testDerrorMessage + // "EnumWithTypeArgs.Outer1.B's 1st argument should be an Int64. However, a String (\"b\") was passed instead.\n\nExpected: EnumWithTypeArgs.Outer1.B (Int64)\nActual: EnumWithTypeArgs.Outer1.B (String)" - Outer2.A 5L = Builtin.testDerrorMessage - "EnumWithTypeArgs.Outer2.A's 1st argument should be a String. However, an Int64 (5) was passed instead.\n\nExpected: EnumWithTypeArgs.Outer2.A (String)\nActual: EnumWithTypeArgs.Outer2.A (Int64)" + // Outer2.A 5L = Builtin.testDerrorMessage + // "EnumWithTypeArgs.Outer2.A's 1st argument should be a String. However, an Int64 (5) was passed instead.\n\nExpected: EnumWithTypeArgs.Outer2.A (String)\nActual: EnumWithTypeArgs.Outer2.A (Int64)" module EnumWithTypeArgsDifferentName = type Inner<'a, 'b> = @@ -190,11 +190,11 @@ module EnumWithTypeArgsDifferentName = MostOutest.A 5L = Inner.A 5L MostOutest.B "test" = Inner.B "test" - MostOutest.A "not allowed" = Builtin.testDerrorMessage - "EnumWithTypeArgsDifferentName.MostOutest.A's 1st argument should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: EnumWithTypeArgsDifferentName.MostOutest.A (Int64)\nActual: EnumWithTypeArgsDifferentName.MostOutest.A (String)" + // MostOutest.A "not allowed" = Builtin.testDerrorMessage + // "EnumWithTypeArgsDifferentName.MostOutest.A's 1st argument should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: EnumWithTypeArgsDifferentName.MostOutest.A (Int64)\nActual: EnumWithTypeArgsDifferentName.MostOutest.A (String)" - MostOutest.B 6L = Builtin.testDerrorMessage - "EnumWithTypeArgsDifferentName.MostOutest.B's 1st argument should be a String. However, an Int64 (6) was passed instead.\n\nExpected: EnumWithTypeArgsDifferentName.MostOutest.B (String)\nActual: EnumWithTypeArgsDifferentName.MostOutest.B (Int64)" + // MostOutest.B 6L = Builtin.testDerrorMessage + // "EnumWithTypeArgsDifferentName.MostOutest.B's 1st argument should be a String. However, an Int64 (6) was passed instead.\n\nExpected: EnumWithTypeArgsDifferentName.MostOutest.B (String)\nActual: EnumWithTypeArgsDifferentName.MostOutest.B (Int64)" module EnumWithRecursiveTypeArgs = diff --git a/backend/testfiles/execution/language/custom-data/_type-enum.dark b/backend/testfiles/execution/language/custom-data/_type-enum.dark deleted file mode 100644 index 6d079a4a6f..0000000000 --- a/backend/testfiles/execution/language/custom-data/_type-enum.dark +++ /dev/null @@ -1,205 +0,0 @@ -Stdlib.Option.Option.None = Stdlib.Option.Option.None - -((Stdlib.List.head []) == Stdlib.Option.Option.None) = true - -(Stdlib.List.head []) = Stdlib.Option.Option.None - -Stdlib.Result.Result.Ok(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage - "err" - -Stdlib.Option.Option.Some(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage - "err" - -Stdlib.Result.Result.Error(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage - "err" - -module Errors = - module Builtins = - Stdlib.Option.Option.None 5 = Builtin.testDerrorMessage - "Case `None` expected 0 fields but got 1" - - Stdlib.Option.Option.Some(5, 6) = Builtin.testDerrorMessage - "Case `Some` expected 1 fields but got 2" - - module User = - type MyEnum = - | A - | B - | C of String - - MyEnum.D = Builtin.testDerrorMessage - "There is no case named `D` in Errors.User.MyEnum" - - MyEnum.C = Builtin.testDerrorMessage "Case `C` expected 1 fields but got 0" - MyEnum.B 5L = Builtin.testDerrorMessage "Case `B` expected 0 fields but got 1" - - (match MyEnum.C "test" with - | C v -> v) = "test" - // TYPESCLEANUP - // (match MyEnum.C "test" with | C -> v) = Builtin.testRuntimeError "TODO" - // (match MyEnum.C "test" with | D -> "PACKAGE.Darklang.Stdlib.Result.Result.Ok" | C _ -> v) = Builtin.testRuntimeError "TODO" - // (match MyEnum.C "test" with | 5 -> "PACKAGE.Darklang.Stdlib.Result.Result.Ok" | C _ -> v) = Builtin.testRuntimeError "TODO" - (MyEnum.C 5L) = Builtin.testDerrorMessage - "Errors.User.MyEnum.C's 1st argument should be a String. However, an Int64 (5) was passed instead. - -Expected: Errors.User.MyEnum.C (String) -Actual: Errors.User.MyEnum.C (Int64)" - - -module Simple = - type AorB = - | A - | B - - (let a = AorB.A - let b = AorB.B - a == b) = false - - (let a1 = AorB.A - let a2 = AorB.A - a1 == a2) = true - - (AorB.A == AorB.A) = true - (AorB.A == AorB.B) = false - - Stdlib.List.unique_v0 [ AorB.A; AorB.B; AorB.A; AorB.A; AorB.B ] = [ AorB.A - AorB.B ] - - module EnumReference = - type CorD = - | C of Int64 - | D of AorB - - (CorD.C 5L != CorD.D AorB.B) = true - (CorD.D AorB.A == CorD.D AorB.A) = true - -module MixedCases = - type EnumOfMixedCases = - | W - | X of String - | Y of i: Int64 - | Z of c: String * i: Int64 - - (EnumOfMixedCases.W == (EnumOfMixedCases.Y 1L)) = false - (EnumOfMixedCases.Y 1L == EnumOfMixedCases.Y 1L) = true - - EnumOfMixedCases.X 1L = Builtin.testDerrorMessage - "MixedCases.EnumOfMixedCases.X's 1st argument should be a String. However, an Int64 (1) was passed instead.\n\nExpected: MixedCases.EnumOfMixedCases.X (String)\nActual: MixedCases.EnumOfMixedCases.X (Int64)" - - EnumOfMixedCases.Y "test" = Builtin.testDerrorMessage - "MixedCases.EnumOfMixedCases.Y's 1st argument should be an Int64. However, a String (\"test\") was passed instead.\n\nExpected: MixedCases.EnumOfMixedCases.Y (Int64)\nActual: MixedCases.EnumOfMixedCases.Y (String)" - - EnumOfMixedCases.Z 1L = Builtin.testDerrorMessage - "Case `Z` expected 2 fields but got 1" - // Test ordering of evaluation - EnumOfMixedCases.Z(Builtin.testRuntimeError "1", Builtin.testRuntimeError "2") = Builtin.testDerrorMessage - "1" - - (let values = - [ EnumOfMixedCases.W - EnumOfMixedCases.X "testX" - EnumOfMixedCases.Y(5L) - EnumOfMixedCases.Z("testZ", 2L) ] - - match Stdlib.List.getAt values 3L with - | Some z -> Stdlib.Result.Result.Ok z - | None -> Stdlib.Result.Result.Error "Failure") = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(EnumOfMixedCases.Z("testZ", 2L)) - - ([ EnumOfMixedCases.W - EnumOfMixedCases.X "testX" - EnumOfMixedCases.Y(5L) - EnumOfMixedCases.Z("testZ", 2L) ] - |> Stdlib.List.map_v0 (fun v -> - match v with - | X s -> "X " ++ s - | Z(s, _i) -> "Z " ++ s - | Y y -> "Y " ++ (Stdlib.Int64.toString_v0 y) - | W -> "a simple W")) = [ "a simple W"; "X testX"; "Y 5"; "Z testZ" ] - -module TuplesVsNonTuples = - type Tuples = - | NotTuple of String * Int64 - | Tuple of (String * Int64) - - (match Tuples.NotTuple("printer broke", 7L) with - | NotTuple(reason, 7L) -> reason) = "printer broke" - - (Tuples.NotTuple(("printer broke", 7L))) = Builtin.testDerrorMessage - "Case `NotTuple` expected 2 fields but got 1" - - (match Tuples.Tuple(("printer broke", 7L)) with - | Tuple((reason, 7L)) -> reason) = "printer broke" - - Tuples.Tuple("printer broke", 7L) = Builtin.testDerrorMessage - "Case `Tuple` expected 1 fields but got 2" - - -module Recursive = - type Tree = - | Leaf - | Node of Tree * Tree - - Tree.Node(Tree.Leaf, Tree.Leaf) = Tree.Node(Tree.Leaf, Tree.Leaf) - - (Tree.Node(Tree.Leaf, Tree.Leaf) - == Tree.Node(Tree.Leaf, Tree.Node(Tree.Leaf, Tree.Leaf))) = false - -module Polymorphism = - // Define a red-black tree - type Color = - | Red - | Black - - type RBTree<'a> = - | Empty - | Node of color: Color * left: RBTree<'a> * value: 'a * right: RBTree<'a> - - let singleton (value: 'a) : RBTree<'a> = - RBTree.Node(Color.Red, RBTree.Empty, value, RBTree.Empty) - - let insert' (tree: RBTree<'a>) (value: 'a) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = - match tree with - | Empty -> singleton value - | Node(color, left, v, right) -> - // CLEANUP we should allow cmp to call two arguments, and not use a weird - // tuple-pipe thing - let c = (value, v) |> cmp - - if c < 0L then - RBTree.Node(color, insert' left value cmp, v, right) - elif c > 0L then - RBTree.Node(color, left, v, insert' right value cmp) - else - RBTree.Node(color, left, value, right) - - let insert (tree: RBTree<'a>) (value: 'a) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = - insert' tree value cmp - - let ofList (values: List<'a>) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = - Stdlib.List.fold_v0 values RBTree.Empty (fun tree value -> insert tree value cmp) - - let toList' (tree: RBTree<'a>) (acc: List<'a>) : List<'a> = - match tree with - | Empty -> acc - | Node(_, left, value, right) -> - toList' left (Stdlib.List.push (toList' right acc) value) - - let toList (tree: RBTree<'a>) : List<'a> = toList' tree [] - - // CLEANUP: we should support tuple destructuring in lambdas - // i.e. update to `fun (x, y) -> ...` - (let intCmp = - fun pair -> - let (x, y) = pair - - if x < y then -1L - elif x > y then 1L - else 0L - - ([ 1L; -2L; 5L; 3L ] |> ofList intCmp |> toList) - == ([ 3L; 5L; -2L; 1L ] |> ofList intCmp |> toList)) = true \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/_type-record.dark b/backend/testfiles/execution/language/custom-data/_type-record.dark deleted file mode 100644 index 811a4352a5..0000000000 --- a/backend/testfiles/execution/language/custom-data/_type-record.dark +++ /dev/null @@ -1,111 +0,0 @@ -type Cols1 = { col1: Int64 } -type Cols2 = { col1: Int64; col2: Int64 } - -type AnEnum = - | A - | B - | C - -Cols2 { col1 = 1L; col2 = 3L } = Cols2 { col1 = 1L; col2 = 3L } - -Cols2 - { col1 = 2L - col2 = Builtin.testRuntimeError "test" } = Builtin.testDerrorMessage "test" - -module WithTypeArgs = - type Owner<'a> = { item: 'a } - type CoOwner<'a> = Owner<'a> - - Owner { item = 5L } = CoOwner { item = 5L } - - type C<'c> = { v: 'c } - type B<'b> = { c: C<'b> } - type A<'a> = { b: B<'a> } - - let getC (a: A) : Int64 = a.b.c.v - - getC (A { b = B { c = C { v = 5L } } }) = 5L - - -module InvalidCols = - Cols1 { col1 = 1L; col1 = 2L } = Builtin.testDerrorMessage - "Duplicate field `col1` in Cols1" - - Cols2 { col1 = 2L; ___ = 3L } = Builtin.testDerrorMessage - "Unexpected field `` in Cols2" - - Cols2 { col1 = 2L } = Builtin.testDerrorMessage "Missing field `col2` in Cols2" - - Cols2 { col1 = 2L; other = 3L } = Builtin.testDerrorMessage - "Unexpected field `other` in Cols2" - - Cols2 { col1 = 2L; col2 = 3L; col3 = 4L } = Builtin.testDerrorMessage - "Unexpected field `col3` in Cols2" - - Cols1 { col1 = "" } = Builtin.testDerrorMessage - "Cols1's `col1` field should be an Int64. However, a String (\"\") was passed instead.\n\nExpected: ({ col1: Int64; ... })\nActual: a String: \"\"" - - -module InvalidType = - MyNonExistantType { col1 = 2L } = Builtin.testDerrorMessage - "There is no type named MyNonExistantType" - - AnEnum { col1 = 2L } = Builtin.testDerrorMessage - "Expected a record but AnEnum is an enum" - -module Polymorphism = - type MyRecord<'a> = { col1: 'a; col2: Int64 } - (MyRecord { col1 = (); col2 = 1L }).col2 = 1L - - (MyRecord - { col1 = Stdlib.Option.Option.Some(Stdlib.Result.Result.Ok 1L) - col2 = 1L }) - .col1 = Stdlib.Option.Option.Some(Stdlib.Result.Result.Ok 1L) - - -module Nested = - type NestedRecordA = { col1: Int64 } - type NestedRecordB = { col1: NestedRecordA } - (NestedRecordB { col1 = NestedRecordA { col1 = 1L } }).col1.col1 = 1L - - -module Update = - type RecordForUpdate = { x: Int64; y: Int64 } - type RecordForUpdateMultipe = { x: Int64; y: Int64; z: Int64 } - - ({ RecordForUpdate { x = 4L; y = 1L } with - y = 2L }) = RecordForUpdate { x = 4L; y = 2L } - - (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = 2L }) = RecordForUpdate - { x = 4L; y = 2L } - - (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = 22L; y = 42L }) = RecordForUpdate - { x = 4L; y = 42L } - - (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } - { myRec with y = 2L; z = 42L }) = RecordForUpdateMultipe - { x = 4L; y = 2L; z = 42L } - - (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } - { myRec with z = 3L; x = 42L }) = RecordForUpdateMultipe - { x = 42L; y = 1L; z = 3L } - - (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } - { myRec with z = 3L; x = 42L; y = 11L }) = RecordForUpdateMultipe - { x = 42L; y = 11L; z = 3L } - - module Invalid = - (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } - - { myRec with - z = 3L - x = 42L - y = 11L - p = 10L }) = Builtin.testDerrorMessage - "Unexpected field `p` in Update.RecordForUpdateMultipe" - - (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with other = 2L }) = Builtin.testDerrorMessage - "Unexpected field `other` in Update.RecordForUpdate" - - (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = "2" }) = Builtin.testDerrorMessage - "Update.RecordForUpdate's `y` field should be an Int64. However, a String (\"2\") was passed instead.\n\nExpected: ({ y: Int64; ... })\nActual: a String: \"2\"" \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/_econstant.dark b/backend/testfiles/execution/language/custom-data/econstant.dark similarity index 97% rename from backend/testfiles/execution/language/custom-data/_econstant.dark rename to backend/testfiles/execution/language/custom-data/econstant.dark index c9a5324c88..d5d39c12b6 100644 --- a/backend/testfiles/execution/language/custom-data/_econstant.dark +++ b/backend/testfiles/execution/language/custom-data/econstant.dark @@ -60,7 +60,7 @@ module UserDefined = enumConst = Stdlib.Option.Option.Some 5L UserDefined.enumConst = Stdlib.Option.Option.Some 5L - Ok 5L = Builtin.testDerrorMessage "Missing type name for enum case: Ok" + //Ok 5L = Builtin.testDerrorMessage "Missing type name for enum case: Ok" module Package = diff --git a/backend/testfiles/execution/language/custom-data/efieldaccess.dark b/backend/testfiles/execution/language/custom-data/efieldaccess.dark new file mode 100644 index 0000000000..1e6d23fd01 --- /dev/null +++ b/backend/testfiles/execution/language/custom-data/efieldaccess.dark @@ -0,0 +1,16 @@ +type MyRecord = { col1: Int64 } + +(let x = MyRecord { col1 = 1L } in x.col1) = 1L + +// module Errors = + +// (let x = MyRecord { col1 = 1L } in x.___) = Builtin.testDerrorMessage +// "Field name is empty" + +// (let x = MyRecord { col1 = 1L } in x.fieldName) = Builtin.testDerrorMessage +// "No field named `fieldName` in MyRecord record" + +// (Builtin.testRuntimeError "error").fieldName = Builtin.testDerrorMessage "error" + +// (let x = 6L in x.fieldName) = Builtin.testDerrorMessage +// "Attempting to access field `fieldName` of a Int64 (field access only works with records)" \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/type-enum.dark b/backend/testfiles/execution/language/custom-data/type-enum.dark new file mode 100644 index 0000000000..300ef7feb9 --- /dev/null +++ b/backend/testfiles/execution/language/custom-data/type-enum.dark @@ -0,0 +1,205 @@ +Stdlib.Option.Option.None = Stdlib.Option.Option.None + +((Stdlib.List.head []) == Stdlib.Option.Option.None) = true + +(Stdlib.List.head []) = Stdlib.Option.Option.None + +// Stdlib.Result.Result.Ok(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage +// "err" + +// Stdlib.Option.Option.Some(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage +// "err" + +// Stdlib.Result.Result.Error(Builtin.testRuntimeError "err") = Builtin.testDerrorMessage +// "err" + +module Errors = + // module Builtins = + // Stdlib.Option.Option.None 5 = Builtin.testDerrorMessage + // "Case `None` expected 0 fields but got 1" + + // Stdlib.Option.Option.Some(5, 6) = Builtin.testDerrorMessage + // "Case `Some` expected 1 fields but got 2" + + module User = + type MyEnum = + | A + | B + | C of String + +// MyEnum.D = Builtin.testDerrorMessage +// "There is no case named `D` in Errors.User.MyEnum" + +// MyEnum.C = Builtin.testDerrorMessage "Case `C` expected 1 fields but got 0" +// MyEnum.B 5L = Builtin.testDerrorMessage "Case `B` expected 0 fields but got 1" + +// (match MyEnum.C "test" with +// | C v -> v) = "test" +// // TYPESCLEANUP +// // (match MyEnum.C "test" with | C -> v) = Builtin.testRuntimeError "TODO" +// // (match MyEnum.C "test" with | D -> "PACKAGE.Darklang.Stdlib.Result.Result.Ok" | C _ -> v) = Builtin.testRuntimeError "TODO" +// // (match MyEnum.C "test" with | 5 -> "PACKAGE.Darklang.Stdlib.Result.Result.Ok" | C _ -> v) = Builtin.testRuntimeError "TODO" +// (MyEnum.C 5L) = Builtin.testDerrorMessage +// "Errors.User.MyEnum.C's 1st argument should be a String. However, an Int64 (5) was passed instead. + +// Expected: Errors.User.MyEnum.C (String) +// Actual: Errors.User.MyEnum.C (Int64)" + + +module Simple = + type AorB = + | A + | B + + (let a = AorB.A + let b = AorB.B + a == b) = false + + (let a1 = AorB.A + let a2 = AorB.A + a1 == a2) = true + + (AorB.A == AorB.A) = true + (AorB.A == AorB.B) = false + + Stdlib.List.unique_v0 [ AorB.A; AorB.B; AorB.A; AorB.A; AorB.B ] = [ AorB.A + AorB.B ] + + module EnumReference = + type CorD = + | C of Int64 + | D of AorB + + (CorD.C 5L != CorD.D AorB.B) = true + (CorD.D AorB.A == CorD.D AorB.A) = true + +module MixedCases = + type EnumOfMixedCases = + | W + | X of String + | Y of i: Int64 + | Z of c: String * i: Int64 + + (EnumOfMixedCases.W == (EnumOfMixedCases.Y 1L)) = false + (EnumOfMixedCases.Y 1L == EnumOfMixedCases.Y 1L) = true + + // EnumOfMixedCases.X 1L = Builtin.testDerrorMessage + // "MixedCases.EnumOfMixedCases.X's 1st argument should be a String. However, an Int64 (1) was passed instead.\n\nExpected: MixedCases.EnumOfMixedCases.X (String)\nActual: MixedCases.EnumOfMixedCases.X (Int64)" + + // EnumOfMixedCases.Y "test" = Builtin.testDerrorMessage + // "MixedCases.EnumOfMixedCases.Y's 1st argument should be an Int64. However, a String (\"test\") was passed instead.\n\nExpected: MixedCases.EnumOfMixedCases.Y (Int64)\nActual: MixedCases.EnumOfMixedCases.Y (String)" + + // EnumOfMixedCases.Z 1L = Builtin.testDerrorMessage + // "Case `Z` expected 2 fields but got 1" + // // Test ordering of evaluation + // EnumOfMixedCases.Z(Builtin.testRuntimeError "1", Builtin.testRuntimeError "2") = Builtin.testDerrorMessage + // "1" + + // (let values = + // [ EnumOfMixedCases.W + // EnumOfMixedCases.X "testX" + // EnumOfMixedCases.Y(5L) + // EnumOfMixedCases.Z("testZ", 2L) ] + + // match Stdlib.List.getAt values 3L with + // | Some z -> Stdlib.Result.Result.Ok z + // | None -> Stdlib.Result.Result.Error "Failure") = PACKAGE + // .Darklang + // .Stdlib + // .Result + // .Result + // .Ok(EnumOfMixedCases.Z("testZ", 2L)) + + // ([ EnumOfMixedCases.W + // EnumOfMixedCases.X "testX" + // EnumOfMixedCases.Y(5L) + // EnumOfMixedCases.Z("testZ", 2L) ] + // |> Stdlib.List.map_v0 (fun v -> + // match v with + // | X s -> "X " ++ s + // | Z(s, _i) -> "Z " ++ s + // | Y y -> "Y " ++ (Stdlib.Int64.toString_v0 y) + // | W -> "a simple W")) = [ "a simple W"; "X testX"; "Y 5"; "Z testZ" ] + +module TuplesVsNonTuples = + type Tuples = + | NotTuple of String * Int64 + | Tuple of (String * Int64) + + (match Tuples.NotTuple("printer broke", 7L) with + | NotTuple(reason, 7L) -> reason) = "printer broke" + + // (Tuples.NotTuple(("printer broke", 7L))) = Builtin.testDerrorMessage + // "Case `NotTuple` expected 2 fields but got 1" + + (match Tuples.Tuple(("printer broke", 7L)) with + | Tuple((reason, 7L)) -> reason) = "printer broke" + + // Tuples.Tuple("printer broke", 7L) = Builtin.testDerrorMessage + // "Case `Tuple` expected 1 fields but got 2" + + +module Recursive = + type Tree = + | Leaf + | Node of Tree * Tree + + Tree.Node(Tree.Leaf, Tree.Leaf) = Tree.Node(Tree.Leaf, Tree.Leaf) + + (Tree.Node(Tree.Leaf, Tree.Leaf) + == Tree.Node(Tree.Leaf, Tree.Node(Tree.Leaf, Tree.Leaf))) = false + +module Polymorphism = + // Define a red-black tree + type Color = + | Red + | Black + + type RBTree<'a> = + | Empty + | Node of color: Color * left: RBTree<'a> * value: 'a * right: RBTree<'a> + + let singleton (value: 'a) : RBTree<'a> = + RBTree.Node(Color.Red, RBTree.Empty, value, RBTree.Empty) + + let insert' (tree: RBTree<'a>) (value: 'a) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = + match tree with + | Empty -> singleton value + | Node(color, left, v, right) -> + // CLEANUP we should allow cmp to call two arguments, and not use a weird + // tuple-pipe thing + let c = (value, v) |> cmp + + if c < 0L then + RBTree.Node(color, insert' left value cmp, v, right) + elif c > 0L then + RBTree.Node(color, left, v, insert' right value cmp) + else + RBTree.Node(color, left, value, right) + + let insert (tree: RBTree<'a>) (value: 'a) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = + insert' tree value cmp + + let ofList (values: List<'a>) (cmp: ('a * 'a) -> Int64) : RBTree<'a> = + Stdlib.List.fold_v0 values RBTree.Empty (fun tree value -> insert tree value cmp) + + let toList' (tree: RBTree<'a>) (acc: List<'a>) : List<'a> = + match tree with + | Empty -> acc + | Node(_, left, value, right) -> + toList' left (Stdlib.List.push (toList' right acc) value) + + let toList (tree: RBTree<'a>) : List<'a> = toList' tree [] + + // // CLEANUP: we should support tuple destructuring in lambdas + // // i.e. update to `fun (x, y) -> ...` + // (let intCmp = + // fun pair -> + // let (x, y) = pair + + // if x < y then -1L + // elif x > y then 1L + // else 0L + + // ([ 1L; -2L; 5L; 3L ] |> ofList intCmp |> toList) + // == ([ 3L; 5L; -2L; 1L ] |> ofList intCmp |> toList)) = true \ No newline at end of file diff --git a/backend/testfiles/execution/language/custom-data/type-record.dark b/backend/testfiles/execution/language/custom-data/type-record.dark new file mode 100644 index 0000000000..f1701f0174 --- /dev/null +++ b/backend/testfiles/execution/language/custom-data/type-record.dark @@ -0,0 +1,111 @@ +type Cols1 = { col1: Int64 } +type Cols2 = { col1: Int64; col2: Int64 } + +type AnEnum = + | A + | B + | C + +Cols2 { col1 = 1L; col2 = 3L } = Cols2 { col1 = 1L; col2 = 3L } + +// Cols2 +// { col1 = 2L +// col2 = Builtin.testRuntimeError "test" } = Builtin.testDerrorMessage "test" + +module WithTypeArgs = + type Owner<'a> = { item: 'a } + type CoOwner<'a> = Owner<'a> + + //Owner { item = 5L } = CoOwner { item = 5L } + + type C<'c> = { v: 'c } + type B<'b> = { c: C<'b> } + type A<'a> = { b: B<'a> } + + let getC (a: A) : Int64 = a.b.c.v + + getC (A { b = B { c = C { v = 5L } } }) = 5L + + +// module InvalidCols = +// Cols1 { col1 = 1L; col1 = 2L } = Builtin.testDerrorMessage +// "Duplicate field `col1` in Cols1" + +// Cols2 { col1 = 2L; ___ = 3L } = Builtin.testDerrorMessage +// "Unexpected field `` in Cols2" + +// Cols2 { col1 = 2L } = Builtin.testDerrorMessage "Missing field `col2` in Cols2" + +// Cols2 { col1 = 2L; other = 3L } = Builtin.testDerrorMessage +// "Unexpected field `other` in Cols2" + +// Cols2 { col1 = 2L; col2 = 3L; col3 = 4L } = Builtin.testDerrorMessage +// "Unexpected field `col3` in Cols2" + +// Cols1 { col1 = "" } = Builtin.testDerrorMessage +// "Cols1's `col1` field should be an Int64. However, a String (\"\") was passed instead.\n\nExpected: ({ col1: Int64; ... })\nActual: a String: \"\"" + + +// module InvalidType = +// MyNonExistantType { col1 = 2L } = Builtin.testDerrorMessage +// "There is no type named MyNonExistantType" + +// AnEnum { col1 = 2L } = Builtin.testDerrorMessage +// "Expected a record but AnEnum is an enum" + +module Polymorphism = + type MyRecord<'a> = { col1: 'a; col2: Int64 } + (MyRecord { col1 = (); col2 = 1L }).col2 = 1L + + (MyRecord + { col1 = Stdlib.Option.Option.Some(Stdlib.Result.Result.Ok 1L) + col2 = 1L }) + .col1 = Stdlib.Option.Option.Some(Stdlib.Result.Result.Ok 1L) + + +module Nested = + type NestedRecordA = { col1: Int64 } + type NestedRecordB = { col1: NestedRecordA } + (NestedRecordB { col1 = NestedRecordA { col1 = 1L } }).col1.col1 = 1L + + +module Update = + type RecordForUpdate = { x: Int64; y: Int64 } + type RecordForUpdateMultipe = { x: Int64; y: Int64; z: Int64 } + + ({ RecordForUpdate { x = 4L; y = 1L } with + y = 2L }) = RecordForUpdate { x = 4L; y = 2L } + + (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = 2L }) = RecordForUpdate + { x = 4L; y = 2L } + + (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = 22L; y = 42L }) = RecordForUpdate + { x = 4L; y = 42L } + + (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } + { myRec with y = 2L; z = 42L }) = RecordForUpdateMultipe + { x = 4L; y = 2L; z = 42L } + + (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } + { myRec with z = 3L; x = 42L }) = RecordForUpdateMultipe + { x = 42L; y = 1L; z = 3L } + + (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } + { myRec with z = 3L; x = 42L; y = 11L }) = RecordForUpdateMultipe + { x = 42L; y = 11L; z = 3L } + + // module Invalid = + // (let myRec = RecordForUpdateMultipe { x = 4L; y = 1L; z = 0L } + + // { myRec with + // z = 3L + // x = 42L + // y = 11L + // p = 10L }) = Builtin.testDerrorMessage + // "Unexpected field `p` in Update.RecordForUpdateMultipe" + + // (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with other = 2L }) = Builtin.testDerrorMessage + // "Unexpected field `other` in Update.RecordForUpdate" + + // (let myRec = RecordForUpdate { x = 4L; y = 1L } in { myRec with y = "2" }) = Builtin.testDerrorMessage + // "Update.RecordForUpdate's `y` field should be an Int64. However, a String (\"2\") was passed instead.\n\nExpected: ({ y: Int64; ... })\nActual: a String: \"2\"" \ No newline at end of file diff --git a/backend/testfiles/execution/language/derror.dark b/backend/testfiles/execution/language/derror.dark new file mode 100644 index 0000000000..bcdc459f62 --- /dev/null +++ b/backend/testfiles/execution/language/derror.dark @@ -0,0 +1,66 @@ +module Error = +// Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x y -> x) = Builtin.testDerrorMessage +// "Expected 2 arguments, got 1" + +// Stdlib.Option.map2_v0 +// (Stdlib.Option.Option.Some 10L) +// "not an option" +// (fun (a, b) -> "1") = (Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.Option.map2's 2nd argument (`option2`) should be a PACKAGE.Darklang.Stdlib.Option.Option<'b>. However, a String (\"not an op...) was passed instead. + +// Expected: (option2: PACKAGE.Darklang.Stdlib.Option.Option<'b>) +// Actual: a String: \"not an option\"") + + +// // Check we get previous errors before later ones +// (Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> Builtin.testRuntimeError "X")) +// |> Stdlib.List.fakeFunction = Builtin.testDerrorMessage "X" + + + +module ErrorPropagation = + type EPRec = + { i: Int64 + m: Int64 + j: Int64 + n: Int64 } + + // Stdlib.List.head (Builtin.testRuntimeError "test") = Builtin.testDerrorMessage + // "test" + + // (if Builtin.testRuntimeError "test" then 5L else 6L) = Builtin.testDerrorMessage + // "test" + + // (Stdlib.List.head (Builtin.testRuntimeError "test")).field = Builtin.testDerrorMessage + // "test" + + // [ 5L; 6L; Stdlib.List.head (Builtin.testRuntimeError "test") ] = Builtin.testDerrorMessage + // "test" + + // [ 5L; 6L; Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage "test" + + // EPRec + // { i = Builtin.testRuntimeError "1" + // m = 5L + // j = Stdlib.List.head (Builtin.testRuntimeError "2") + // n = 6L } = Builtin.testDerrorMessage "1" + + // 5L |> (+) (Builtin.testRuntimeError "test") |> (+) 3564L = Builtin.testDerrorMessage + // "test" + + // 5L |> (+) (Builtin.testRuntimeError "test") = Builtin.testDerrorMessage "test" + + // ("test" |> Builtin.testRuntimeError) = Builtin.testDerrorMessage "test" + + // Stdlib.Option.Option.Some(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage + // "test" + + // Stdlib.Result.Result.Error(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage + // "test" + + // Stdlib.Result.Result.Ok(Builtin.testRuntimeError "test") = Builtin.testDerrorMessage + // "test" + + + // // pipe into error + // ("test" |> Builtin.testRuntimeError |> (++) "3") = Builtin.testDerrorMessage "test" \ No newline at end of file diff --git a/backend/testfiles/execution/language/flow-control/_eif.dark b/backend/testfiles/execution/language/flow-control/_eif.dark deleted file mode 100644 index c8eb0f14dc..0000000000 --- a/backend/testfiles/execution/language/flow-control/_eif.dark +++ /dev/null @@ -1,35 +0,0 @@ -(if true then "correct" else 0L) = "correct" - -(if true then Builtin.testRuntimeError "a" else 0L) = Builtin.testDerrorMessage "a" - -(if false then 0L else Builtin.testRuntimeError "a") = Builtin.testDerrorMessage "a" - -(if false then Builtin.testRuntimeError "a" else 0L) = 0L -(if true then 0L else Builtin.testRuntimeError "a") = 0L -(if false then "" else "correct") = "correct" -(if () then "" else "") = Builtin.testDerrorMessage "If only supports Booleans" - -(if Builtin.testRuntimeError "msg" then "" else "") = Builtin.testDerrorMessage "msg" - -(if 5L then "" else "") = Builtin.testDerrorMessage "If only supports Booleans" - -(if true then - ()) = () - -(if 1L > 3L then - 4L) = () - -(if 1L < 3L then - 4L) = 4L - -(if 1L < 3L then - "msg") = "msg" - -(if () then - "msg") = Builtin.testDerrorMessage "If only supports Booleans" - -(if true then - Builtin.testRuntimeError "a") = Builtin.testDerrorMessage "a" - -(if Builtin.testRuntimeError "msg" then - "") = Builtin.testDerrorMessage "msg" \ No newline at end of file diff --git a/backend/testfiles/execution/language/flow-control/eif.dark b/backend/testfiles/execution/language/flow-control/eif.dark new file mode 100644 index 0000000000..7e3a1da527 --- /dev/null +++ b/backend/testfiles/execution/language/flow-control/eif.dark @@ -0,0 +1,35 @@ +(if true then "correct" else 0L) = "correct" + +// (if true then Builtin.testRuntimeError "a" else 0L) = Builtin.testDerrorMessage "a" + +// (if false then 0L else Builtin.testRuntimeError "a") = Builtin.testDerrorMessage "a" + +// (if false then Builtin.testRuntimeError "a" else 0L) = 0L +// (if true then 0L else Builtin.testRuntimeError "a") = 0L +(if false then "" else "correct") = "correct" +// (if () then "" else "") = Builtin.testDerrorMessage "If only supports Booleans" + +// (if Builtin.testRuntimeError "msg" then "" else "") = Builtin.testDerrorMessage "msg" + +// (if 5L then "" else "") = Builtin.testDerrorMessage "If only supports Booleans" + +(if true then + ()) = () + +(if 1L > 3L then + 4L) = () + +(if 1L < 3L then + 4L) = 4L + +(if 1L < 3L then + "msg") = "msg" + +// (if () then +// "msg") = Builtin.testDerrorMessage "If only supports Booleans" + +// (if true then +// Builtin.testRuntimeError "a") = Builtin.testDerrorMessage "a" + +// (if Builtin.testRuntimeError "msg" then +// "") = Builtin.testDerrorMessage "msg" \ No newline at end of file diff --git a/backend/testfiles/execution/language/flow-control/_ematch.dark b/backend/testfiles/execution/language/flow-control/ematch.dark similarity index 61% rename from backend/testfiles/execution/language/flow-control/_ematch.dark rename to backend/testfiles/execution/language/flow-control/ematch.dark index db489e074c..69bce11d54 100644 --- a/backend/testfiles/execution/language/flow-control/_ematch.dark +++ b/backend/testfiles/execution/language/flow-control/ematch.dark @@ -25,13 +25,13 @@ module Int64 = | 999999999999999L -> "pass") = "pass" - (match 6L with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 6 with a Float pattern" + // (match 6L with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 6 with a Float pattern" - (match 6.0 with - | 6L -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an Int64 pattern" + // (match 6.0 with + // | 6L -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an Int64 pattern" module UInt64 = @@ -54,13 +54,13 @@ module UInt64 = | 0UL -> "fail" | 18446744073709551615UL -> "pass") = "pass" - (match 6UL with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match UInt64 value 6 with a Float pattern" + // (match 6UL with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match UInt64 value 6 with a Float pattern" - (match 6.0 with - | 6UL -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an UInt64 pattern" + // (match 6.0 with + // | 6UL -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an UInt64 pattern" module Int8 = @@ -84,13 +84,13 @@ module Int8 = | 0y -> "fail" | 127y -> "pass") = "pass" - (match 6y with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match Int8 value 6 with a Float pattern" + // (match 6y with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int8 value 6 with a Float pattern" - (match 6.0 with - | 6y -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an Int8 pattern" + // (match 6.0 with + // | 6y -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an Int8 pattern" module UInt8 = @@ -113,13 +113,13 @@ module UInt8 = | 0uy -> "fail" | 255uy -> "pass") = "pass" - (match 6uy with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match UInt8 value 6 with a Float pattern" + // (match 6uy with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match UInt8 value 6 with a Float pattern" - (match 6.0 with - | 6uy -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an UInt8 pattern" + // (match 6.0 with + // | 6uy -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an UInt8 pattern" module Int16 = @@ -143,13 +143,13 @@ module Int16 = | 0s -> "fail" | 32767s -> "pass") = "pass" - (match 6s with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match Int16 value 6 with a Float pattern" + // (match 6s with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int16 value 6 with a Float pattern" - (match 6.0 with - | 6s -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an Int16 pattern" + // (match 6.0 with + // | 6s -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an Int16 pattern" module UInt16 = @@ -172,13 +172,13 @@ module UInt16 = | 0us -> "fail" | 65535us -> "pass") = "pass" - (match 6us with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match UInt16 value 6 with a Float pattern" + // (match 6us with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match UInt16 value 6 with a Float pattern" - (match 6.0 with - | 6us -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an UInt16 pattern" + // (match 6.0 with + // | 6us -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an UInt16 pattern" module Int32 = @@ -202,13 +202,13 @@ module Int32 = | 0l -> "fail" | 2147483647l -> "pass") = "pass" - (match 6l with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match Int32 value 6 with a Float pattern" + // (match 6l with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int32 value 6 with a Float pattern" - (match 6.0 with - | 6l -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an Int32 pattern" + // (match 6.0 with + // | 6l -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an Int32 pattern" module UInt32 = @@ -231,13 +231,13 @@ module UInt32 = | 0ul -> "fail" | 4294967295ul -> "pass") = "pass" - (match 6ul with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match UInt32 value 6 with a Float pattern" + // (match 6ul with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match UInt32 value 6 with a Float pattern" - (match 6.0 with - | 6ul -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an UInt32 pattern" + // (match 6.0 with + // | 6ul -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an UInt32 pattern" module Int128 = @@ -261,13 +261,13 @@ module Int128 = | 0Q -> "fail" | 170141183460469231731687303715884105727Q -> "pass") = "pass" - (match 6Q with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match Int128 value 6 with a Float pattern" + // (match 6Q with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int128 value 6 with a Float pattern" - (match 6.0 with - | 6Q -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an Int128 pattern" + // (match 6.0 with + // | 6Q -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an Int128 pattern" module UInt128 = (match 6Z with @@ -289,13 +289,13 @@ module UInt128 = | 0Z -> "fail" | 340282366920938463463374607431768211455Z -> "pass") = "pass" - (match 6Z with - | 6.0 -> "fail") = Builtin.testDerrorMessage - "Cannot match UInt128 value 6 with a Float pattern" + // (match 6Z with + // | 6.0 -> "fail") = Builtin.testDerrorMessage + // "Cannot match UInt128 value 6 with a Float pattern" - (match 6.0 with - | 6Z -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 6.0 with an UInt128 pattern" + // (match 6.0 with + // | 6Z -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 6.0 with an UInt128 pattern" module String = @@ -316,13 +316,13 @@ module String = | "x" -> "fail" | "y" -> "fail") = "pass: x" - (match "x" with - | 6L -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"x\" with an Int64 pattern" + // (match "x" with + // | 6L -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"x\" with an Int64 pattern" - (match 6L with - | "x" -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 6 with a String pattern" + // (match 6L with + // | "x" -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 6 with a String pattern" module Bool = @@ -352,13 +352,13 @@ module Bool = | false -> "fail" | true -> "fail") = "pass" - (match false with - | "false" -> "fail") = Builtin.testDerrorMessage - "Cannot match Bool value false with a String pattern" + // (match false with + // | "false" -> "fail") = Builtin.testDerrorMessage + // "Cannot match Bool value false with a String pattern" - (match "false" with - | false -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"false\" with a Bool pattern" + // (match "false" with + // | false -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"false\" with a Bool pattern" module Float = @@ -394,13 +394,13 @@ module Float = | -4.7 -> "fail" | 4.7 -> "fail") = "pass: -4.7" - (match -4.7 with - | true -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value -4.7 with a Bool pattern" + // (match -4.7 with + // | true -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value -4.7 with a Bool pattern" - (match true with - | -4.7 -> "fail") = Builtin.testDerrorMessage - "Cannot match Bool value true with a Float pattern" + // (match true with + // | -4.7 -> "fail") = Builtin.testDerrorMessage + // "Cannot match Bool value true with a Float pattern" module Unit = @@ -413,13 +413,13 @@ module Unit = | var -> "pass" | () -> "fail") = "pass" - (match () with - | 0L -> "fail") = Builtin.testDerrorMessage - "Cannot match Unit value () with an Int64 pattern" + // (match () with + // | 0L -> "fail") = Builtin.testDerrorMessage + // "Cannot match Unit value () with an Int64 pattern" - (match 0L with - | () -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 0 with an Unit pattern" + // (match 0L with + // | () -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 0 with an Unit pattern" module Char = @@ -449,13 +449,13 @@ module Char = | 'c' -> "fail" | 'd' -> "fail") = "pass" - (match 'c' with - | true -> "fail") = Builtin.testDerrorMessage - "Cannot match Char value 'c' with a Bool pattern" + // (match 'c' with + // | true -> "fail") = Builtin.testDerrorMessage + // "Cannot match Char value 'c' with a Bool pattern" - (match true with - | 'c' -> "fail") = Builtin.testDerrorMessage - "Cannot match Bool value true with a Char pattern" + // (match true with + // | 'c' -> "fail") = Builtin.testDerrorMessage + // "Cannot match Bool value true with a Char pattern" module List = @@ -502,17 +502,17 @@ module List = | [ a; a; a ] -> a | name -> name ++ "var") = 5L - (match [ 1L; 2L; 3L ] with - | "1,2,3" -> "fail") = Builtin.testDerrorMessage - "Cannot match List value [ 1, 2, ... with a String pattern" + // (match [ 1L; 2L; 3L ] with + // | "1,2,3" -> "fail") = Builtin.testDerrorMessage + // "Cannot match List value [ 1, 2, ... with a String pattern" - (match [ 1L; 2L; 3L ] with - | [ 1.0; 2.0; 3.0 ] -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 1 with a Float pattern" + // (match [ 1L; 2L; 3L ] with + // | [ 1.0; 2.0; 3.0 ] -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 1 with a Float pattern" - (match "" with - | [ 1L; 2L; 3L ] -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"\" with a List pattern" + // (match "" with + // | [ 1L; 2L; 3L ] -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"\" with a List pattern" @@ -547,27 +547,27 @@ module List = | [ _; [ 3L; _ ] ] -> "pass" | _ -> "fail") = "pass" - (match [ [ 1L; 2L ]; [ 3L; 4L ] ] with - | "1,2,3,4" -> "fail") = Builtin.testDerrorMessage - "Cannot match List> value [ [ ... with a String pattern" + // (match [ [ 1L; 2L ]; [ 3L; 4L ] ] with + // | "1,2,3,4" -> "fail") = Builtin.testDerrorMessage + // "Cannot match List> value [ [ ... with a String pattern" - (match [ "" ] with - // Different lengths - | [ 1L; 2L; 3L ] -> "fail") = Builtin.testDerrorMessage "No match for [ \"\"]" + // (match [ "" ] with + // // Different lengths + // | [ 1L; 2L; 3L ] -> "fail") = Builtin.testDerrorMessage "No match for [ \"\"]" - (match [ "" ] with - | [ 1L ] -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"\" with an Int64 pattern" + // (match [ "" ] with + // | [ 1L ] -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"\" with an Int64 pattern" - (match [ [ 1.0 ] ] with - | [ [ 1L ] ] -> "fail") = Builtin.testDerrorMessage - "Cannot match Float value 1.0 with an Int64 pattern" + // (match [ [ 1.0 ] ] with + // | [ [ 1L ] ] -> "fail") = Builtin.testDerrorMessage + // "Cannot match Float value 1.0 with an Int64 pattern" - (match [ [ 1L; 2L ]; [ 3L; 4L ] ] with - | [ [ 1.0; 2.0 ]; [ 3L; 4L ] ] -> "fail" - | [ [ 1L; 2L ]; [ 3L; 4L ] ] -> "fail" - | _ -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 1 with a Float pattern" + // (match [ [ 1L; 2L ]; [ 3L; 4L ] ] with + // | [ [ 1.0; 2.0 ]; [ 3L; 4L ] ] -> "fail" + // | [ [ 1L; 2L ]; [ 3L; 4L ] ] -> "fail" + // | _ -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 1 with a Float pattern" module ListCons = @@ -592,9 +592,9 @@ module List = (match [ 1L; 2L; 3L ] with | head :: rest -> head + (rest |> Stdlib.List.head |> Builtin.unwrap)) = 3L - (match "" with - | head :: rest -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"\" with a List pattern" + // (match "" with + // | head :: rest -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"\" with a List pattern" // head tail let headTail (list: List) : (Int64 * List) = @@ -674,19 +674,19 @@ module Tuple = | (1L, _, true) -> "pass" | _ -> "fail") = "pass" - (match (1L, 'a') with - | "1,a" -> "fail") = Builtin.testDerrorMessage - "Cannot match (Int64, Char) value (1, 'a') with a String pattern" + // (match (1L, 'a') with + // | "1,a" -> "fail") = Builtin.testDerrorMessage + // "Cannot match (Int64, Char) value (1, 'a') with a String pattern" - (match "1,a" with - | (1L, 'a') -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"1,a\" with a Tuple pattern" + // (match "1,a" with + // | (1L, 'a') -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"1,a\" with a Tuple pattern" - (match (1L, 'a') with - | (1.0, 'a') -> "fail" - | (1L, 'a') -> "fail" - | (2L, 'b') -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 1 with a Float pattern" + // (match (1L, 'a') with + // | (1.0, 'a') -> "fail" + // | (1L, 'a') -> "fail" + // | (2L, 'b') -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 1 with a Float pattern" (match (1L, 'a') with | (1L, 'a', true) -> "fail" @@ -731,19 +731,19 @@ module Tuple = | ((1L, _), (_, 2.0)) -> "pass" | _ -> "fail") = "pass" - (match ((1L, 'a'), (true, 2.0)) with - | "1,a,true,2.0" -> "fail") = Builtin.testDerrorMessage - "Cannot match ((Int64, Char), (Bool, Float)) value ((1, 'a'),... with a String pattern" + // (match ((1L, 'a'), (true, 2.0)) with + // | "1,a,true,2.0" -> "fail") = Builtin.testDerrorMessage + // "Cannot match ((Int64, Char), (Bool, Float)) value ((1, 'a'),... with a String pattern" - (match "" with - | ((1.0, 'a'), (true, 2.0)) -> "fail") = Builtin.testDerrorMessage - "Cannot match String value \"\" with a Tuple pattern" + // (match "" with + // | ((1.0, 'a'), (true, 2.0)) -> "fail") = Builtin.testDerrorMessage + // "Cannot match String value \"\" with a Tuple pattern" - (match ((1L, 'a'), (true, 2.0)) with - | ((1.0, 'a'), (true, 2.0)) -> "fail" - | ((1L, 'a'), (true, 2.0)) -> "fail" - | _ -> "fail") = Builtin.testDerrorMessage - "Cannot match Int64 value 1 with a Float pattern" + // (match ((1L, 'a'), (true, 2.0)) with + // | ((1.0, 'a'), (true, 2.0)) -> "fail" + // | ((1L, 'a'), (true, 2.0)) -> "fail" + // | _ -> "fail") = Builtin.testDerrorMessage + // "Cannot match Int64 value 1 with a Float pattern" (match ((1L, 'a'), (true, 2.0)) with | ((_, _), (_, _)) -> "pass" @@ -787,11 +787,11 @@ module Result = | Ok((1L, 'a')) -> "pass" | _ -> "fail") = "pass" - (match Stdlib.Result.Result.Error "failure" with - | "failure" -> "fail" - | Error "failure" -> "fail" - | _ -> "fail") = Builtin.testDerrorMessage - "Cannot match PACKAGE.Darklang.Stdlib.Result.Result value PACKAGE.Da... with a String pattern" + // (match Stdlib.Result.Result.Error "failure" with + // | "failure" -> "fail" + // | Error "failure" -> "fail" + // | _ -> "fail") = Builtin.testDerrorMessage + // "Cannot match PACKAGE.Darklang.Stdlib.Result.Result value PACKAGE.Da... with a String pattern" (match Stdlib.Result.Result.Ok 5.0 with | Ok 6.0 -> "fail" @@ -834,12 +834,12 @@ module Option = | Some((1L, 'a')) -> "pass" | _ -> "fail") = "pass" - (match Stdlib.Option.Option.Some "hello" with - | "hello" -> "fail" - | Some "hello" -> "fail" - | _ -> "fail") = Builtin.testDerrorMessage - // TODO bad error message - "Cannot match PACKAGE.Darklang.Stdlib.Option.Option value PACKAGE.Da... with a String pattern" + // (match Stdlib.Option.Option.Some "hello" with + // | "hello" -> "fail" + // | Some "hello" -> "fail" + // | _ -> "fail") = Builtin.testDerrorMessage + // // TODO bad error message + // "Cannot match PACKAGE.Darklang.Stdlib.Option.Option value PACKAGE.Da... with a String pattern" (match Stdlib.Option.Option.Some 5.0 with | Some 6.0 -> "fail" @@ -848,64 +848,64 @@ module Option = | _ -> "fail") = "pass" -module Errors = - (match "nothing matches" with - | "not this" -> "fail") = Builtin.testDerrorMessage "No match for \"nothing m..." +// module Errors = +// (match "nothing matches" with +// | "not this" -> "fail") = Builtin.testDerrorMessage "No match for \"nothing m..." - (match Builtin.testRuntimeError "cond is error" with - | 5L -> "fail" - | 6L -> "pass" - | var -> "fail") = Builtin.testDerrorMessage "cond is error" +// (match Builtin.testRuntimeError "cond is error" with +// | 5L -> "fail" +// | 6L -> "pass" +// | var -> "fail") = Builtin.testDerrorMessage "cond is error" - (match Builtin.testRuntimeError "cond is error, wildcard" with - | 5L -> 5L - | _ -> 6L) = Builtin.testDerrorMessage "cond is error, wildcard" +// (match Builtin.testRuntimeError "cond is error, wildcard" with +// | 5L -> 5L +// | _ -> 6L) = Builtin.testDerrorMessage "cond is error, wildcard" - (match 1L with - | 1L -> Builtin.testRuntimeError "a" - | 6L -> "pass" - | var -> "fail") = Builtin.testDerrorMessage "a" +// (match 1L with +// | 1L -> Builtin.testRuntimeError "a" +// | 6L -> "pass" +// | var -> "fail") = Builtin.testDerrorMessage "a" - (match 1L with - | 2L -> Builtin.testRuntimeError "a" - | 1L -> "pass" - | var -> "fail") = "pass" +// (match 1L with +// | 2L -> Builtin.testRuntimeError "a" +// | 1L -> "pass" +// | var -> "fail") = "pass" - (match 1L with - | 1L -> "pass" - | 6L -> Builtin.testRuntimeError "a" - | var -> "fail") = "pass" +// (match 1L with +// | 1L -> "pass" +// | 6L -> Builtin.testRuntimeError "a" +// | var -> "fail") = "pass" - (match 1L with - | 2L -> "pass" - | 1L -> Builtin.testRuntimeError "a" - | var -> "fail") = Builtin.testDerrorMessage "a" +// (match 1L with +// | 2L -> "pass" +// | 1L -> Builtin.testRuntimeError "a" +// | var -> "fail") = Builtin.testDerrorMessage "a" - (match 3L with - | 2L -> "pass" - | 1L -> Builtin.testRuntimeError "a" - | var -> "pass") = "pass" +// (match 3L with +// | 2L -> "pass" +// | 1L -> Builtin.testRuntimeError "a" +// | var -> "pass") = "pass" -module TypeErrors = - type TestType = - | NoArgs - | OneArg of Int64 - | TwoArgs of Int64 * Int64 +// module TypeErrors = +// type TestType = +// | NoArgs +// | OneArg of Int64 +// | TwoArgs of Int64 * Int64 - // enum with more pattern params than actual args - (match TestType.NoArgs with - | NoArgs _ -> "wrong number") = Builtin.testDerrorMessage - "NoArgs pattern is expecting 1 field, but NoArgs has 0 fields" +// // enum with more pattern params than actual args +// (match TestType.NoArgs with +// | NoArgs _ -> "wrong number") = Builtin.testDerrorMessage +// "NoArgs pattern is expecting 1 field, but NoArgs has 0 fields" - // enum with fewer pattern params than actual args - (match TestType.OneArg 1L with - | OneArg -> "wrong number") = Builtin.testDerrorMessage - "OneArg pattern is expecting 0 fields, but OneArg has 1 field" +// // enum with fewer pattern params than actual args +// (match TestType.OneArg 1L with +// | OneArg -> "wrong number") = Builtin.testDerrorMessage +// "OneArg pattern is expecting 0 fields, but OneArg has 1 field" - // enum with a single wildcard - (match TestType.TwoArgs(1L, 2L) with - | TwoArgs _ -> "wildcards allowed") = "wildcards allowed" +// // enum with a single wildcard +// (match TestType.TwoArgs(1L, 2L) with +// | TwoArgs _ -> "wildcards allowed") = "wildcards allowed" module GuardClause = @@ -945,26 +945,26 @@ module GuardClause = | (x, y) when x > 0L && Stdlib.String.length y == 5L -> "pass" | _ -> "fail") = "pass" - (match -5L with - | x when y > 0L -> true - | _ -> false) = Builtin.testDerrorMessage "There is no variable named: y" + // (match -5L with + // | x when y > 0L -> true + // | _ -> false) = Builtin.testDerrorMessage "There is no variable named: y" (match 5L with | 5L -> false | x when y > 0L -> true) = false - (match 5L with - | x when x + 1L -> true - | 5L -> false) = Builtin.testDerrorMessage "When condition should be a boolean" + // (match 5L with + // | x when x + 1L -> true + // | 5L -> false) = Builtin.testDerrorMessage "When condition should be a boolean" - (match 5L with - | (x, y) when x > 0L -> true - | _ -> false) = Builtin.testDerrorMessage - "Cannot match Int64 value 5 with a Tuple pattern" + // (match 5L with + // | (x, y) when x > 0L -> true + // | _ -> false) = Builtin.testDerrorMessage + // "Cannot match Int64 value 5 with a Tuple pattern" - (match 5L with - | 2L when x > 2L -> false - | 3L -> true) = Builtin.testDerrorMessage "No match for 5" + // (match 5L with + // | 2L when x > 2L -> false + // | 3L -> true) = Builtin.testDerrorMessage "No match for 5" (match Stdlib.Result.Result.Error 5L with | Ok x when x > 2L -> false diff --git a/backend/testfiles/execution/language/flow-control/_epipe.dark b/backend/testfiles/execution/language/flow-control/epipe.dark similarity index 53% rename from backend/testfiles/execution/language/flow-control/_epipe.dark rename to backend/testfiles/execution/language/flow-control/epipe.dark index c1cc9df50b..1e448a3811 100644 --- a/backend/testfiles/execution/language/flow-control/_epipe.dark +++ b/backend/testfiles/execution/language/flow-control/epipe.dark @@ -8,8 +8,8 @@ let userFn () : Int64 = 6L ([] |> Stdlib.List.push_v0 (Stdlib.Int64.add_v0 1L ((+) 1L 3L))) = [ 5L ] -([] |> Stdlib.List.push_v0 (Builtin.testRuntimeError "err")) = Builtin.testDerrorMessage - "err" +// ([] |> Stdlib.List.push_v0 (Builtin.testRuntimeError "err")) = Builtin.testDerrorMessage +// "err" // general (4L |> (-) 3L) = 1L @@ -24,12 +24,12 @@ let userFn () : Int64 = 6L // lambda in variable (let x = fun a -> a + 1L in (5L |> x |> x |> (+) 3L)) = 10L -(let x = fun a b -> a + 1L in (7L |> x)) = Builtin.testDerrorMessage - "Expected 2 arguments, got 1" +// (let x = fun a b -> a + 1L in (7L |> x)) = Builtin.testDerrorMessage +// "Expected 2 arguments, got 1" -// only lambda might be placed into the variable used in the middle of the pipe -(let x = 1L in (5L |> x |> x |> (+) 3L)) = Builtin.testDerrorMessage - "Expected a function value, got something else: 1" +// // only lambda might be placed into the variable used in the middle of the pipe +// (let x = 1L in (5L |> x |> x |> (+) 3L)) = Builtin.testDerrorMessage +// "Expected a function value, got something else: 1" // dict type Z = { a: List } @@ -51,15 +51,15 @@ type MyEnum = A of Int64 * Int64 * Int64 Stdlib.Option.Option.None -(let x = Stdlib.Option.Option.Some 3L +// (let x = Stdlib.Option.Option.Some 3L - x |> Stdlib.Option.map (fun a -> a) |> Stdlib.Option.map (fun a -> a + 1L)) = Stdlib.Option.Option.Some - 4L +// x |> Stdlib.Option.map (fun a -> a) |> Stdlib.Option.map (fun a -> a + 1L)) = Stdlib.Option.Option.Some +// 4L -(let x = fun x -> Stdlib.Option.map x (fun a -> a) +// (let x = fun x -> Stdlib.Option.map x (fun a -> a) - (Stdlib.Option.Option.Some 3L) |> x |> Stdlib.Option.map (fun a -> a + 1L)) = Stdlib.Option.Option.Some - 4L +// (Stdlib.Option.Option.Some 3L) |> x |> Stdlib.Option.map (fun a -> a + 1L)) = Stdlib.Option.Option.Some +// 4L ((Stdlib.Option.Option.Some 3L) |> Stdlib.Option.withDefault_v0 Stdlib.Option.Option.None @@ -67,28 +67,28 @@ type MyEnum = A of Int64 * Int64 * Int64 ((Stdlib.Result.Result.Ok 3L) |> Stdlib.Result.withDefault_v0 0L |> (+) 3L) = 6L -((Stdlib.Result.Result.Error "err") |> Stdlib.Result.withDefault_v0 0L |> (+) 3L) = 3L +//((Stdlib.Result.Result.Error "err") |> Stdlib.Result.withDefault_v0 0L |> (+) 3L) = 3L -(let x = fun a -> Stdlib.Result.withDefault_v0 a 1L - (Stdlib.Result.Result.Error "err") |> x |> (+) 3L) = 4L +// (let x = fun a -> Stdlib.Result.withDefault_v0 a 1L +// (Stdlib.Result.Result.Error "err") |> x |> (+) 3L) = 4L -(let x = - fun x -> - Stdlib.Option.andThen_v0 (Stdlib.Option.Option.Some x) (fun x -> - Stdlib.Option.Option.Some(1L + x)) +// (let x = +// fun x -> +// Stdlib.Option.andThen_v0 (Stdlib.Option.Option.Some x) (fun x -> +// Stdlib.Option.Option.Some(1L + x)) - 3L |> x) = Stdlib.Option.Option.Some 4L +// 3L |> x) = Stdlib.Option.Option.Some 4L -(let x = - fun x -> Stdlib.Option.andThen_v0 x (fun x -> Stdlib.Option.Option.Some(1L + x)) +// (let x = +// fun x -> Stdlib.Option.andThen_v0 x (fun x -> Stdlib.Option.Option.Some(1L + x)) - 3L |> Stdlib.Option.Option.Some |> x) = Stdlib.Option.Option.Some 4L +// 3L |> Stdlib.Option.Option.Some |> x) = Stdlib.Option.Option.Some 4L (3L |> Stdlib.Option.Option.Some |> Stdlib.Result.fromOption "test") = Stdlib.Result.Result.Ok 3L -(Stdlib.Option.Option.None |> Stdlib.Result.fromOption "test") = Stdlib.Result.Result.Error - "test" +// (Stdlib.Option.Option.None |> Stdlib.Result.fromOption "test") = Stdlib.Result.Result.Error +// "test" module FnName = diff --git a/backend/testfiles/execution/language/_interpreter.dark b/backend/testfiles/execution/language/interpreter.dark similarity index 100% rename from backend/testfiles/execution/language/_interpreter.dark rename to backend/testfiles/execution/language/interpreter.dark diff --git a/backend/testfiles/execution/stdlib/_list.dark b/backend/testfiles/execution/stdlib/_list.dark deleted file mode 100644 index 83a45162fe..0000000000 --- a/backend/testfiles/execution/stdlib/_list.dark +++ /dev/null @@ -1,515 +0,0 @@ -// CLEANUP the following tests should fail on having mixed types -//[1; 2.3] = Builtin.testDerrorMessage "Cannot form a list of mixed types - the 2nd element does not match the type of previous elements" -//[(1,10);10;(3,30)] = Builtin.testDerrorMessage "Cannot form a list of mixed types ..." -//[(1,10);(2,20);(3,30,40)] = Builtin.testDerrorMessage "Cannot form a list of mixed types" - - -Stdlib.List.all_v0 [] (fun item -> item < 3L) = true -Stdlib.List.all_v0 [ 2L ] (fun item -> item < 3L) = true -Stdlib.List.all_v0 [ 1L; 2L ] (fun item -> item < 3L) = true -Stdlib.List.all_v0 [ 4L ] (fun item -> item < 3L) = false -Stdlib.List.all_v0 [ 1L; 4L ] (fun item -> item < 3L) = false - - -Stdlib.List.append_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 2L; 3L; 4L; 5L; 6L ] - -Stdlib.List.append_v0 [ 3L; 4L ] [ 5L; 6L ] = [ 3L; 4L; 5L; 6L ] -Stdlib.List.append_v0 [ 1L ] [ 2L ] = [ 1L; 2L ] -Stdlib.List.append_v0 [] [] = [] - - -Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] -3L = [ "a"; "b"; "c"; "d" ] - -Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "d" ] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] -1L = [ 1L; 2L; 3L; 4L ] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 0L = [ 1L; 2L; 3L; 4L ] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 440737095L = [] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 1184467440737095L = [] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 2L = [ 3L; 4L ] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 4L = [] -Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 5L = [] -Stdlib.List.drop_v0 [ 3L; 3L; 3L ] 0L = [ 3L; 3L; 3L ] -Stdlib.List.drop_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [] -Stdlib.List.drop_v0 [ 5L ] 4L = [] -Stdlib.List.drop_v0 [] 4L = [] - -Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage - "If only supports Booleans" - -Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 3L; 4L ] - -Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item >= 1L) = [] - -Stdlib.List.dropWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 5L; 2L; 2L ] - -Stdlib.List.dropWhile_v0 [] (fun item -> item < 3L) = [] - -Stdlib.List.empty_v0 = [] - -(Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> Builtin.testIncrementSideEffectCounter ()) - - Builtin.testSideEffectCount ()) = 3L - -(Stdlib.List.iter [ 1L; 2L; 3L; 4L; 5L ] (fun x -> - if x % 2L == 0L then - Builtin.testIncrementSideEffectCounter ()) - - Builtin.testSideEffectCount ()) = 2L - -(Stdlib.List.iter [] (fun x -> Builtin.testIncrementSideEffectCounter ()) - - Builtin.testSideEffectCount ()) = 0L - -(Stdlib.List.iter [ 10L; 20L; 30L ] (fun x -> - Builtin.testIncrementSideEffectCounter () - Builtin.testIncrementSideEffectCounter ()) - - Builtin.testSideEffectCount ()) = 6L - -(Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> - if x > 2L then - Builtin.testIncrementSideEffectCounter ()) - - Builtin.testSideEffectCount ()) = 1L - - -Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> - match item with - | 1L -> Stdlib.Option.Option.None - | 2L -> false - | 3L -> true) = Builtin.testDerrorMessage "If only supports Booleans" - -Stdlib.List.filter [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage - "If only supports Booleans" - -Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> - match item with - | 1L -> true - | 2L -> false - | 3L -> true) = [ 1L; 3L ] - -Stdlib.List.filter [] (fun item -> true) = [] -Stdlib.List.filter [ -20L; 5L; 9L ] (fun x -> x > 20L) = [] -Stdlib.List.filter [] (fun item -> "a") = [] - -Stdlib.List.filterMap_v0 [ 1L; 2L; 3L ] (fun item -> - if item == 2L then - Stdlib.Option.Option.None - else - (Stdlib.Option.Option.Some(item * 2L))) = [ 2L; 6L ] - -Stdlib.List.filterMap_v0 [] (fun item -> 0L) = [] - -Stdlib.List.findFirst [ 1L; 2L; 3L ] (fun x -> x > 5L) = Stdlib.Option.Option.None -Stdlib.List.findFirst [] (fun x -> x) = Stdlib.Option.Option.None - -Stdlib.List.findFirst [ 1L; 2L; 3L; 1L; 4L ] (fun x -> x > 1L) = Stdlib.Option.Option.Some - 2L - -Stdlib.List.findFirst [ 0L; 5L; -6L; -10L ] (fun x -> x < 0L) = Stdlib.Option.Option.Some - -6L - -Stdlib.List.findFirst [ 1L; -33L; 3L; -2L; 12L ] (fun x -> (x < 0L && x % 2L == 0L)) = Stdlib.Option.Option.Some - -2L - -// CLEANUP once DList contains typeRefs, this test may be uncommented and the error message updated: -// Stdlib.List.flatten_v0 [1;2;3] = -// Builtin.testRuntimeError "In List.flatten's 1st argument (`list`), the value should be a List>. However, a List ([1; 2; 3]) was passed instead.\n\nExpected: List>\nActual: List: [1; 2; 3]" -Stdlib.List.flatten_v0 [ [ 1L ]; [ 2L ]; [ 3L ] ] = [ 1L; 2L; 3L ] - -Stdlib.List.flatten_v0 [ [ 1L ]; [ [ 2L; 3L ] ] ] = Builtin.testDerrorMessage - "Could not merge types List>> and List>" - -Stdlib.List.flatten_v0 [ [ [] ] ] = [ [] ] -Stdlib.List.flatten_v0 [ [] ] = [] -Stdlib.List.flatten_v0 [] = [] - -Stdlib.List.fold_v0 [ "a"; "b"; "c"; "d" ] "x" (fun accum curr -> accum ++ curr) = "xabcd" - -Stdlib.List.fold_v0 [ 1L; 2L; 3L; 4L; 5L ] [] (fun accum curr -> - Stdlib.List.pushBack_v0 accum (curr + 1L)) = [ 2L; 3L; 4L; 5L; 6L ] - -Stdlib.List.fold_v0 [] [] (fun accum curr -> 5L) = [] - -Stdlib.List.getAt [ "a"; "b"; "c"; "d" ] -1L = Stdlib.Option.Option.None -Stdlib.List.getAt [ 0L ] 1L = Stdlib.Option.Option.None -Stdlib.List.getAt [] 1L = Stdlib.Option.Option.None -Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 6018427387902L = Stdlib.Option.Option.None - -Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Option.Option.Some 1L - -Stdlib.List.getAt [ 3L; 3L; 3L ] -5L = Stdlib.Option.Option.None -Stdlib.List.getAt [ 3L; 3L; 3L ] 2147483648L = Stdlib.Option.Option.None - -Stdlib.List.head [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 1L - -Stdlib.List.head [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage - "test" - -Stdlib.List.head [] = Stdlib.Option.Option.None - -Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> v - i) = [ 3L; 1L; -1L ] - -Stdlib.List.indexedMap_v0 [] (fun i v -> v - i) = [] - -Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> i) = [ 0L; 1L; 2L ] - -Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 2L; 5L; 3L; 6L ] - -Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L ] = [ 1L; 4L; 2L; 3L ] -Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [] = [ 1L; 2L; 3L ] -Stdlib.List.interleave_v0 [ 1L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 5L; 6L ] -Stdlib.List.interleave_v0 [] [ 4L; 5L; 6L ] = [ 4L; 5L; 6L ] -Stdlib.List.interleave_v0 [] [] = [] - -Stdlib.List.interleave_v0 [ "a"; "b"; "c" ] [ 0L ] = Builtin.testDerrorMessage - "Could not merge types List and List" - -Stdlib.List.interpose_v0 [ 1L; 2L; 3L ] 5L = [ 1L; 5L; 2L; 5L; 3L ] -Stdlib.List.interpose_v0 [ 1L ] 5L = [ 1L ] -Stdlib.List.interpose_v0 [] 5L = [] - -Stdlib.List.interpose_v0 [ "a"; "b"; "c" ] 0L = Builtin.testDerrorMessage - "Could not merge types List and List" - -Stdlib.List.isEmpty_v0 [ 1L ] = false -Stdlib.List.isEmpty_v0 [] = true - -Stdlib.List.last [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 3L - -Stdlib.List.last [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage - "test" - -Stdlib.List.last [] = Stdlib.Option.Option.None - -Stdlib.List.length_v0 [ 1L; 2L; 3L ] = 3L -Stdlib.List.length_v0 [] = 0L - -Stdlib.List.map_v0 (Stdlib.List.range_v0 1L 5L) (fun x -> x + 1L) = [ 2L - 3L - 4L - 5L - 6L ] - -Stdlib.List.map_v0 [ 1L; 2L; 3L ] (fun x -> - Stdlib.Bool.and_v0 - (Stdlib.Int64.greaterThanOrEqualTo_v0 x 0L) - (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = [ true; true; true ] - -Stdlib.List.map_v0 [ 1L; 2L ] (fun x -> x + 1L) = [ 2L; 3L ] -Stdlib.List.map_v0 [] (fun x -> x + 1L) = [] - -Stdlib.List.map2_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.Some - [ 9L; 18L; 27L ] - -Stdlib.List.map2_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.None - -Stdlib.List.map2_v0 [] [] (fun a b -> a - b) = Stdlib.Option.Option.Some [] - -Stdlib.List.map2shortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L - 18L - 27L ] - -Stdlib.List.map2shortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L - 18L ] - -Stdlib.List.map2shortest_v0 [] [ 1L; 2L; 3L ] (fun a b -> a - b) = [] -Stdlib.List.map2shortest_v0 [ 1L; 2L; 3L ] [] (fun a b -> a - b) = [] - -Stdlib.List.member_v0 [ 1L; 2L; 3L ] 2L = true -Stdlib.List.member_v0 [ 1L; 2L; 3L ] 4L = false -Stdlib.List.member_v0 [] 1L = false - -Stdlib.List.partition_v0 [ -20L; 5L; 9L ] (fun x -> x > 0L) = ([ 5L; 9L ], [ -20L ]) - -Stdlib.List.partition_v0 [] (fun item -> true) = ([], []) -Stdlib.List.partition_v0 [] (fun item -> "a") = ([], []) - -Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> - match item with - | 1L -> true - | 2L -> false - | 3L -> true) = ([ 1L; 3L ], [ 2L ]) - -Stdlib.List.partition_v0 [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage - "If only supports Booleans" - - -Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> - match item with - | 1L -> Stdlib.Option.Option.None - | 2L -> false - | 3L -> true) = Builtin.testDerrorMessage "If only supports Booleans" - -Stdlib.List.pushBack_v0 [ 2L; 3L ] 1L = [ 2L; 3L; 1L ] -Stdlib.List.pushBack_v0 [] 1L = [ 1L ] - -Stdlib.List.push_v0 [ 2L; 3L ] 1L = [ 1L; 2L; 3L ] -Stdlib.List.push_v0 [] 1L = [ 1L ] - -Stdlib.List.randomElement_v0 [ 1L ] = Stdlib.Option.Option.Some 1L - -Stdlib.List.randomElement_v0 [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage - "test" - -Stdlib.List.randomElement_v0 [] = Stdlib.Option.Option.None - -Stdlib.List.range_v0 -1L 0L = [ -1L; 0L ] - -Stdlib.List.range_v0 -5L 5L = [ -5L; -4L; -3L; -2L; -1L; 0L; 1L; 2L; 3L; 4L; 5L ] - -Stdlib.List.range_v0 5L 0L = [] - -Stdlib.List.repeat_v0 0L 1L = Stdlib.Result.Result.Ok [] - -Stdlib.List.repeat_v0 1L "a" = Stdlib.Result.Result.Ok [ "a" ] - -Stdlib.List.repeat_v0 1L 1L = Stdlib.Result.Result.Ok [ 1L ] - -Stdlib.List.repeat_v0 3L 1L = Stdlib.Result.Result.Ok [ 1L; 1L; 1L ] - -Stdlib.List.repeat_v0 3L 3L = Stdlib.Result.Result.Ok [ 3L; 3L; 3L ] - -Stdlib.List.repeat_v0 5L "a" = Stdlib.Result.Result.Ok [ "a"; "a"; "a"; "a"; "a" ] - -Stdlib.List.repeat_v0 -4L "a" = Stdlib.Result.Result.Error - "Expected `times` to be positive, but it was `-4`" - -Stdlib.List.repeat_v0 3L [ 1L; 2L; 3L ] = Stdlib.Result.Result.Ok - [ [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ] ] - -Stdlib.List.repeat_v0 3L [] = Stdlib.Result.Result.Ok [ []; []; [] ] - -Stdlib.List.reverse_v0 [ "a"; "b"; "c"; "d" ] = [ "d"; "c"; "b"; "a" ] - -Stdlib.List.reverse_v0 [ 5L; 4L; 3L; 2L; 1L ] = [ 1L; 2L; 3L; 4L; 5L ] - -Stdlib.List.reverse_v0 [] = [] - -Stdlib.List.singleton_v0 1L = [ 1L ] - -Stdlib.List.sortBy_v0 [ 6L; 2L; 8L; 3L ] (fun x -> 0L - x) = [ 8L; 6L; 3L; 2L ] - -Stdlib.List.sortBy_v0 [] (fun x -> 0L - x) = [] - -Stdlib.List.sort_v0 [ "6"; "2"; "8"; "3" ] = [ "2"; "3"; "6"; "8" ] -Stdlib.List.sort_v0 [ 6L; 2L; 8L; 3L ] = [ 2L; 3L; 6L; 8L ] -Stdlib.List.sort_v0 [] = [] - -// CLEANUP: it should be a type error on the function not returning an Int64 -Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 0.1) = Builtin.testDerrorMessage - // "Function return value should be an Int64. However, a Float (0.1) was returned instead.\n\nExpected: Int64\nActual: a Float: 0.1" - "Both values must be the same type" - -Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 3L) = Stdlib.Result.Result.Error - "Expected comparator function to return -1, 0, or 1, but it returned 3" - -// CLEANUP: it should be a type error on the function not returning an Int64 -Stdlib.List.sortByComparator_v0 [ 1L; 2L; 3L ] (fun a b -> "㧑༷釺") = Builtin.testDerrorMessage - // "Function return value should be an Int64. However, a String (\"㧑༷釺\") was returned instead.\n\nExpected: Int64\nActual: a String: \"㧑༷釺\"" - "Both values must be the same type" - -Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> - if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok - [ 1L; 2L; 3L ] - -Stdlib.List.sortByComparator_v0 [] (fun a b -> - if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok [] - -Stdlib.List.sortByComparator_v0 - [ 3L - 1L - 2L - 67L - 3L - -1L - 6L - 3L - 5L - 6L - 2L - 5L - 63L - 2L - 3L - 5L - -1L - -1L - -1L ] - (fun a b -> if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok - [ -1L - -1L - -1L - -1L - 1L - 2L - 2L - 2L - 3L - 3L - 3L - 3L - 5L - 5L - 5L - 6L - 6L - 63L - 67L ] - -// CLEANUP this error message is not ideal in 2 ways: -// - The error does not provide context that the issue is with the fn specifically -// - it seems to be from the perspective of the lambda -// (I'm a lambda and I'm expecting 2 arguments, but I got 1!!) -// rather than from the perspective of the function it's being used in -Stdlib.List.sortByComparator_v0 [ 6.0; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage - "Expected 1 arguments, got 2" - -Stdlib.List.tail_v0 [ 10L; 20L; 30L; 40L ] = Stdlib.Option.Option.Some - [ 20L; 30L; 40L ] - -Stdlib.List.tail_v0 [] = Stdlib.Option.Option.None - -Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] -1L = [] - -Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 2147483648L = [ "a"; "b"; "c"; "d" ] - -Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "a"; "b"; "c" ] -Stdlib.List.take_v0 [ 3L; 3L; 3L ] 0L = [] - -Stdlib.List.take_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [ 5L; 4L; 3L; 2L; 1L ] - -Stdlib.List.take_v0 [ 5L ] 4L = [ 5L ] -Stdlib.List.take_v0 [] 4L = [] - -//TODO: better error message -Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage - "If only supports Booleans" - -Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 1L) = [] - -Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 1L; 2L ] - -Stdlib.List.takeWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 1L ] -Stdlib.List.takeWhile_v0 [] (fun item -> item < 3L) = [] -// it isn't specified which is the right value to keep when there are duplicates -Stdlib.List.uniqueBy_v0 [ 1L; 2L; 3L; 4L ] (fun x -> Stdlib.Int64.divide_v0 x 2L) = [ 1L - 2L - 4L ] - -Stdlib.List.uniqueBy_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x) = [ 1L; 2L; 3L; 4L ] - -Stdlib.List.uniqueBy_v0 [ 1L; 1L; 1L; 1L ] (fun x -> x) = [ 1L ] - -Stdlib.List.uniqueBy_v0 [ 7L; 42L; 7L; 2L; 10L ] (fun x -> x) = [ 2L; 7L; 10L; 42L ] - -Stdlib.List.uniqueBy_v0 [] (fun x -> x) = [] - -Stdlib.List.uniqueBy_v0 [ 6L; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage - "Could not merge types List and List" - -Stdlib.List.unique_v0 [ 1L; 2L; 3L; 4L ] = [ 1L; 2L; 3L; 4L ] -Stdlib.List.unique_v0 [ 1L; 1L; 1L; 1L ] = [ 1L ] - -Stdlib.List.unique_v0 [ 7L; 42L; 7L; 2L; 10L ] = [ 2L; 7L; 10L; 42L ] - -Stdlib.List.unique_v0 [] = [] -// TODO: more tests, with values of more complex types - -Stdlib.List.unzip_v0 [ (1L, 10L); (2L, 20L); (3L, 30L) ] = ([ 1L; 2L; 3L ], - [ 10L; 20L; 30L ]) - -Stdlib.List.unzip_v0 [ (10L, 6L) ] = ([ 10L ], [ 6L ]) - -Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = [ (10L, 1L) - (20L, 2L) - (30L, 3L) ] - -Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ "a"; "bc"; "d" ] = [ (10L, "a") - (20L, "bc") - (30L, "d") ] - -Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = [ (10L, 1L); (20L, 2L) ] - -Stdlib.List.zipShortest_v0 [ 1L; 2L; 3L ] [ 10L; 20L ] = [ (1L, 10L); (2L, 20L) ] - -Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ "a"; "bc"; "d" ] = [ (10L, "a") - (20L, "bc") ] - -Stdlib.List.zipShortest_v0 [ "a"; "bc"; "d" ] [ 10L; 20L ] = [ ("a", 10L) - ("bc", 20L) ] - -Stdlib.List.zipShortest_v0 [ "b"; "v"; "z" ] [] = [] -Stdlib.List.zipShortest_v0 [] [ "b"; "v"; "z" ] = [] - - -Stdlib.List.zip_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some - [ (10L, 1L); (20L, 2L); (30L, 3L) ] - -Stdlib.List.zip_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.None - -Stdlib.List.zip_v0 [] [] = Stdlib.Option.Option.Some [] - -Stdlib.List.zip_v0 [ Builtin.testRuntimeError "msg" ] [ Some "" ] = Builtin.testDerrorMessage - "msg" - - -Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> - Stdlib.Int64.mod_v0 x 2L) = [ (1L, [ 1L; 3L; 5L ]); (0L, [ 2L; 4L ]) ] - -Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> - Stdlib.Int64.mod_v0 x 2L) = [ (1L, [ 1L; 3L; 5L ]); (0L, [ 2L; 4L ]) ] - -Stdlib.List.groupByWithKey_v0 - [ "apple"; "banana"; "avocado"; "grape"; "apricot" ] - (fun s -> Stdlib.String.first_v0 s 1L) = [ ("a", [ "apple"; "avocado"; "apricot" ]) - ("b", [ "banana" ]) - ("g", [ "grape" ]) ] - -Stdlib.List.groupByWithKey_v0 [ 'a'; 'b'; 'c'; 'a'; 'b' ] (fun c -> c) = [ ('a', - [ 'a' - 'a' ]) - ('b', - [ 'b' - 'b' ]) - ('c', - [ 'c' ]) ] - -Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> - Stdlib.Int64.mod_v0 x 2L == 0L) = [ (false, [ 1L; 3L; 5L ]); (true, [ 2L; 4L ]) ] - -Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> - ((Stdlib.Int64.mod_v0 x 2L), "test")) = [ ((1L, "test"), [ 1L; 3L; 5L ]) - ((0L, "test"), [ 2L; 4L ]) ] - -Stdlib.List.groupByWithKey_v0 [] (fun x -> x) = [] - - -Stdlib.List.dropLast [ 1L; 2L; 3L; 4L; 5L ] = [ 1L; 2L; 3L; 4L ] -Stdlib.List.dropLast [ 1L ] = [] -Stdlib.List.dropLast [] = [] - -Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L ] 2L = Stdlib.Result.Result.Ok - [ [ 1L; 2L ]; [ 3L; 4L ]; [ 5L ] ] - -Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L; 6L ] 3L = Stdlib.Result.Result.Ok - [ [ 1L; 2L; 3L ]; [ 4L; 5L; 6L ] ] - -Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L ] 1L = Stdlib.Result.Result.Ok - [ [ 1L ]; [ 2L ]; [ 3L ] ] - -Stdlib.List.chunkBySize_v0 [ 1L; 2L ] 3L = Stdlib.Result.Result.Ok [ [ 1L; 2L ] ] - -Stdlib.List.chunkBySize_v0 [] 4L = Stdlib.Result.Result.Ok [] - -Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Result.Result.Error - Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero - -Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] -1L = Stdlib.Result.Result.Error - Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero - - -Stdlib.List.splitLast [] = Stdlib.Option.Option.None -Stdlib.List.splitLast [ 1L ] = Stdlib.Option.Option.Some(([], 1L)) -Stdlib.List.splitLast [ 1L; 2L ] = Stdlib.Option.Option.Some(([ 1L ], 2L)) -Stdlib.List.splitLast [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some(([ 1L; 2L ], 3L)) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_nomodule.dark b/backend/testfiles/execution/stdlib/_nomodule.dark index 6007ee8971..c8ca2c31f2 100644 --- a/backend/testfiles/execution/stdlib/_nomodule.dark +++ b/backend/testfiles/execution/stdlib/_nomodule.dark @@ -1,5 +1,3 @@ -// CLEANUP move all these to LibMisc - module Equals = type ERec = { x: Int64; y: Int64 } type ERec2 = ERec diff --git a/backend/testfiles/execution/stdlib/_bool.dark b/backend/testfiles/execution/stdlib/bool.dark similarity index 100% rename from backend/testfiles/execution/stdlib/_bool.dark rename to backend/testfiles/execution/stdlib/bool.dark diff --git a/backend/testfiles/execution/stdlib/_char.dark b/backend/testfiles/execution/stdlib/char.dark similarity index 86% rename from backend/testfiles/execution/stdlib/_char.dark rename to backend/testfiles/execution/stdlib/char.dark index eec0b5775b..9cf84bacb9 100644 --- a/backend/testfiles/execution/stdlib/_char.dark +++ b/backend/testfiles/execution/stdlib/char.dark @@ -134,39 +134,23 @@ Stdlib.Char.isASCII_v0 ' ' = true Stdlib.Char.isASCII_v0 '\t' = true -Stdlib.Char.toAsciiCode 'a' = Stdlib.Option.Option.Some 97L - -Stdlib.Char.toAsciiCode 'A' = Stdlib.Option.Option.Some 65L - -Stdlib.Char.toAsciiCode 'á' = Stdlib.Option.Option.Some 225L - -Stdlib.Char.toAsciiCode 'Á' = Stdlib.Option.Option.Some 193L - -Stdlib.Char.toAsciiCode '3' = Stdlib.Option.Option.Some 51L - -Stdlib.Char.toAsciiCode (smiley ()) = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'ż' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'Ż' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'ó' = Stdlib.Option.Option.Some 243L - -Stdlib.Char.toAsciiCode 'Ó' = Stdlib.Option.Option.Some 211L - -Stdlib.Char.toAsciiCode 'ł' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'Ł' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode (hand ()) = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'ჾ' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode 'Ჾ' = Stdlib.Option.Option.None - -Stdlib.Char.toAsciiCode ' ' = Stdlib.Option.Option.Some 32L - -Stdlib.Char.toAsciiCode '\t' = Stdlib.Option.Option.Some 9L +//Stdlib.Char.toAsciiCode 'a' = Stdlib.Option.Option.Some 97L +//Stdlib.Char.toAsciiCode 'A' = Stdlib.Option.Option.Some 65L +//Stdlib.Char.toAsciiCode 'á' = Stdlib.Option.Option.Some 225L +//Stdlib.Char.toAsciiCode 'Á' = Stdlib.Option.Option.Some 193L +//Stdlib.Char.toAsciiCode '3' = Stdlib.Option.Option.Some 51L +// Stdlib.Char.toAsciiCode (smiley ()) = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode 'ż' = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode 'Ż' = Stdlib.Option.Option.None +//Stdlib.Char.toAsciiCode 'ó' = Stdlib.Option.Option.Some 243L +//Stdlib.Char.toAsciiCode 'Ó' = Stdlib.Option.Option.Some 211L +// Stdlib.Char.toAsciiCode 'ł' = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode 'Ł' = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode (hand ()) = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode 'ჾ' = Stdlib.Option.Option.None +// Stdlib.Char.toAsciiCode 'Ჾ' = Stdlib.Option.Option.None +//Stdlib.Char.toAsciiCode ' ' = Stdlib.Option.Option.Some 32L +//Stdlib.Char.toAsciiCode '\t' = Stdlib.Option.Option.Some 9L Stdlib.Char.isLessThan_v0 'a' 'b' = true diff --git a/backend/testfiles/execution/stdlib/ints/_int8.dark b/backend/testfiles/execution/stdlib/ints/_int8.dark index 2f5e16a22e..9910d25f35 100644 --- a/backend/testfiles/execution/stdlib/ints/_int8.dark +++ b/backend/testfiles/execution/stdlib/ints/_int8.dark @@ -1,7 +1,7 @@ Stdlib.Int8.absoluteValue_v0 -5y = 5y Stdlib.Int8.absoluteValue_v0 5y = 5y -Stdlib.Int8.absoluteValue_v0 -128y = Builtin.testDerrorMessage "Out of range" +//Stdlib.Int8.absoluteValue_v0 -128y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.max_v0 5y 6y = 6y Stdlib.Int8.max_v0 10y 1y = 10y @@ -32,7 +32,7 @@ Stdlib.Int8.negate_v0 5y = -5y Stdlib.Int8.negate_v0 0y = 0y Stdlib.Int8.negate_v0 -0y = 0y -Stdlib.Int8.negate_v0 -128y = Builtin.testDerrorMessage "Out of range" +//Stdlib.Int8.negate_v0 -128y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.remainder_v0 15y 6y = Stdlib.Result.Result.Ok 3y @@ -44,7 +44,7 @@ Stdlib.Int8.remainder_v0 -20y -8y = Stdlib.Result.Result.Ok -4y Stdlib.Int8.remainder_v0 -15y 6y = Stdlib.Result.Result.Ok -3y -Stdlib.Int8.remainder_v0 5y 0y = Builtin.testDerrorMessage "Division by zero" +//Stdlib.Int8.remainder_v0 5y 0y = Builtin.testDerrorMessage "Division by zero" Stdlib.Int8.add_v0 10y 9y = 19y @@ -56,13 +56,13 @@ Stdlib.Int8.add_v0 -55y 55y = 0y Stdlib.Int8.add_v0 55y 55y = 110y Stdlib.Int8.add_v0 PACKAGE.Darklang.Test.Constants.int8Const 5y = 10y -Stdlib.Int8.add_v0 127y 1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 127y 1y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.add_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.add_v0 -100y -30y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 -100y -30y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.add_v0 100y 30y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 100y 30y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.subtract_v0 10y 9y = 1y Stdlib.Int8.subtract_v0 88y 9y = 79y @@ -70,16 +70,16 @@ Stdlib.Int8.subtract_v0 0y 1y = -1y Stdlib.Int8.subtract_v0 1y 0y = 1y Stdlib.Int8.subtract_v0 -55y -55y = 0y -Stdlib.Int8.subtract_v0 -2y 127y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.subtract_v0 -2y 127y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.subtract_v0 -55y 100y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.subtract_v0 -55y 100y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.multiply_v0 8y 8y = 64y Stdlib.Int8.multiply_v0 1y 0y = 0y -Stdlib.Int8.multiply_v0 64y 2y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.multiply_v0 64y 2y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.multiply_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.multiply_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.power_v0 2y 3y = 8y Stdlib.Int8.power_v0 0y 1y = 0y @@ -90,11 +90,11 @@ Stdlib.Int8.power_v0 -1y 5y = -1y Stdlib.Int8.power_v0 -1y 6y = 1y Stdlib.Int8.power_v0 1y 127y = 1y -Stdlib.Int8.power_v0 3y 5y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.power_v0 3y 5y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.power_v0 120y 20y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.power_v0 120y 20y = Builtin.testDerrorMessage "Out of range" -Stdlib.Int8.power_v0 2y -3y = Builtin.testDerrorMessage "Negative exponent" +// Stdlib.Int8.power_v0 2y -3y = Builtin.testDerrorMessage "Negative exponent" Stdlib.Int8.divide_v0 10y 5y = 2y @@ -102,9 +102,9 @@ Stdlib.Int8.divide_v0 17y 3y = 5y Stdlib.Int8.divide_v0 -8y 5y = -1y Stdlib.Int8.divide_v0 0y 1y = 0y -Stdlib.Int8.divide_v0 1y 0y = Builtin.testDerrorMessage "Division by zero" +// Stdlib.Int8.divide_v0 1y 0y = Builtin.testDerrorMessage "Division by zero" -Stdlib.Int8.divide_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.divide_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" Stdlib.Int8.greaterThan_v0 20y 1y = true @@ -152,9 +152,9 @@ Stdlib.Int8.mod_v0 -1y 2y = 1y Stdlib.Int8.mod_v0 -128y 53y = 31y Stdlib.Int8.mod_v0 127y 3y = 1y -Stdlib.Int8.mod_v0 5y 0y = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.Int8.mod_v0 5y 0y = Builtin.testDerrorMessage "Zero modulus" -Stdlib.Int8.mod_v0 5y -5y = Builtin.testDerrorMessage "Negative modulus" +// Stdlib.Int8.mod_v0 5y -5y = Builtin.testDerrorMessage "Negative modulus" (Stdlib.List.range_v0 1L 5L) |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 1y 2y) diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/list.dark new file mode 100644 index 0000000000..7af6689535 --- /dev/null +++ b/backend/testfiles/execution/stdlib/list.dark @@ -0,0 +1,515 @@ +// CLEANUP the following tests should fail on having mixed types +//[1; 2.3] = Builtin.testDerrorMessage "Cannot form a list of mixed types - the 2nd element does not match the type of previous elements" +//[(1,10);10;(3,30)] = Builtin.testDerrorMessage "Cannot form a list of mixed types ..." +//[(1,10);(2,20);(3,30,40)] = Builtin.testDerrorMessage "Cannot form a list of mixed types" + + +// Stdlib.List.all_v0 [] (fun item -> item < 3L) = true +// Stdlib.List.all_v0 [ 2L ] (fun item -> item < 3L) = true +// Stdlib.List.all_v0 [ 1L; 2L ] (fun item -> item < 3L) = true +// Stdlib.List.all_v0 [ 4L ] (fun item -> item < 3L) = false +// Stdlib.List.all_v0 [ 1L; 4L ] (fun item -> item < 3L) = false + + +Stdlib.List.append_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 2L; 3L; 4L; 5L; 6L ] + +Stdlib.List.append_v0 [ 3L; 4L ] [ 5L; 6L ] = [ 3L; 4L; 5L; 6L ] +Stdlib.List.append_v0 [ 1L ] [ 2L ] = [ 1L; 2L ] +Stdlib.List.append_v0 [] [] = [] + + +Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] -3L = [ "a"; "b"; "c"; "d" ] + +//Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "d" ] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] -1L = [ 1L; 2L; 3L; 4L ] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 0L = [ 1L; 2L; 3L; 4L ] +//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 440737095L = [] +//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 1184467440737095L = [] +//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 2L = [ 3L; 4L ] +//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 4L = [] +//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 5L = [] +Stdlib.List.drop_v0 [ 3L; 3L; 3L ] 0L = [ 3L; 3L; 3L ] +//Stdlib.List.drop_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [] +//Stdlib.List.drop_v0 [ 5L ] 4L = [] +Stdlib.List.drop_v0 [] 4L = [] + +// Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage +// "If only supports Booleans" + +// Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 3L; 4L ] + +// Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item >= 1L) = [] + +// Stdlib.List.dropWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 5L; 2L; 2L ] + +// Stdlib.List.dropWhile_v0 [] (fun item -> item < 3L) = [] + +Stdlib.List.empty_v0 = [] + +// (Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> Builtin.testIncrementSideEffectCounter ()) + +// Builtin.testSideEffectCount ()) = 3L + +// (Stdlib.List.iter [ 1L; 2L; 3L; 4L; 5L ] (fun x -> +// if x % 2L == 0L then +// Builtin.testIncrementSideEffectCounter ()) + +// Builtin.testSideEffectCount ()) = 2L + +// (Stdlib.List.iter [] (fun x -> Builtin.testIncrementSideEffectCounter ()) + +// Builtin.testSideEffectCount ()) = 0L + +// (Stdlib.List.iter [ 10L; 20L; 30L ] (fun x -> +// Builtin.testIncrementSideEffectCounter () +// Builtin.testIncrementSideEffectCounter ()) + +// Builtin.testSideEffectCount ()) = 6L + +// (Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> +// if x > 2L then +// Builtin.testIncrementSideEffectCounter ()) + +// Builtin.testSideEffectCount ()) = 1L + + +// Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> +// match item with +// | 1L -> Stdlib.Option.Option.None +// | 2L -> false +// | 3L -> true) = Builtin.testDerrorMessage "If only supports Booleans" + +// Stdlib.List.filter [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage +// "If only supports Booleans" + +// Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> +// match item with +// | 1L -> true +// | 2L -> false +// | 3L -> true) = [ 1L; 3L ] + +// Stdlib.List.filter [] (fun item -> true) = [] +// Stdlib.List.filter [ -20L; 5L; 9L ] (fun x -> x > 20L) = [] +// Stdlib.List.filter [] (fun item -> "a") = [] + +// Stdlib.List.filterMap_v0 [ 1L; 2L; 3L ] (fun item -> +// if item == 2L then +// Stdlib.Option.Option.None +// else +// (Stdlib.Option.Option.Some(item * 2L))) = [ 2L; 6L ] + +// Stdlib.List.filterMap_v0 [] (fun item -> 0L) = [] + +// Stdlib.List.findFirst [ 1L; 2L; 3L ] (fun x -> x > 5L) = Stdlib.Option.Option.None +// Stdlib.List.findFirst [] (fun x -> x) = Stdlib.Option.Option.None + +// Stdlib.List.findFirst [ 1L; 2L; 3L; 1L; 4L ] (fun x -> x > 1L) = Stdlib.Option.Option.Some +// 2L + +// Stdlib.List.findFirst [ 0L; 5L; -6L; -10L ] (fun x -> x < 0L) = Stdlib.Option.Option.Some +// -6L + +// Stdlib.List.findFirst [ 1L; -33L; 3L; -2L; 12L ] (fun x -> (x < 0L && x % 2L == 0L)) = Stdlib.Option.Option.Some +// -2L + +// CLEANUP once DList contains typeRefs, this test may be uncommented and the error message updated: +// Stdlib.List.flatten_v0 [1;2;3] = +// Builtin.testRuntimeError "In List.flatten's 1st argument (`list`), the value should be a List>. However, a List ([1; 2; 3]) was passed instead.\n\nExpected: List>\nActual: List: [1; 2; 3]" +Stdlib.List.flatten_v0 [ [ 1L ]; [ 2L ]; [ 3L ] ] = [ 1L; 2L; 3L ] + +// Stdlib.List.flatten_v0 [ [ 1L ]; [ [ 2L; 3L ] ] ] = Builtin.testDerrorMessage +// "Could not merge types List>> and List>" + +Stdlib.List.flatten_v0 [ [ [] ] ] = [ [] ] +Stdlib.List.flatten_v0 [ [] ] = [] +Stdlib.List.flatten_v0 [] = [] + +// Stdlib.List.fold_v0 [ "a"; "b"; "c"; "d" ] "x" (fun accum curr -> accum ++ curr) = "xabcd" + +// Stdlib.List.fold_v0 [ 1L; 2L; 3L; 4L; 5L ] [] (fun accum curr -> +// Stdlib.List.pushBack_v0 accum (curr + 1L)) = [ 2L; 3L; 4L; 5L; 6L ] + +// Stdlib.List.fold_v0 [] [] (fun accum curr -> 5L) = [] + +// Stdlib.List.getAt [ "a"; "b"; "c"; "d" ] -1L = Stdlib.Option.Option.None +// Stdlib.List.getAt [ 0L ] 1L = Stdlib.Option.Option.None +// Stdlib.List.getAt [] 1L = Stdlib.Option.Option.None +// Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 6018427387902L = Stdlib.Option.Option.None + +// Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Option.Option.Some 1L + +// Stdlib.List.getAt [ 3L; 3L; 3L ] -5L = Stdlib.Option.Option.None +// Stdlib.List.getAt [ 3L; 3L; 3L ] 2147483648L = Stdlib.Option.Option.None + +// Stdlib.List.head [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 1L + +// Stdlib.List.head [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage +// "test" + +// Stdlib.List.head [] = Stdlib.Option.Option.None + +// Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> v - i) = [ 3L; 1L; -1L ] + +// Stdlib.List.indexedMap_v0 [] (fun i v -> v - i) = [] + +// Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> i) = [ 0L; 1L; 2L ] + +// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 2L; 5L; 3L; 6L ] + +// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L ] = [ 1L; 4L; 2L; 3L ] +// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [] = [ 1L; 2L; 3L ] +// Stdlib.List.interleave_v0 [ 1L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 5L; 6L ] +// Stdlib.List.interleave_v0 [] [ 4L; 5L; 6L ] = [ 4L; 5L; 6L ] +// Stdlib.List.interleave_v0 [] [] = [] + +// Stdlib.List.interleave_v0 [ "a"; "b"; "c" ] [ 0L ] = Builtin.testDerrorMessage +// "Could not merge types List and List" + +// Stdlib.List.interpose_v0 [ 1L; 2L; 3L ] 5L = [ 1L; 5L; 2L; 5L; 3L ] +// Stdlib.List.interpose_v0 [ 1L ] 5L = [ 1L ] +// Stdlib.List.interpose_v0 [] 5L = [] + +// Stdlib.List.interpose_v0 [ "a"; "b"; "c" ] 0L = Builtin.testDerrorMessage +// "Could not merge types List and List" + +Stdlib.List.isEmpty_v0 [ 1L ] = false +Stdlib.List.isEmpty_v0 [] = true + +//Stdlib.List.last [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 3L + +// Stdlib.List.last [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage +// "test" + +Stdlib.List.last [] = Stdlib.Option.Option.None + +Stdlib.List.length_v0 [ 1L; 2L; 3L ] = 3L +Stdlib.List.length_v0 [] = 0L + +// Stdlib.List.map_v0 (Stdlib.List.range_v0 1L 5L) (fun x -> x + 1L) = [ 2L +// 3L +// 4L +// 5L +// 6L ] + +// Stdlib.List.map_v0 [ 1L; 2L; 3L ] (fun x -> +// Stdlib.Bool.and_v0 +// (Stdlib.Int64.greaterThanOrEqualTo_v0 x 0L) +// (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = [ true; true; true ] + +// Stdlib.List.map_v0 [ 1L; 2L ] (fun x -> x + 1L) = [ 2L; 3L ] +// Stdlib.List.map_v0 [] (fun x -> x + 1L) = [] + +// Stdlib.List.map2_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.Some +// [ 9L; 18L; 27L ] + +// Stdlib.List.map2_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.None + +// Stdlib.List.map2_v0 [] [] (fun a b -> a - b) = Stdlib.Option.Option.Some [] + +// Stdlib.List.map2shortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L +// 18L +// 27L ] + +// Stdlib.List.map2shortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L +// 18L ] + +// Stdlib.List.map2shortest_v0 [] [ 1L; 2L; 3L ] (fun a b -> a - b) = [] +// Stdlib.List.map2shortest_v0 [ 1L; 2L; 3L ] [] (fun a b -> a - b) = [] + +// Stdlib.List.member_v0 [ 1L; 2L; 3L ] 2L = true +// Stdlib.List.member_v0 [ 1L; 2L; 3L ] 4L = false +// Stdlib.List.member_v0 [] 1L = false + +// Stdlib.List.partition_v0 [ -20L; 5L; 9L ] (fun x -> x > 0L) = ([ 5L; 9L ], [ -20L ]) + +// Stdlib.List.partition_v0 [] (fun item -> true) = ([], []) +// Stdlib.List.partition_v0 [] (fun item -> "a") = ([], []) + +// Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> +// match item with +// | 1L -> true +// | 2L -> false +// | 3L -> true) = ([ 1L; 3L ], [ 2L ]) + +// Stdlib.List.partition_v0 [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage +// "If only supports Booleans" + + +// Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> +// match item with +// | 1L -> Stdlib.Option.Option.None +// | 2L -> false +// | 3L -> true) = Builtin.testDerrorMessage "If only supports Booleans" + +// Stdlib.List.pushBack_v0 [ 2L; 3L ] 1L = [ 2L; 3L; 1L ] +// Stdlib.List.pushBack_v0 [] 1L = [ 1L ] + +// Stdlib.List.push_v0 [ 2L; 3L ] 1L = [ 1L; 2L; 3L ] +// Stdlib.List.push_v0 [] 1L = [ 1L ] + +// Stdlib.List.randomElement_v0 [ 1L ] = Stdlib.Option.Option.Some 1L + +// Stdlib.List.randomElement_v0 [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage +// "test" + +//Stdlib.List.randomElement_v0 [] = Stdlib.Option.Option.None + +// Stdlib.List.range_v0 -1L 0L = [ -1L; 0L ] + +// Stdlib.List.range_v0 -5L 5L = [ -5L; -4L; -3L; -2L; -1L; 0L; 1L; 2L; 3L; 4L; 5L ] + +// Stdlib.List.range_v0 5L 0L = [] + +// Stdlib.List.repeat_v0 0L 1L = Stdlib.Result.Result.Ok [] + +// Stdlib.List.repeat_v0 1L "a" = Stdlib.Result.Result.Ok [ "a" ] + +// Stdlib.List.repeat_v0 1L 1L = Stdlib.Result.Result.Ok [ 1L ] + +// Stdlib.List.repeat_v0 3L 1L = Stdlib.Result.Result.Ok [ 1L; 1L; 1L ] + +// Stdlib.List.repeat_v0 3L 3L = Stdlib.Result.Result.Ok [ 3L; 3L; 3L ] + +// Stdlib.List.repeat_v0 5L "a" = Stdlib.Result.Result.Ok [ "a"; "a"; "a"; "a"; "a" ] + +// Stdlib.List.repeat_v0 -4L "a" = Stdlib.Result.Result.Error +// "Expected `times` to be positive, but it was `-4`" + +// Stdlib.List.repeat_v0 3L [ 1L; 2L; 3L ] = Stdlib.Result.Result.Ok +// [ [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ] ] + +// Stdlib.List.repeat_v0 3L [] = Stdlib.Result.Result.Ok [ []; []; [] ] + +// Stdlib.List.reverse_v0 [ "a"; "b"; "c"; "d" ] = [ "d"; "c"; "b"; "a" ] + +// Stdlib.List.reverse_v0 [ 5L; 4L; 3L; 2L; 1L ] = [ 1L; 2L; 3L; 4L; 5L ] + +// Stdlib.List.reverse_v0 [] = [] + +// Stdlib.List.singleton_v0 1L = [ 1L ] + +// Stdlib.List.sortBy_v0 [ 6L; 2L; 8L; 3L ] (fun x -> 0L - x) = [ 8L; 6L; 3L; 2L ] + +// Stdlib.List.sortBy_v0 [] (fun x -> 0L - x) = [] + +// Stdlib.List.sort_v0 [ "6"; "2"; "8"; "3" ] = [ "2"; "3"; "6"; "8" ] +// Stdlib.List.sort_v0 [ 6L; 2L; 8L; 3L ] = [ 2L; 3L; 6L; 8L ] +// Stdlib.List.sort_v0 [] = [] + +// // CLEANUP: it should be a type error on the function not returning an Int64 +// Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 0.1) = Builtin.testDerrorMessage +// // "Function return value should be an Int64. However, a Float (0.1) was returned instead.\n\nExpected: Int64\nActual: a Float: 0.1" +// "Both values must be the same type" + +// Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 3L) = Stdlib.Result.Result.Error +// "Expected comparator function to return -1, 0, or 1, but it returned 3" + +// // CLEANUP: it should be a type error on the function not returning an Int64 +// Stdlib.List.sortByComparator_v0 [ 1L; 2L; 3L ] (fun a b -> "㧑༷釺") = Builtin.testDerrorMessage +// // "Function return value should be an Int64. However, a String (\"㧑༷釺\") was returned instead.\n\nExpected: Int64\nActual: a String: \"㧑༷釺\"" +// "Both values must be the same type" + +// Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> +// if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok +// [ 1L; 2L; 3L ] + +// Stdlib.List.sortByComparator_v0 [] (fun a b -> +// if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok [] + +// Stdlib.List.sortByComparator_v0 +// [ 3L +// 1L +// 2L +// 67L +// 3L +// -1L +// 6L +// 3L +// 5L +// 6L +// 2L +// 5L +// 63L +// 2L +// 3L +// 5L +// -1L +// -1L +// -1L ] +// (fun a b -> if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok +// [ -1L +// -1L +// -1L +// -1L +// 1L +// 2L +// 2L +// 2L +// 3L +// 3L +// 3L +// 3L +// 5L +// 5L +// 5L +// 6L +// 6L +// 63L +// 67L ] + +// // CLEANUP this error message is not ideal in 2 ways: +// // - The error does not provide context that the issue is with the fn specifically +// // - it seems to be from the perspective of the lambda +// // (I'm a lambda and I'm expecting 2 arguments, but I got 1!!) +// // rather than from the perspective of the function it's being used in +// Stdlib.List.sortByComparator_v0 [ 6.0; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage +// "Expected 1 arguments, got 2" + +// Stdlib.List.tail_v0 [ 10L; 20L; 30L; 40L ] = Stdlib.Option.Option.Some +// [ 20L; 30L; 40L ] + +// Stdlib.List.tail_v0 [] = Stdlib.Option.Option.None + +// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] -1L = [] + +// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 2147483648L = [ "a"; "b"; "c"; "d" ] + +// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "a"; "b"; "c" ] +// Stdlib.List.take_v0 [ 3L; 3L; 3L ] 0L = [] + +// Stdlib.List.take_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [ 5L; 4L; 3L; 2L; 1L ] + +// Stdlib.List.take_v0 [ 5L ] 4L = [ 5L ] +// Stdlib.List.take_v0 [] 4L = [] + +// //TODO: better error message +// Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage +// "If only supports Booleans" + +// Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 1L) = [] + +// Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 1L; 2L ] + +// Stdlib.List.takeWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 1L ] +// Stdlib.List.takeWhile_v0 [] (fun item -> item < 3L) = [] +// // it isn't specified which is the right value to keep when there are duplicates +// Stdlib.List.uniqueBy_v0 [ 1L; 2L; 3L; 4L ] (fun x -> Stdlib.Int64.divide_v0 x 2L) = [ 1L +// 2L +// 4L ] + +// Stdlib.List.uniqueBy_v0 [ 1L; 2L; 3L; 4L ] (fun x -> x) = [ 1L; 2L; 3L; 4L ] + +// Stdlib.List.uniqueBy_v0 [ 1L; 1L; 1L; 1L ] (fun x -> x) = [ 1L ] + +// Stdlib.List.uniqueBy_v0 [ 7L; 42L; 7L; 2L; 10L ] (fun x -> x) = [ 2L; 7L; 10L; 42L ] + +// Stdlib.List.uniqueBy_v0 [] (fun x -> x) = [] + +// Stdlib.List.uniqueBy_v0 [ 6L; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage +// "Could not merge types List and List" + +// Stdlib.List.unique_v0 [ 1L; 2L; 3L; 4L ] = [ 1L; 2L; 3L; 4L ] +// Stdlib.List.unique_v0 [ 1L; 1L; 1L; 1L ] = [ 1L ] + +// Stdlib.List.unique_v0 [ 7L; 42L; 7L; 2L; 10L ] = [ 2L; 7L; 10L; 42L ] + +// Stdlib.List.unique_v0 [] = [] +// // TODO: more tests, with values of more complex types + +// Stdlib.List.unzip_v0 [ (1L, 10L); (2L, 20L); (3L, 30L) ] = ([ 1L; 2L; 3L ], +// [ 10L; 20L; 30L ]) + +// Stdlib.List.unzip_v0 [ (10L, 6L) ] = ([ 10L ], [ 6L ]) + +// Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = [ (10L, 1L) +// (20L, 2L) +// (30L, 3L) ] + +// Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ "a"; "bc"; "d" ] = [ (10L, "a") +// (20L, "bc") +// (30L, "d") ] + +// Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = [ (10L, 1L); (20L, 2L) ] + +// Stdlib.List.zipShortest_v0 [ 1L; 2L; 3L ] [ 10L; 20L ] = [ (1L, 10L); (2L, 20L) ] + +// Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ "a"; "bc"; "d" ] = [ (10L, "a") +// (20L, "bc") ] + +// Stdlib.List.zipShortest_v0 [ "a"; "bc"; "d" ] [ 10L; 20L ] = [ ("a", 10L) +// ("bc", 20L) ] + +// Stdlib.List.zipShortest_v0 [ "b"; "v"; "z" ] [] = [] +// Stdlib.List.zipShortest_v0 [] [ "b"; "v"; "z" ] = [] + + +// Stdlib.List.zip_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some +// [ (10L, 1L); (20L, 2L); (30L, 3L) ] + +// Stdlib.List.zip_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.None + +// Stdlib.List.zip_v0 [] [] = Stdlib.Option.Option.Some [] + +// Stdlib.List.zip_v0 [ Builtin.testRuntimeError "msg" ] [ Some "" ] = Builtin.testDerrorMessage +// "msg" + + +// Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> +// Stdlib.Int64.mod_v0 x 2L) = [ (1L, [ 1L; 3L; 5L ]); (0L, [ 2L; 4L ]) ] + +// Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> +// Stdlib.Int64.mod_v0 x 2L) = [ (1L, [ 1L; 3L; 5L ]); (0L, [ 2L; 4L ]) ] + +// Stdlib.List.groupByWithKey_v0 +// [ "apple"; "banana"; "avocado"; "grape"; "apricot" ] +// (fun s -> Stdlib.String.first_v0 s 1L) = [ ("a", [ "apple"; "avocado"; "apricot" ]) +// ("b", [ "banana" ]) +// ("g", [ "grape" ]) ] + +// Stdlib.List.groupByWithKey_v0 [ 'a'; 'b'; 'c'; 'a'; 'b' ] (fun c -> c) = [ ('a', +// [ 'a' +// 'a' ]) +// ('b', +// [ 'b' +// 'b' ]) +// ('c', +// [ 'c' ]) ] + +// Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> +// Stdlib.Int64.mod_v0 x 2L == 0L) = [ (false, [ 1L; 3L; 5L ]); (true, [ 2L; 4L ]) ] + +// Stdlib.List.groupByWithKey_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x -> +// ((Stdlib.Int64.mod_v0 x 2L), "test")) = [ ((1L, "test"), [ 1L; 3L; 5L ]) +// ((0L, "test"), [ 2L; 4L ]) ] + +// Stdlib.List.groupByWithKey_v0 [] (fun x -> x) = [] + + +// Stdlib.List.dropLast [ 1L; 2L; 3L; 4L; 5L ] = [ 1L; 2L; 3L; 4L ] +// Stdlib.List.dropLast [ 1L ] = [] +// Stdlib.List.dropLast [] = [] + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L ] 2L = Stdlib.Result.Result.Ok +// [ [ 1L; 2L ]; [ 3L; 4L ]; [ 5L ] ] + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L; 6L ] 3L = Stdlib.Result.Result.Ok +// [ [ 1L; 2L; 3L ]; [ 4L; 5L; 6L ] ] + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L ] 1L = Stdlib.Result.Result.Ok +// [ [ 1L ]; [ 2L ]; [ 3L ] ] + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L ] 3L = Stdlib.Result.Result.Ok [ [ 1L; 2L ] ] + +// Stdlib.List.chunkBySize_v0 [] 4L = Stdlib.Result.Result.Ok [] + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Result.Result.Error +// Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero + +// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] -1L = Stdlib.Result.Result.Error +// Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero + + +// Stdlib.List.splitLast [] = Stdlib.Option.Option.None +// Stdlib.List.splitLast [ 1L ] = Stdlib.Option.Option.Some(([], 1L)) +// Stdlib.List.splitLast [ 1L; 2L ] = Stdlib.Option.Option.Some(([ 1L ], 2L)) +// Stdlib.List.splitLast [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some(([ 1L; 2L ], 3L)) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_math.dark b/backend/testfiles/execution/stdlib/math.dark similarity index 78% rename from backend/testfiles/execution/stdlib/_math.dark rename to backend/testfiles/execution/stdlib/math.dark index bfaf2ba0fb..0063af85bc 100644 --- a/backend/testfiles/execution/stdlib/_math.dark +++ b/backend/testfiles/execution/stdlib/math.dark @@ -1,14 +1,10 @@ -Stdlib.Math.acos_v0 -1.0 = Stdlib.Option.Option.Some 3.14159265359 +// Stdlib.Math.acos_v0 -1.0 = Stdlib.Option.Option.Some 3.14159265359 +// Stdlib.Math.acos_v0 1.0 = Stdlib.Option.Option.Some 0.0 +// Stdlib.Math.acos_v0 5.0 = Stdlib.Option.Option.None -Stdlib.Math.acos_v0 1.0 = Stdlib.Option.Option.Some 0.0 - -Stdlib.Math.acos_v0 5.0 = Stdlib.Option.Option.None - -Stdlib.Math.asin_v0 0.0 = Stdlib.Option.Option.Some 0.0 - -Stdlib.Math.asin_v0 1.0 = Stdlib.Option.Option.Some 1.57079632679 - -Stdlib.Math.asin_v0 5.0 = Stdlib.Option.Option.None +// Stdlib.Math.asin_v0 0.0 = Stdlib.Option.Option.Some 0.0 +// Stdlib.Math.asin_v0 1.0 = Stdlib.Option.Option.Some 1.57079632679 +// Stdlib.Math.asin_v0 5.0 = Stdlib.Option.Option.None Stdlib.Math.atan_v0 0.0 = 0.0 Stdlib.Math.atan_v0 1.0 = 0.785398163397 From a8f4996482e9a15d5f0b1fa89eaba00db61e095d Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Fri, 20 Sep 2024 21:41:10 -0400 Subject: [PATCH 55/60] 1200/9000 tests passing --- .../testfiles/execution/stdlib/_string.dark | 988 ------------------ .../stdlib/{_bytes.dark => bytes.dark} | 0 .../stdlib/{_float.dark => float.dark} | 46 +- .../stdlib/{_nomodule.dark => nomodule.dark} | 156 +-- .../testfiles/execution/stdlib/string.dark | 968 +++++++++++++++++ 5 files changed, 1069 insertions(+), 1089 deletions(-) delete mode 100644 backend/testfiles/execution/stdlib/_string.dark rename backend/testfiles/execution/stdlib/{_bytes.dark => bytes.dark} (100%) rename backend/testfiles/execution/stdlib/{_float.dark => float.dark} (80%) rename backend/testfiles/execution/stdlib/{_nomodule.dark => nomodule.dark} (68%) create mode 100644 backend/testfiles/execution/stdlib/string.dark diff --git a/backend/testfiles/execution/stdlib/_string.dark b/backend/testfiles/execution/stdlib/_string.dark deleted file mode 100644 index 78467716bb..0000000000 --- a/backend/testfiles/execution/stdlib/_string.dark +++ /dev/null @@ -1,988 +0,0 @@ -let c (arg: String) : Char = - (Builtin.testToChar_v0 arg) |> Builtin.unwrap - -module Equality = - "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - "Είναι προικισμένοι με λογική" = "Είναι προικισμένοι με λογική" - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - -module Append = - "" ++ "" = "" - "a" ++ "̂" = "â" - "hello" ++ " world" = "hello world" - "ᄀ" ++ "ᅡᆨ" = "각" - "" ++ "a" = "a" - "a" ++ "" = "a" - "a" ++ "̂" = "â" - - Stdlib.String.append "a" "̂" = "â" - Stdlib.String.append "" "" = "" - Stdlib.String.append "hello" " world" = "hello world" - Stdlib.String.append "hello" "world" = "helloworld" // Stdlib.String.append works for ASCII range - Stdlib.String.append "ᄀ" "ᅡᆨ" = "각" - Stdlib.String.append "żółw" "😄" = "żółw😄" // Stdlib.String.append works on non-ascii strings - Stdlib.String.append "🧑🏼‍💻" "🧑🏻‍🍼" = "🧑🏼‍💻🧑🏻‍🍼" - Stdlib.String.append "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽👱👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.append "🧟‍♂️🧟‍♀️" "🧟‍♂️" = "🧟‍♂️🧟‍♀️🧟‍♂️" - Stdlib.String.append "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "👨‍❤️‍💋‍👨" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇👨‍❤️‍💋‍👨" - - -module Join = - (Stdlib.String.join_v0 [ "a"; "b"; "c"; "d" ] "|") = "a|b|c|d" - - (Stdlib.String.join_v0 [ "a"; "̂" ] "") |> Stdlib.String.base64UrlEncode_v0 = "w6I" - - Stdlib.String.join_v0 [ "hello"; " world" ] "" = "hello world" - Stdlib.String.join_v0 [ "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽"; "🧟‍♀️" ] "" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽🧟‍♀️" - - Stdlib.String.join_v0 [ "👱👱🏻👱🏼👱🏽👱🏾👱🏿"; "👨‍❤️‍💋‍👨"; "﷽﷽﷽" ] "" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿👨‍❤️‍💋‍👨﷽﷽﷽" - - Stdlib.String.join_v0 [ "🧟‍♀️🧟‍♂️"; "🧟‍♀️🧑🏽‍🦰" ] "" = "🧟‍♀️🧟‍♂️🧟‍♀️🧑🏽‍🦰" - - Stdlib.String.join_v0 [ "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️"; "‍⚧️‍️🇵🇷" ] "" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - Stdlib.String.join_v0 [ "🧟‍♀️🧟‍♂️‍"; "🧟‍♀️🧑🏽‍🦰‍‍" ] "" = "🧟‍♀️🧟‍♂️‍🧟‍♀️🧑🏽‍🦰‍‍" - Stdlib.String.join_v0 [ "🧑🏽‍🦰‍"; "🧑🏼‍💻‍‍" ] "" = "🧑🏽‍🦰‍🧑🏼‍💻‍‍" - -module ToBytes = - Stdlib.List.length (Stdlib.String.toBytes_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿") = 62L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "😄APPLE🍏") = 13L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "Είναι προικισμένοι με λογική") = 53L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "") = 0L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿") = 62L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = 48L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = 44L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "🧟‍♀️🧟‍♂️") = 26L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷") = 82L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = 49L - - Stdlib.List.length (Stdlib.String.toBytes_v0 "") = 0L - - -module FromBytesWithReplacement = - Stdlib.String.fromBytesWithReplacement_v0 ( - (Stdlib.Base64.decode_v0 "w6I") |> Builtin.unwrap - ) = "â" - - Stdlib.String.fromBytesWithReplacement_v0 ( - (Stdlib.Base64.decode_v0 "aGVsbG8g8J+YgA==") |> Builtin.unwrap - ) = "hello 😀" - - Stdlib.String.fromBytesWithReplacement_v0 ( - (Stdlib.Base64.decode_v0 "ww==") |> Builtin.unwrap - ) = "�" - - Stdlib.String.fromBytesWithReplacement_v0 ( - (Stdlib.Base64.decode_v0 "7aCA") |> Builtin.unwrap - ) = "���" - - Stdlib.String.fromBytesWithReplacement_v0 ( - (Stdlib.Base64.decode_v0 "aMM=") |> Builtin.unwrap - ) = "h�" - - -module FromBytes = - Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "w6I") |> Builtin.unwrap) = Stdlib.Option.Option.Some - "â" - - Stdlib.String.fromBytes_v0 ( - (Stdlib.Base64.decode_v0 "aGVsbG8g8J+YgA==") |> Builtin.unwrap - ) = Stdlib.Option.Option.Some "hello 😀" - - Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "ww==") |> Builtin.unwrap) = Stdlib.Option.Option.None - - Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "7aCA") |> Builtin.unwrap) = Stdlib.Option.Option.None - - Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "aMM=") |> Builtin.unwrap) = Stdlib.Option.Option.None - - -module StartsWith = - Stdlib.String.startsWith_v0 "a string" "a s" = true - Stdlib.String.startsWith_v0 "a string" " s" = false - Stdlib.String.startsWith_v0 "żółw" "żó" = true - Stdlib.String.startsWith_v0 "żółw" "r22" = false - Stdlib.String.startsWith_v0 "👩🏻‍🚀🍇" "🍇" = false - Stdlib.String.startsWith_v0 "123456" "123" = true - Stdlib.String.startsWith_v0 "" "" = true - Stdlib.String.startsWith_v0 "E" "\u0014\u0004" = false - - Stdlib.String.startsWith_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏾‍🦰" = false - - Stdlib.String.startsWith_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" = true - - Stdlib.String.startsWith_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽﷽﷽" = true - Stdlib.String.startsWith_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏿" = false - Stdlib.String.startsWith_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = false - - Stdlib.String.startsWith_v0 - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" = true - - Stdlib.String.startsWith_v0 "a string" "" = true - -module EndsWith = - Stdlib.String.endsWith_v0 "a string" "in" = false - Stdlib.String.endsWith_v0 "a string" "ing" = true - Stdlib.String.endsWith_v0 "a string" "" = true - Stdlib.String.endsWith_v0 "żółw" "żó" = false - Stdlib.String.endsWith_v0 "żółw" "łw" = true - Stdlib.String.endsWith_v0 "👩🏻‍🚀🍇" "🍇" = true - Stdlib.String.endsWith_v0 "123456" "56" = true - Stdlib.String.endsWith_v0 "" "" = true - Stdlib.String.endsWith_v0 "E" "\u0014\u0004" = false - Stdlib.String.endsWith_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "✋✋🏿✋🏿" = false - - Stdlib.String.endsWith_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "ǧ̗͚̚o̙̔ͮ̇͐̇" = true - - Stdlib.String.endsWith_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "12xsd" = false - Stdlib.String.endsWith_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "﷽" = false - Stdlib.String.endsWith_v0 "🧟‍♀️🧟‍♂️" "🧟‍♀️" = false - - Stdlib.String.endsWith_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🏳️‍⚧️‍️🇵🇷" = true - - -module Map = - Stdlib.String.map "a string" (fun x -> x) = "a string" - Stdlib.String.map "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" (fun x -> x) = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.map "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" (fun x -> x) = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.map "👱👱🏻👱🏼👱🏽👱🏾👱🏿" (fun x -> x) = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.map "🧟‍♀️🧟‍♂️" (fun x -> x) = "🧟‍♀️🧟‍♂️" - - Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> x) = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 'c') = "cccc" - - // CLEANUP: it should be a type error on the function not returning a Char - Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 5L) = Builtin.testDerrorMessage - """PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ 5, 5, ...) was passed instead. - -Expected: (lst: List) -Actual: a List: [ - 5, 5, 5, 5 -]""" - - - // Check that map executes the right number of times - (let v = - Stdlib.String.map "a string" (fun x -> - let _ = Builtin.testIncrementSideEffectCounter_v0 false in 'c') - - (v, Builtin.testSideEffectCount_v0 ())) = ("cccccccc", 8L) - - -module FromChar = - Stdlib.String.fromChar 'a' = "a" - Stdlib.String.fromChar (c "1") = "1" - Stdlib.String.fromChar (c "👩‍👩‍👧‍👦") = "👩‍👩‍👧‍👦" - Stdlib.String.fromChar (c "🏳️‍⚧️‍️") = "🏳️‍⚧️‍️" - Stdlib.String.fromChar (c "👱🏾") = "👱🏾" - Stdlib.String.fromChar (c "Z̤͔ͧ̑̓") = "Z̤͔ͧ̑̓" - - - -module Base64Decode = - Stdlib.String.base64Decode_v0 "random string" = Stdlib.Result.Result.Error - "Not a valid base64 string" - - Stdlib.String.base64Decode_v0 "illegal chars&@:" = Stdlib.Result.Result.Error - "Not a valid base64 string" - - Stdlib.String.base64Decode_v0 "Kw" = Stdlib.Result.Result.Ok "+" - - Stdlib.String.base64Decode_v0 "yLo" = Stdlib.Result.Result.Ok "Ⱥ" - - Stdlib.String.base64Decode_v0 "xbzDs8WCdw" = Stdlib.Result.Result.Ok "żółw" - - Stdlib.String.base64Decode_v0 "LyotKygmQDk4NTIx" = Stdlib.Result.Result.Ok - "/*-+(&@98521" - - Stdlib.String.base64Decode_v0 "" = Stdlib.Result.Result.Ok "" // empty case - - - // Test cases from the spec with padding added - Stdlib.String.base64Decode_v0 "Zg" = Stdlib.Result.Result.Ok "f" - - Stdlib.String.base64Decode_v0 "Zg==" = Stdlib.Result.Result.Ok "f" - - Stdlib.String.base64Decode_v0 "Zm8" = Stdlib.Result.Result.Ok "fo" - - Stdlib.String.base64Decode_v0 "Zm8=" = Stdlib.Result.Result.Ok "fo" - - Stdlib.String.base64Decode_v0 "Zm9v" = Stdlib.Result.Result.Ok "foo" - - Stdlib.String.base64Decode_v0 "Zm9vYg" = Stdlib.Result.Result.Ok "foob" - - Stdlib.String.base64Decode_v0 "Zm9vYg==" = Stdlib.Result.Result.Ok "foob" - - Stdlib.String.base64Decode_v0 "Zm9vYmE" = Stdlib.Result.Result.Ok "fooba" - - Stdlib.String.base64Decode_v0 "Zm9vYmE=" = Stdlib.Result.Result.Ok "fooba" - - Stdlib.String.base64Decode_v0 "Zm9vYmFy" = Stdlib.Result.Result.Ok "foobar" - - - // "Impossible cases" from apache - // https://commons.apache.org/proper/commons-codec/xref-test/org/apache/commons/codec/binary/Base64Test.html - Stdlib.String.base64Decode_v0 "ZE==" = Stdlib.Result.Result.Ok "d" - - Stdlib.String.base64Decode_v0 "ZmC=" = Stdlib.Result.Result.Ok "f`" - - Stdlib.String.base64Decode_v0 "Zm9vYE==" = Stdlib.Result.Result.Ok "foo`" - - Stdlib.String.base64Decode_v0 "Zm9vYmC=" = Stdlib.Result.Result.Ok "foob`" - - Stdlib.String.base64Decode_v0 - "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" = Stdlib.Result.Result.Ok - "from=06/07/2013 query=\"Καλώς ορίσατε\"" - - Stdlib.String.base64Decode_v0 - "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" = Stdlib.Result.Result.Ok - "👱👱🏻👱🏼👱🏽👱🏾👱🏿" - - - Stdlib.String.base64Decode_v0 "-p" = Stdlib.Result.Result.Error - "Invalid UTF-8 string" - - Stdlib.String.base64Decode_v0 "lI" = Stdlib.Result.Result.Error - "Invalid UTF-8 string" - - Stdlib.String.base64Decode_v0 "5Sk" = Stdlib.Result.Result.Error - "Invalid UTF-8 string" - - -module Base64UrlEncode = - Stdlib.String.base64UrlEncode_v0 "+" = "Kw" - Stdlib.String.base64UrlEncode_v0 "Ⱥ" = "yLo" - Stdlib.String.base64UrlEncode_v0 "żółw" = "xbzDs8WCdw" - Stdlib.String.base64UrlEncode_v0 "/*-+(&@98521" = "LyotKygmQDk4NTIx" - Stdlib.String.base64UrlEncode_v0 "" = "" - Stdlib.String.base64UrlEncode_v0 "f" = "Zg" - Stdlib.String.base64UrlEncode_v0 "fo" = "Zm8" - Stdlib.String.base64UrlEncode_v0 "foo" = "Zm9v" - Stdlib.String.base64UrlEncode_v0 "foob" = "Zm9vYg" - Stdlib.String.base64UrlEncode_v0 "fooba" = "Zm9vYmE" - Stdlib.String.base64UrlEncode_v0 "foobar" = "Zm9vYmFy" - Stdlib.String.base64UrlEncode_v0 "Hello World" = "SGVsbG8gV29ybGQ" - - Stdlib.String.base64UrlEncode_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"" = "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" - - Stdlib.String.base64UrlEncode_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" - - -module Base64Encode = - Stdlib.String.base64Encode_v0 "+" = "Kw==" - Stdlib.String.base64Encode_v0 "Ⱥ" = "yLo=" - Stdlib.String.base64Encode_v0 "żółw" = "xbzDs8WCdw==" - Stdlib.String.base64Encode_v0 "/*-+(&@98521" = "LyotKygmQDk4NTIx" - Stdlib.String.base64Encode_v0 "" = "" - Stdlib.String.base64Encode_v0 "f" = "Zg==" - Stdlib.String.base64Encode_v0 "fo" = "Zm8=" - Stdlib.String.base64Encode_v0 "foo" = "Zm9v" - Stdlib.String.base64Encode_v0 "foob" = "Zm9vYg==" - Stdlib.String.base64Encode_v0 "fooba" = "Zm9vYmE=" - Stdlib.String.base64Encode_v0 "foobar" = "Zm9vYmFy" - Stdlib.String.base64Encode_v0 "Hello World" = "SGVsbG8gV29ybGQ=" - - Stdlib.String.base64Encode_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"" = "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs+CIM6/z4HOr8+DzrHPhM61Ig==" - - Stdlib.String.base64Encode_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "8J+RsfCfkbHwn4+78J+RsfCfj7zwn5Gx8J+PvfCfkbHwn4++8J+RsfCfj78=" - - -module Digest = - Stdlib.String.digest_v0 "" = "OLBgp1GsljhM2TJ-sbHjaiH9txEUvgdDTAzHv2P24donTt6_529l-9Ua0vFImLlb" - Stdlib.String.digest_v0 "😄" = "Z2Y7YuyYHR9miKrg6mLtxSTaHRpGZuaenmGQl3QFY58pwhPCK2bIYxJQ728ChJwA" - Stdlib.String.digest_v0 "ελπίδα" = "j4uJEeBe6g8QrzbuxoI2roUgapGQiExE8CWEQqZao61eZVN1iSZ8cV39IM1nGqsa" - Stdlib.String.digest_v0 "/*-+(&@98521" = "wSGXFkLMpPufNoF2mUBAjT4YlUEb9cl0Iliy4qohwt1XFpg51PRJVTWndn5PewSr" - Stdlib.String.digest_v0 "👩🏻‍🚀🍇" = "hVrNUSbFOfYXwZe6zQRUFFfGPe90qr-aROG2n-hMk8kAC-xodOyHOqecLWb9HIKJ" - Stdlib.String.digest_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" = "7Fo0ImavUzoUM_9kdjucgh6pYAHk5VovpTOUObvxacS31QoCTkcE4rpcQbJJpshE" - Stdlib.String.digest_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "U2v72uGbUR_UIiD5qF6L21pKzYi4B6OB76HGtbpM0o-2_4YB3ytPjJ7w9png3L9k" - Stdlib.String.digest_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "c1Wm67axXlBaejcJZxct80MvexdTtyyrTK9J9-_4RqgP1pf4Bk9SoMZpsnXpvLIx" - Stdlib.String.digest_v0 "🧟‍♀️🧟‍♂️" = "FBnrDureCzgPeGP9qOuW1BIiF2Wz5WejO5XtJWa81qCxcD6cZ4A_WAB0ZJzhOErc" - Stdlib.String.digest_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "3QFqrhTPpxeje6XUNObFt2eJZZ1t0pAcX42AFdFVv42hco0bTOopQK3py4KMBT0m" - - -module Random = - (Stdlib.String.random 5L) == (Stdlib.String.random 5L) = false - - Stdlib.String.random -1L = Stdlib.Result.Result.Error - "Expected `length` to be positive, but it was `-1`" - - Stdlib.String.length ((Stdlib.String.random 10L) |> Builtin.unwrap) = 10L - - Stdlib.String.length ((Stdlib.String.random 5L) |> Builtin.unwrap) = 5L - - Stdlib.String.length ((Stdlib.String.random 0L) |> Builtin.unwrap) = 0L - - -module HtmlEscape = - Stdlib.String.htmlEscape_v0 "test<>&\"" = "test<>&"" // HTML escaping works reasonably - - Stdlib.String.htmlEscape_v0 - "

This is f#

" = "<html><head></head><body><h1>This is f#</h1></body></html>" // HTML escaping works reasonably - - Stdlib.String.htmlEscape_v0 - "" = "<html><head><!-- head definitions go here --></head><body><!-- the content goes here --></body></html>" - - Stdlib.String.htmlEscape_v0 "" = "" - Stdlib.String.htmlEscape_v0 "😄" = "😄" - Stdlib.String.htmlEscape_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - - Stdlib.String.htmlEscape_v0 "

﷽﷽﷽﷽﷽

" = "<html><head></head><body><h1>﷽﷽﷽﷽﷽</h1></body></html>" - - Stdlib.String.htmlEscape_v0 "🧟‍♀️🧟‍♂️" = "<head>🧟‍♀️🧟‍♂️</head>" - Stdlib.String.htmlEscape_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - -module IsEmpty = - Stdlib.String.isEmpty_v0 "" = true - Stdlib.String.isEmpty_v0 "a" = false - Stdlib.String.isEmpty_v0 "🧑🏼‍💻🧑🏻‍🍼" = false - Stdlib.String.isEmpty_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = false - Stdlib.String.isEmpty_v0 "﷽﷽﷽﷽﷽" = false - Stdlib.String.isEmpty_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = false - Stdlib.String.isEmpty_v0 "🧟‍♀️🧟‍♂️" = false - Stdlib.String.isEmpty_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = false - - -module NewLine = - Stdlib.String.newline = "\n" - - -module Length = - Stdlib.String.length "😄" = 1L - Stdlib.String.length "" = 0L - Stdlib.String.length "abcdef" = 6L - Stdlib.String.length "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" = 6L - Stdlib.String.length "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = 5L - Stdlib.String.length "﷽﷽﷽﷽﷽" = 5L - Stdlib.String.length "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = 6L - Stdlib.String.length "🧟‍♀️🧟‍♂️" = 2L - Stdlib.String.length "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = 4L - - -module Prepend = - Stdlib.String.prepend_v0 "hello" "world" = "worldhello" // Stdlib.String.prepend works for ASCII range - Stdlib.String.prepend_v0 "hello" "" = "hello" - Stdlib.String.prepend_v0 "" "hello" = "hello" - Stdlib.String.prepend_v0 "żółw" "😄" = "😄żółw" // Stdlib.String.prepend works on non-ascii strings - Stdlib.String.prepend_v0 "123" "456" = "456123" - Stdlib.String.prepend_v0 "óñÜá" "abc" = "abcóñÜá" - Stdlib.String.prepend_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓" = "Z̤͔ͧ̑̓Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.prepend_v0 "﷽﷽﷽﷽﷽" "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨﷽﷽﷽﷽﷽" - Stdlib.String.prepend_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.prepend_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "✋🏻" = "✋🏻👱👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.prepend_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = "🧟‍♂️🧟‍♀️🧟‍♂️" - - Stdlib.String.prepend_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - Stdlib.String.prepend_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧟‍♂️" = "🧟‍♂️żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - - -module ReplaceAll = - Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "b" "x" = "axcABCcxaCBA" - Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "" "x" = "xaxbxcxAxBxCxcxbxaxCxBxAx" - Stdlib.String.replaceAll_v0 "" "" "&" = "&" - Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "b" "" = "acABCcaCBA" - - Stdlib.String.replaceAll_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "ä͖̭̈̇" "$" = "Z̤͔ͧ̑̓$lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - - Stdlib.String.replaceAll_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽" "$" = "$$$$$$$$" - Stdlib.String.replaceAll_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏽" "✋🏻" = "👱👱🏻👱🏼✋🏻👱🏾👱🏿" - Stdlib.String.replaceAll_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" "🧑🏽‍🦰" = "🧟‍♀️🧑🏽‍🦰" - - Stdlib.String.replaceAll_v0 - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - "👨‍❤️‍💋‍👨" - "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - Stdlib.String.replaceAll_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" "🧟‍♂️" = "żółw🧑🏽‍🦰🧟‍♂️✋✋🏻✋🏿" - - -module Slugify = - Builtin.stringSlugify - " M@y 'super' Really- exce+llent *Uber_ ama\"zing* ~very 5x5 ~ \"clever\" thing: coffee😭!" = "my-super-really-excellent-uber-amazing-very-5x5-clever-thing-coffee" - - Builtin.stringSlugify - " m@y 'super' really- excellent *uber_ amazing* ~very ~ \"clever\" thing: coffee😭!" = "my-super-really-excellent-uber-amazing-very-clever-thing-coffee" - - Builtin.stringSlugify "" = "" - Builtin.stringSlugify "ABCD-45646sassa" = "abcd-45646sassa" - Builtin.stringSlugify "ddsd516ds125sd12sd12Ü" = "ddsd516ds125sd12sd12" - Builtin.stringSlugify "q=\u0002$\u001a<+MC" = "qmc" - Builtin.stringSlugify "🎁🎄Ǣʚ231" = "231" - Builtin.stringSlugify "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "" - Builtin.stringSlugify "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "zlo" - Builtin.stringSlugify "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "" - Builtin.stringSlugify "🧟‍♀️🧟‍♂️" = "" - Builtin.stringSlugify "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "" - - Builtin.stringSlugify - "b\x01c\x02d\x03e\x04f\x05g\x06h\x07i\x08j\x09k\x0Al\x0Bm\x0Cn\x0Do\x0Ep\x0Fq" = "bcdefghij-k-lm-n-opq" - - Builtin.stringSlugify - "a\x10b\x11c\x12d\x13e\x14f\x15g\x16h\x17i\x18j\x19k\x1Al\x1Bm\x1Cn\x1Do\x1Ep\x1Fq" = "abcdefghijklmnopq" - - Builtin.stringSlugify "!\"#$%&'()*+,-./" = "-" - Builtin.stringSlugify ":;<=>?@" = "" - Builtin.stringSlugify "[\\]^_`" = "-" - Builtin.stringSlugify "{|}~\x7F" = "" - - -module FromList = - Stdlib.String.fromList [] = "" - Stdlib.String.fromList [ c "a" ] = "a" - - Stdlib.String.fromList [ c "👩‍👩‍👧‍👦"; c "🏳️‍⚧️‍️"; c "👱🏾"; c "Z̤͔ͧ̑̓" ] = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" - - Stdlib.String.fromList [ "a" ] = Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ \"a\"]) was passed instead. - -Expected: (lst: List) -Actual: a List: [\n \"a\"\n]" - - -module ToList = - Stdlib.String.toList "" = [] - Stdlib.String.toList "ab" = [ 'a'; 'b' ] - Stdlib.String.toList "👨‍👩‍👧‍👦" = [ c "👨‍👩‍👧‍👦" ] - - Stdlib.String.toList "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ (c "Z̤͔ͧ̑̓") - (c "ä͖̭̈̇") - (c "lͮ̒ͫ") - (c "ǧ̗͚̚") - (c "o̙̔ͮ̇͐̇") ] - - - Stdlib.String.toList "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = [ (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") - (c "﷽") ] - - Stdlib.String.toList "🧟‍♀️🧟‍♂️" = [ c "🧟‍♀️"; c "🧟‍♂️" ] - - Stdlib.String.toList "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = [ (c "👱") - (c "👱🏻") - (c "👱🏼") - (c "👱🏽") - (c "👱🏾") - (c "👱🏿") ] - - - Stdlib.String.toList "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = [ (c "ż") - (c "ó") - (c "ł") - (c "w") - (c "🧑🏽‍🦰") - (c "🧑🏻‍🍼") - (c "✋") - (c "✋🏻") - (c "✋🏿") ] - - ("ab1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "ab1" - - ("@Ǣá1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "@Ǣá1" - - ("👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" - |> Stdlib.String.toList - |> Stdlib.String.fromList) = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" - - -module Split = - Stdlib.String.split "hello world" "notfound" = [ "hello world" ] - Stdlib.String.split "hello😄world" "😄" = [ "hello"; "world" ] - Stdlib.String.split "hello&&&&world" "&&&&" = [ "hello"; "world" ] - Stdlib.String.split "hello34564world34564sun" "😄" = [ "hello34564world34564sun" ] - - Stdlib.String.split "hello34564world34564sun" "34564" = [ "hello"; "world"; "sun" ] - - Stdlib.String.split "" "34564" = [ "" ] - Stdlib.String.split "34564" "" = [ "3"; "4"; "5"; "6"; "4" ] - - Stdlib.String.split "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" = [ "🧑🏽‍🦰🧑🏼‍💻" - "✋✋🏻✋🏿" ] - - // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ "" - // "" ] - - Stdlib.String.split "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽﷽﷽" = [ ""; ""; ""; ""; "" ] - - Stdlib.String.split "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = [ "👱👱🏻"; "👱🏾👱🏿" ] - - Stdlib.String.split "🧟‍♀️🧟‍♂️" "👱🏽" = [ "🧟‍♀️🧟‍♂️" ] - - // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = [ "👨‍❤️‍💋‍👨" - // "🏳️‍⚧️‍️🇵🇷" ] - - // Stdlib.String.split "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = [ "żółw" - // "🧑🏻‍🍼✋✋🏻✋🏿" ] - - // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" = [ "" - // "ǧ̗͚̚o̙̔ͮ̇͐̇" ] - - Stdlib.String.split "666666" "6" = [ ""; ""; ""; ""; ""; ""; "" ] - Stdlib.String.split "55555" "5" = [ ""; ""; ""; ""; ""; "" ] - Stdlib.String.split "4444" "4" = [ ""; ""; ""; ""; "" ] - Stdlib.String.split "333" "3" = [ ""; ""; ""; "" ] - Stdlib.String.split "22" "2" = [ ""; ""; "" ] - Stdlib.String.split "1" "1" = [ ""; "" ] - Stdlib.String.split "" "" = [] - - Stdlib.String.split "666666x" "6" = [ ""; ""; ""; ""; ""; ""; "x" ] - - Stdlib.String.split "55555x" "5" = [ ""; ""; ""; ""; ""; "x" ] - Stdlib.String.split "4444x" "4" = [ ""; ""; ""; ""; "x" ] - Stdlib.String.split "333x" "3" = [ ""; ""; ""; "x" ] - Stdlib.String.split "22x" "2" = [ ""; ""; "x" ] - Stdlib.String.split "1x" "1" = [ ""; "x" ] - - Stdlib.String.split "x666666" "6" = [ "x"; ""; ""; ""; ""; ""; "" ] - - Stdlib.String.split "x55555" "5" = [ "x"; ""; ""; ""; ""; "" ] - Stdlib.String.split "x4444" "4" = [ "x"; ""; ""; ""; "" ] - Stdlib.String.split "x333" "3" = [ "x"; ""; ""; "" ] - Stdlib.String.split "x22" "2" = [ "x"; ""; "" ] - Stdlib.String.split "x1" "1" = [ "x"; "" ] - - Stdlib.String.split "x666666y" "6" = [ "x"; ""; ""; ""; ""; ""; "y" ] - - Stdlib.String.split "x55555y" "5" = [ "x"; ""; ""; ""; ""; "y" ] - Stdlib.String.split "x4444y" "4" = [ "x"; ""; ""; ""; "y" ] - Stdlib.String.split "x333y" "3" = [ "x"; ""; ""; "y" ] - Stdlib.String.split "x22y" "2" = [ "x"; ""; "y" ] - Stdlib.String.split "x1y" "1" = [ "x"; "y" ] - - Stdlib.String.split "6a6aa6aaa6aaaa" "a" = [ "6" - "6" - "" - "6" - "" - "" - "6" - "" - "" - "" - "" ] - - // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "" = [ "👨‍❤️‍💋‍👨" - // "👩‍👩‍👧‍👦" - // "🏳️‍⚧️‍️" - // "🇵🇷" ] - - Stdlib.String.split "👨‍👩‍👧‍👦" "👩" = [ "👨‍👩‍👧‍👦" ] - - -module ToLowercase = - Stdlib.String.toLowercase "HELLO😄WORLD" = "hello😄world" - Stdlib.String.toLowercase "" = "" - Stdlib.String.toLowercase "ABCDEF" = "abcdef" // Stdlib.String.toLowercase_v0 works for ASCII range - Stdlib.String.toLowercase "AB323CDEF" = "ab323cdef" - Stdlib.String.toLowercase "SÁNCHEZ" = "sánchez" // not lowercase a - Stdlib.String.toLowercase "sánchez" = "sánchez" - Stdlib.String.toLowercase "ŻÓŁW" = "żółw" // Stdlib.String.toLowercase works on non-ascii strings - Stdlib.String.toLowercase "😄ORANGE" = "😄orange" - Stdlib.String.toLowercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.toLowercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.toLowercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.toLowercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" - Stdlib.String.toLowercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - Stdlib.String.toLowercase "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.toLowercase "Ჾ" = "ჾ" - Stdlib.String.toLowercase "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" = "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - - Stdlib.String.toLowercase - "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "h̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈w̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠b̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅt͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝w͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" - - - -module ToUppercase = - Stdlib.String.toUppercase "" = "" - Stdlib.String.toUppercase "hello😄world" = "HELLO😄WORLD" - Stdlib.String.toUppercase "abcdef" = "ABCDEF" - Stdlib.String.toUppercase "ab323cdef" = "AB323CDEF" - Stdlib.String.toUppercase "sánchez" = "SÁNCHEZ" // not lowercase a - Stdlib.String.toUppercase "SÁNChEZ" = "SÁNCHEZ" - Stdlib.String.toUppercase "żółw" = "ŻÓŁW" - Stdlib.String.toUppercase "😄orange" = "😄ORANGE" - Stdlib.String.toUppercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.toUppercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.toUppercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.toUppercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" - Stdlib.String.toUppercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - Stdlib.String.toUppercase "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.toUppercase "ჾ" = "Ჾ" - - // TODO: There are two types of unicode case "mapping" (conversion), "simple" - // and "full". .NET supports simple mapping, which maps a single character to a - // single character. It does not support "full" mapping, which maps a single - // character to multiple characters. - - // Discussed at https://github.com/dotnet/runtime/issues/30960, specifially - // https://github.com/dotnet/runtime/issues/30960#issuecomment-535274401 - - // A possible solution is to write our own case mapper, or reuse an existing - // one. A potential candidate is - // https://github.com/dotnet/corefxlab/tree/archive/src/System.Text.CaseFolding - // (packaged at - // https://dnceng.visualstudio.com/public/_packaging?_a=package&feed=dotnet-experimental&view=overview&package=System.Text.CaseFolding&version=0.1.2-alpha.21059.1&protocolType=NuGet) - - Stdlib.String.toUppercase "fifl" = "fifl" // should be "FIFL" - Stdlib.String.toUppercase "և" = "և" // should be "ԵՒ" - - Stdlib.String.toUppercase "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" - - Stdlib.String.toUppercase - "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "H̬̤̗̤͝E͜ ̜̥̝̻͍̟́W̕H̖̯͓O̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭A̺̪͍Į͈͕̭͙̯̜T̶̼̮S̘͙͖̕ ̠̫̠B̻͍͙͉̳ΙE̵H̵̬͇̫͙I̹͓̳̳̮͎̫̕N͟D̴̪̜̖ ̰͉̩͇͙̲͞ΙT͖̼͓̪͢H͏͓̮̻E̬̝̟Ι ̤̹̝W͙̞̝͔͇͝ΙA͏͓͔̹̼̣L̴͔̰̤̟͔Ḽ̫.͕" - - - -module TrimEnd = - Stdlib.String.trimEnd_v0 " " = "" - Stdlib.String.trimEnd_v0 "" = "" - Stdlib.String.trimEnd_v0 " foo " = " foo" - Stdlib.String.trimEnd_v0 " foo bar " = " foo bar" - Stdlib.String.trimEnd_v0 " foo" = " foo" - Stdlib.String.trimEnd_v0 " 😄foobar😄 " = " 😄foobar😄" - Stdlib.String.trimEnd_v0 "  foo bar  " = "  foo bar" - Stdlib.String.trimEnd_v0 "foo " = "foo" - Stdlib.String.trimEnd_v0 "foo" = "foo" - - Stdlib.String.trimEnd_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" - - Stdlib.String.trimEnd_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" - - Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.trimEnd_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.trimEnd_v0 " ﷽﷽ " = " ﷽﷽" - Stdlib.String.trimEnd_v0 " 🧟‍♀️🧟‍♂️ " = " 🧟‍♀️🧟‍♂️" - - Stdlib.String.trimEnd_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - - Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.trimEnd_v0 "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" = "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" - - -module TrimStart = - Stdlib.String.trimStart_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " - - Stdlib.String.trimStart_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " - - Stdlib.String.trimStart_v0 " " = "" - Stdlib.String.trimStart_v0 "" = "" - Stdlib.String.trimStart_v0 " foo " = "foo " - Stdlib.String.trimStart_v0 " foo bar " = "foo bar " - Stdlib.String.trimStart_v0 " foo" = "foo" - Stdlib.String.trimStart_v0 " 😄foobar😄 " = "😄foobar😄 " - Stdlib.String.trimStart_v0 "  foo bar  " = "foo bar  " - Stdlib.String.trimStart_v0 "foo " = "foo " - Stdlib.String.trimStart_v0 "foo" = "foo" - Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " - Stdlib.String.trimStart_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " - Stdlib.String.trimStart_v0 " ﷽﷽ " = "﷽﷽ " - Stdlib.String.trimStart_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️ " - - Stdlib.String.trimStart_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " - - Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " - - -module Trim = - Stdlib.String.trim_v0 " " = "" - Stdlib.String.trim_v0 "" = "" - Stdlib.String.trim_v0 " foo " = "foo" // String trims both leading + trailing spaces - Stdlib.String.trim_v0 " foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched - Stdlib.String.trim_v0 " foo" = "foo" // String trims leading spaces - Stdlib.String.trim_v0 " 😄foobar😄 " = "😄foobar😄" // String trims both leading + trailing spaces, preserving emoji - Stdlib.String.trim_v0 "  foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched w/ unicode spaces - Stdlib.String.trim_v0 "foo " = "foo" // String trims trailing spaces - Stdlib.String.trim_v0 "foo" = "foo" // String trim noops - Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.trim_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.trim_v0 " ﷽﷽" = "﷽﷽" - Stdlib.String.trim_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️" - Stdlib.String.trim_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - - Stdlib.String.trim_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" - - Stdlib.String.trim_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" - Stdlib.String.trim_v0 "쉆ꥨ逴皪巌䖑ⱝዓ淋" = "쉆ꥨ逴皪巌䖑ⱝዓ淋" - - -module Reverse = - Stdlib.String.reverse_v0 "abcde" = "edcba" - Stdlib.String.reverse_v0 "0abcde" = "edcba0" - Stdlib.String.reverse_v0 "a" = "a" - Stdlib.String.reverse_v0 "" = "" - Stdlib.String.reverse_v0 "ábc" = "cbá" - Stdlib.String.reverse_v0 "🎁🧸DŽʠ123" = "321ʠDŽ🧸🎁" - Stdlib.String.reverse_v0 "😄foobar👽" = "👽raboof😄" - Stdlib.String.reverse_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "✋🏿✋🏻✋🧑🏻‍🍼🧑🏽‍🦰włóż" - Stdlib.String.reverse_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.reverse_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱🏿👱🏾👱🏽👱🏼👱🏻👱" - Stdlib.String.reverse_v0 "🧟‍♀️🧟‍♂️" = "🧟‍♂️🧟‍♀️" - Stdlib.String.reverse_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "🇵🇷🏳️‍⚧️‍️👩‍👩‍👧‍👦👨‍❤️‍💋‍👨" - Stdlib.String.reverse_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "o̙̔ͮ̇͐̇ǧ̗͚̚lͮ̒ͫä͖̭̈̇Z̤͔ͧ̑̓" - - -module DropFirst = - Stdlib.String.dropFirst_v0 "abcd" -3L = "abcd" - Stdlib.String.dropFirst_v0 "abcd" 0L = "abcd" - Stdlib.String.dropFirst_v0 "abcd" 3L = "d" - Stdlib.String.dropFirst_v0 "" 3L = "" - Stdlib.String.dropFirst_v0 "abcd" 3L = "d" - Stdlib.String.dropFirst_v0 "🍏🍒🍒" 1L = "🍒🍒" - Stdlib.String.dropFirst_v0 "🍏🍒🍍" 2L = "🍍" - Stdlib.String.dropFirst_v0 "🍏a🍒b🍍c" 2L = "🍒b🍍c" - Stdlib.String.dropFirst_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 5L = "🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L = "ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "ǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.dropFirst_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - Stdlib.String.dropFirst_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 1L = "👱🏻👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.dropFirst_v0 "🧟‍♀️🧟‍♂️" 20L = "" - Stdlib.String.dropFirst_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "🇵🇷" - - -module DropLast = - Stdlib.String.dropLast_v0 "abcd" -3L = "abcd" - Stdlib.String.dropLast_v0 "abcd" 0L = "abcd" - Stdlib.String.dropLast_v0 "abcd" 3L = "a" - Stdlib.String.dropLast_v0 "" 3L = "" - Stdlib.String.dropLast_v0 "🍏🍒🍒" 1L = "🍏🍒" - Stdlib.String.dropLast_v0 "🍏🍒🍍" 2L = "🍏" - Stdlib.String.dropLast_v0 "🍏a🍒b🍍c" 2L = "🍏a🍒b" - Stdlib.String.dropLast_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" - Stdlib.String.dropLast_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 10L = "﷽﷽﷽﷽﷽﷽" - Stdlib.String.dropLast_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱👱🏻👱🏼" - Stdlib.String.dropLast_v0 "🧟‍♀️🧟‍♂️" 20L = "" - Stdlib.String.dropLast_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" - Stdlib.String.dropLast_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "żółw🧑🏽‍🦰" - - -module Last = - Stdlib.String.last_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "🧑🏻‍🍼✋✋🏻✋🏿" - Stdlib.String.last_v0 "abcd" -3L = "" - Stdlib.String.last_v0 "abcd" 0L = "" - Stdlib.String.last_v0 "" 7L = "" - Stdlib.String.last_v0 "abcd" 1L = "d" - Stdlib.String.last_v0 "abcd" 2L = "cd" - Stdlib.String.last_v0 "abcd" 3L = "bcd" - Stdlib.String.last_v0 "🍍🍍🍏" 1L = "🍏" - Stdlib.String.last_v0 "🍊🍍🍏" 2L = "🍍🍏" - Stdlib.String.last_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿🧑🏻‍🍼" 1L = "🧑🏻‍🍼" - Stdlib.String.last_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "ǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.last_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L = "﷽﷽" - Stdlib.String.last_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱🏽👱🏾👱🏿" - Stdlib.String.last_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♂️" - Stdlib.String.last_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 1L = "🇵🇷" - - -module Contains = - Stdlib.String.contains_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "2223" = false - Stdlib.String.contains_v0 "👱👱🏻👱🏼👱🏽👱🏾" "👱🏿" = false - Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = true - Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️🧟‍♂️" = false - - Stdlib.String.contains_v0 - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" = true - - Stdlib.String.contains_v0 "اختبار" "اختبار" = true - Stdlib.String.contains_v0 "" "" = true - Stdlib.String.contains_v0 "a" "" = true - Stdlib.String.contains_v0 "" "a" = false - - -module Slice = - Stdlib.String.slice_v0 "abcd" -2L 4L = "cd" - Stdlib.String.slice_v0 "abcd" -5L -6L = "" - Stdlib.String.slice_v0 "abcd" -5L 1L = "a" - Stdlib.String.slice_v0 "abcd" 0L -1L = "abc" - Stdlib.String.slice_v0 "abcd" 2L 3L = "c" - Stdlib.String.slice_v0 "abcd" 2L 6L = "cd" - Stdlib.String.slice_v0 "abcd" 3L 2L = "" - Stdlib.String.slice_v0 "abcd" 5L 6L = "" - Stdlib.String.slice_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 2L 10L = "✋✋🏻✋🏿" - Stdlib.String.slice_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L 3L = "ä͖̭̈̇lͮ̒ͫ" - Stdlib.String.slice_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L 6L = "﷽﷽﷽﷽" - Stdlib.String.slice_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L 6L = "👱🏼👱🏽👱🏾👱🏿" - Stdlib.String.slice_v0 "🧟‍♀️🧟‍♂️" 2L 4L = "" - Stdlib.String.slice_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L 10L = "🏳️‍⚧️‍️🇵🇷" - Stdlib.String.slice_v0 "abc" 0L 4503599627370498L = "abc" - - -module First = - Stdlib.String.first_v0 "abcd" -3L = "" - Stdlib.String.first_v0 "abcd" 0L = "" - Stdlib.String.first_v0 "abcd" 1L = "a" - Stdlib.String.first_v0 "abcd" 2L = "ab" - Stdlib.String.first_v0 "abcd" 3L = "abc" - Stdlib.String.first_v0 "abcd" 3000000000000000L = "abcd" - Stdlib.String.first_v0 "" 7L = "" - Stdlib.String.first_v0 "🍊🍍🍏" 1L = "🍊" - Stdlib.String.first_v0 "🍊🍍🍏" 2L = "🍊🍍" - Stdlib.String.first_v0 "🍊🍍🍏" 3L = "🍊🍍🍏" - Stdlib.String.first_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 1L = "🧑🏽‍🦰" - Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 10L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇" - Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" - Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 4L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" - Stdlib.String.first_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽" - Stdlib.String.first_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L = "👱👱🏻" - Stdlib.String.first_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♀️" - Stdlib.String.first_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" - - -module PadStart = - Stdlib.String.padStart_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" - - Stdlib.String.padStart_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" - - Stdlib.String.padStart_v0 "123" "_-" 4L = Stdlib.Result.Result.Error - "Expected `padWith` to be 1 character long, but it was `\"_-\"`" - - Stdlib.String.padStart_v0 "123" "" 10L = Stdlib.Result.Result.Error - "Expected `padWith` to be 1 character long, but it was `\"\"`" - - Stdlib.String.padStart_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "000123" - - Stdlib.String.padStart_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" - - Stdlib.String.padStart_v0 "123🍊🍊" "0" 3L = Stdlib.Result.Result.Ok "123🍊🍊" - - Stdlib.String.padStart_v0 "🍍🍍🍊🍊" "0" 7L = Stdlib.Result.Result.Ok "000🍍🍍🍊🍊" - - Stdlib.String.padStart_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok - "0żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - - Stdlib.String.padStart_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok - "00000Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - - Stdlib.String.padStart_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok - "0000﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" - - Stdlib.String.padStart_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok - "0000👱👱🏻👱🏼👱🏽👱🏾👱🏿" - - Stdlib.String.padStart_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok - "000🧟‍♀️🧟‍♂️" - - Stdlib.String.padStart_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok - "000000👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" - - Stdlib.String.padStart_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" - - -module PadEnd = - Stdlib.String.padEnd_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" - - Stdlib.String.padEnd_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" - - Stdlib.String.padEnd_v0 "123" "_-" 3L = Stdlib.Result.Result.Error - "Expected `padWith` to be 1 character long, but it was `\"_-\"`" - - Stdlib.String.padEnd_v0 "123" "" 10L = Stdlib.Result.Result.Error - "Expected `padWith` to be 1 character long, but it was `\"\"`" - - Stdlib.String.padEnd_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "123000" - - Stdlib.String.padEnd_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" - - Stdlib.String.padEnd_v0 "123🍊🍊" "0" 8L = Stdlib.Result.Result.Ok "123🍊🍊000" - - Stdlib.String.padEnd_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok - "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿0" - - Stdlib.String.padEnd_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok - "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇00000" - - Stdlib.String.padEnd_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok - "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽0000" - - Stdlib.String.padEnd_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok - "👱👱🏻👱🏼👱🏽👱🏾👱🏿0000" - - Stdlib.String.padEnd_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok - "🧟‍♀️🧟‍♂️000" - - Stdlib.String.padEnd_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok - "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷000000" - - Stdlib.String.padEnd_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" - - -module IndexOf = - Stdlib.String.indexOf_v0 "hello world" "world" = Stdlib.Option.Option.Some 6L - - Stdlib.String.indexOf_v0 "hello world" "earth" = Stdlib.Option.Option.None - - Stdlib.String.indexOf_v0 "" "" = Stdlib.Option.Option.Some 0L - - Stdlib.String.indexOf_v0 "hello" "" = Stdlib.Option.Option.Some 0L - - Stdlib.String.indexOf_v0 "" "hello" = Stdlib.Option.Option.None - - Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = Stdlib.Option.Option.Some - 6L - - Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏿" = Stdlib.Option.Option.None - - Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = Stdlib.Option.Option.Some - 11L - - Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = Stdlib.Option.Option.Some - 4L - - Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "👱🏽" = Stdlib.Option.Option.None - - Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🧑🏻‍🍼" = Stdlib.Option.Option.None - - -module Ellipsis = - Stdlib.String.ellipsis_v0 "hello world" 5L = "hello..." - Stdlib.String.ellipsis_v0 "hello world" 9L = "hello wor..." - Stdlib.String.ellipsis_v0 "hello world" 11L = "hello world" - Stdlib.String.ellipsis_v0 "hello world" 12L = "hello world" - Stdlib.String.ellipsis_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 5L = "👱👱🏻👱🏼👱🏽👱🏾..." - Stdlib.String.ellipsis_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ..." - Stdlib.String.ellipsis_v0 "👩‍👩‍👧‍👦" 2L = "👩‍👩‍👧‍👦" - - Stdlib.String.ellipsis_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷✋✋🏻✋🏿" 4L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷..." - -module Head = - Stdlib.String.head "hello world" = Stdlib.Option.Option.Some 'h' - - Stdlib.String.head "" = Stdlib.Option.Option.None -// Commented out as Fantomas doesn't like unicode "characters" -// Stdlib.String.head "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = Stdlib.Option.Option.Some '👱' -// Stdlib.String.head "🧟‍♀️🧟‍♂️" = Stdlib.Option.Option.Some '🧟' -// Stdlib.String.head "👨‍❤️‍💋‍👨" = Stdlib.Option.Option.Some '👨‍❤️‍💋‍👨' - -module ArticleFor = - Stdlib.String.articleFor "apple" = "an" - Stdlib.String.articleFor "banana" = "a" - Stdlib.String.articleFor "🍍" = "a" - Stdlib.String.articleFor "🍊" = "a" - Stdlib.String.articleFor "" = "" \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_bytes.dark b/backend/testfiles/execution/stdlib/bytes.dark similarity index 100% rename from backend/testfiles/execution/stdlib/_bytes.dark rename to backend/testfiles/execution/stdlib/bytes.dark diff --git a/backend/testfiles/execution/stdlib/_float.dark b/backend/testfiles/execution/stdlib/float.dark similarity index 80% rename from backend/testfiles/execution/stdlib/_float.dark rename to backend/testfiles/execution/stdlib/float.dark index e2188bed30..f4f51a3a9b 100644 --- a/backend/testfiles/execution/stdlib/_float.dark +++ b/backend/testfiles/execution/stdlib/float.dark @@ -125,43 +125,43 @@ Stdlib.Float.min_v0 2147483647.0 00000000.000 = 0.0 Stdlib.Float.multiply_v0 26.0 0.5 = 13.0 -Stdlib.Float.parse_v0 "1.5" = Stdlib.Result.Result.Ok 1.5 +// Stdlib.Float.parse_v0 "1.5" = Stdlib.Result.Result.Ok 1.5 -Stdlib.Float.parse_v0 "0.0" = Stdlib.Result.Result.Ok 0.0 +// Stdlib.Float.parse_v0 "0.0" = Stdlib.Result.Result.Ok 0.0 -Stdlib.Float.parse_v0 "-0.5" = Stdlib.Result.Result.Ok -0.5 +// Stdlib.Float.parse_v0 "-0.5" = Stdlib.Result.Result.Ok -0.5 -Stdlib.Float.parse_v0 "+0.5" = Stdlib.Result.Result.Ok 0.5 +// Stdlib.Float.parse_v0 "+0.5" = Stdlib.Result.Result.Ok 0.5 -Stdlib.Float.parse_v0 ".5" = Stdlib.Result.Result.Ok 0.5 +// Stdlib.Float.parse_v0 ".5" = Stdlib.Result.Result.Ok 0.5 -Stdlib.Float.parse_v0 "0.6999999999999999555910790149937383830547332763671875" = Stdlib.Result.Result.Ok - 0.7 +// Stdlib.Float.parse_v0 "0.6999999999999999555910790149937383830547332763671875" = Stdlib.Result.Result.Ok +// 0.7 -Stdlib.Float.parse_v0 "-0.6999999999999999555910790149937383830547332763671875" = Stdlib.Result.Result.Ok - -0.7 +// Stdlib.Float.parse_v0 "-0.6999999999999999555910790149937383830547332763671875" = Stdlib.Result.Result.Ok +// -0.7 -Stdlib.Float.parse_v0 "0.7999999999" = Stdlib.Result.Result.Ok 0.8 +// Stdlib.Float.parse_v0 "0.7999999999" = Stdlib.Result.Result.Ok 0.8 -Stdlib.Float.parse_v0 "0.79999" = Stdlib.Result.Result.Ok 0.79999 +// Stdlib.Float.parse_v0 "0.79999" = Stdlib.Result.Result.Ok 0.79999 -Stdlib.Float.parse_v0 "-55555555555555555555555555555.5" = Stdlib.Result.Result.Ok - -55555555555555555555555555555.5 +// Stdlib.Float.parse_v0 "-55555555555555555555555555555.5" = Stdlib.Result.Result.Ok +// -55555555555555555555555555555.5 -Stdlib.Float.parse_v0 "-141s" = Stdlib.Result.Result.Error - Stdlib.Float.ParseError.BadFormat +// Stdlib.Float.parse_v0 "-141s" = Stdlib.Result.Result.Error +// Stdlib.Float.ParseError.BadFormat -Stdlib.Float.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.Float.ParseError.BadFormat +// Stdlib.Float.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.Float.ParseError.BadFormat -Stdlib.Float.parse "-5.55555555556e+28" = Stdlib.Result.Result.Ok - -55555555555555555555555555555.5 +// Stdlib.Float.parse "-5.55555555556e+28" = Stdlib.Result.Result.Ok +// -55555555555555555555555555555.5 //Stdlib.Float.parse_v0 "0xffffffffffffffff" = Stdlib.Result.Result.Ok 1.844674407e+19 -Stdlib.Float.parse_v0 "-1.8E+308" = Stdlib.Result.Result.Ok - Builtin.testNegativeInfinity_v0 +// Stdlib.Float.parse_v0 "-1.8E+308" = Stdlib.Result.Result.Ok +// Builtin.testNegativeInfinity_v0 -Stdlib.Float.parse_v0 "1.8E+308" = Stdlib.Result.Result.Ok Builtin.testInfinity_v0 +//Stdlib.Float.parse_v0 "1.8E+308" = Stdlib.Result.Result.Ok Builtin.testInfinity_v0 Stdlib.Float.power_v0 4.0 -0.5 = 0.5 Stdlib.Float.power_v0 4.0 0.5 = 2.0 @@ -177,7 +177,7 @@ Stdlib.Float.sqrt_v0 0.0 = 0.0 Stdlib.Float.subtract_v0 1.0 0.2 = 0.8 -Stdlib.Float.sum_v0 [ 1.0; 0.2 ] = 1.2 +//Stdlib.Float.sum_v0 [ 1.0; 0.2 ] = 1.2 Builtin.testNan_v0 == Builtin.testNan_v0 = false diff --git a/backend/testfiles/execution/stdlib/_nomodule.dark b/backend/testfiles/execution/stdlib/nomodule.dark similarity index 68% rename from backend/testfiles/execution/stdlib/_nomodule.dark rename to backend/testfiles/execution/stdlib/nomodule.dark index c8ca2c31f2..c2ea70a4b5 100644 --- a/backend/testfiles/execution/stdlib/_nomodule.dark +++ b/backend/testfiles/execution/stdlib/nomodule.dark @@ -170,79 +170,79 @@ module Equals = (Stdlib.Uuid.parse_v0 "3700adbc-7a46-4ff4-81d3-45afb03f6e2e" != Stdlib.Uuid.parse_v0 "3700adbc-7a46-4ff4-81d3-45afb03f6e2d") = true - (fun x -> y) = (fun x -> y) - ((fun x -> let y = 1Q in y) == (fun x -> let y = 1Q in y)) = true - ((fun x -> let y = 1Q in y) != (fun x -> let y = 2Q in x)) = true + //(fun x -> y) = (fun x -> y) + // ((fun x -> let y = 1Q in y) == (fun x -> let y = 1Q in y)) = true + // ((fun x -> let y = 1Q in y) != (fun x -> let y = 2Q in x)) = true - ((fun x -> let y = 1Z in y) == (fun x -> let y = 1Z in y)) = true - ((fun x -> let y = 1Z in y) != (fun x -> let y = 2Z in x)) = true + // ((fun x -> let y = 1Z in y) == (fun x -> let y = 1Z in y)) = true + // ((fun x -> let y = 1Z in y) != (fun x -> let y = 2Z in x)) = true - ((fun x -> let y = 1L in y) == (fun x -> let y = 1L in y)) = true - ((fun x -> let y = 1L in y) != (fun x -> let y = 2L in x)) = true + // ((fun x -> let y = 1L in y) == (fun x -> let y = 1L in y)) = true + // ((fun x -> let y = 1L in y) != (fun x -> let y = 2L in x)) = true - ((fun x -> let y = 1l in y) == (fun x -> let y = 1l in y)) = true - ((fun x -> let y = 1l in y) != (fun x -> let y = 2l in x)) = true + // ((fun x -> let y = 1l in y) == (fun x -> let y = 1l in y)) = true + // ((fun x -> let y = 1l in y) != (fun x -> let y = 2l in x)) = true - ((fun x -> let y = 1ul in y) == (fun x -> let y = 1ul in y)) = true - ((fun x -> let y = 1ul in y) != (fun x -> let y = 2ul in x)) = true + // ((fun x -> let y = 1ul in y) == (fun x -> let y = 1ul in y)) = true + // ((fun x -> let y = 1ul in y) != (fun x -> let y = 2ul in x)) = true - ((fun x -> let y = 1s in y) == (fun x -> let y = 1s in y)) = true - ((fun x -> let y = 1s in y) != (fun x -> let y = 2s in x)) = true + // ((fun x -> let y = 1s in y) == (fun x -> let y = 1s in y)) = true + // ((fun x -> let y = 1s in y) != (fun x -> let y = 2s in x)) = true - ((fun x -> let y = 1us in y) == (fun x -> let y = 1us in y)) = true - ((fun x -> let y = 1us in y) != (fun x -> let y = 2us in x)) = true + // ((fun x -> let y = 1us in y) == (fun x -> let y = 1us in y)) = true + // ((fun x -> let y = 1us in y) != (fun x -> let y = 2us in x)) = true - ((fun x -> let y = 1y in y) == (fun x -> let y = 1y in y)) = true - ((fun x -> let y = 1y in y) != (fun x -> let y = 2y in x)) = true + // ((fun x -> let y = 1y in y) == (fun x -> let y = 1y in y)) = true + // ((fun x -> let y = 1y in y) != (fun x -> let y = 2y in x)) = true - ((fun x -> let y = 1uy in y) == (fun x -> let y = 1uy in y)) = true - ((fun x -> let y = 1uy in y) != (fun x -> let y = 2uy in x)) = true + // ((fun x -> let y = 1uy in y) == (fun x -> let y = 1uy in y)) = true + // ((fun x -> let y = 1uy in y) != (fun x -> let y = 2uy in x)) = true (ERecInt128 { x = 6Q; y = 7Q } == ERecInt128 { x = 6Q; y = 7Q }) = true (ERecInt128 { x = 6Q; y = 7Q } == ERecInt128 { y = 7Q; x = 6Q }) = true (ERecInt128 { x = 6Q; y = 7Q } != ERecInt128 { x = 7Q; y = 6Q }) = true - (ERecInt128 { x = 6Q; y = 7Q } == ERec2Int128 { y = 7Q; x = 6Q }) = true + //(ERecInt128 { x = 6Q; y = 7Q } == ERec2Int128 { y = 7Q; x = 6Q }) = true (ERecUInt128 { x = 6Z; y = 7Z } == ERecUInt128 { x = 6Z; y = 7Z }) = true (ERecUInt128 { x = 6Z; y = 7Z } == ERecUInt128 { y = 7Z; x = 6Z }) = true (ERecUInt128 { x = 6Z; y = 7Z } != ERecUInt128 { x = 7Z; y = 6Z }) = true - (ERecUInt128 { x = 6Z; y = 7Z } == ERec2UInt128 { y = 7Z; x = 6Z }) = true + //(ERecUInt128 { x = 6Z; y = 7Z } == ERec2UInt128 { y = 7Z; x = 6Z }) = true (ERec { x = 6L; y = 7L } == ERec { x = 6L; y = 7L }) = true (ERec { x = 6L; y = 7L } == ERec { y = 7L; x = 6L }) = true (ERec { x = 6L; y = 7L } != ERec { x = 7L; y = 6L }) = true - (ERec { x = 6L; y = 7L } == ERec2 { y = 7L; x = 6L }) = true + //(ERec { x = 6L; y = 7L } == ERec2 { y = 7L; x = 6L }) = true (ERecUInt64 { x = 6UL; y = 7UL } == ERecUInt64 { x = 6UL; y = 7UL }) = true (ERecUInt64 { x = 6UL; y = 7UL } == ERecUInt64 { y = 7UL; x = 6UL }) = true (ERecUInt64 { x = 6UL; y = 7UL } != ERecUInt64 { x = 7UL; y = 6UL }) = true - (ERecUInt64 { x = 6UL; y = 7UL } == ERec2UInt64 { y = 7UL; x = 6UL }) = true + //(ERecUInt64 { x = 6UL; y = 7UL } == ERec2UInt64 { y = 7UL; x = 6UL }) = true (ERecInt32 { x = 6l; y = 7l } == ERecInt32 { x = 6l; y = 7l }) = true (ERecInt32 { x = 6l; y = 7l } == ERecInt32 { y = 7l; x = 6l }) = true (ERecInt32 { x = 6l; y = 7l } != ERecInt32 { x = 7l; y = 6l }) = true - (ERecInt32 { x = 6l; y = 7l } == ERec2Int32 { y = 7l; x = 6l }) = true + //(ERecInt32 { x = 6l; y = 7l } == ERec2Int32 { y = 7l; x = 6l }) = true (ERecUInt32 { x = 6ul; y = 7ul } == ERecUInt32 { x = 6ul; y = 7ul }) = true (ERecUInt32 { x = 6ul; y = 7ul } == ERecUInt32 { y = 7ul; x = 6ul }) = true (ERecUInt32 { x = 6ul; y = 7ul } != ERecUInt32 { x = 7ul; y = 6ul }) = true - (ERecUInt32 { x = 6ul; y = 7ul } == ERec2UInt32 { y = 7ul; x = 6ul }) = true + //(ERecUInt32 { x = 6ul; y = 7ul } == ERec2UInt32 { y = 7ul; x = 6ul }) = true (ERecInt16 { x = 6s; y = 7s } == ERecInt16 { x = 6s; y = 7s }) = true (ERecInt16 { x = 6s; y = 7s } == ERecInt16 { y = 7s; x = 6s }) = true (ERecInt16 { x = 6s; y = 7s } != ERecInt16 { x = 7s; y = 6s }) = true - (ERecInt16 { x = 6s; y = 7s } == ERec2Int16 { y = 7s; x = 6s }) = true + //(ERecInt16 { x = 6s; y = 7s } == ERec2Int16 { y = 7s; x = 6s }) = true (ERecUInt16 { x = 6us; y = 7us } == ERecUInt16 { x = 6us; y = 7us }) = true (ERecUInt16 { x = 6us; y = 7us } == ERecUInt16 { y = 7us; x = 6us }) = true (ERecUInt16 { x = 6us; y = 7us } != ERecUInt16 { x = 7us; y = 6us }) = true - (ERecUInt16 { x = 6us; y = 7us } == ERec2UInt16 { y = 7us; x = 6us }) = true + //(ERecUInt16 { x = 6us; y = 7us } == ERec2UInt16 { y = 7us; x = 6us }) = true (ERecInt8 { x = 6y; y = 7y } == ERecInt8 { x = 6y; y = 7y }) = true (ERecInt8 { x = 6y; y = 7y } == ERecInt8 { y = 7y; x = 6y }) = true (ERecInt8 { x = 6y; y = 7y } != ERecInt8 { x = 7y; y = 6y }) = true - (ERecInt8 { x = 6y; y = 7y } == ERec2Int8 { y = 7y; x = 6y }) = true + //(ERecInt8 { x = 6y; y = 7y } == ERec2Int8 { y = 7y; x = 6y }) = true (ERecUInt8 { x = 6uy; y = 7uy } == ERecUInt8 { x = 6uy; y = 7uy }) = true (ERecUInt8 { x = 6uy; y = 7uy } == ERecUInt8 { y = 7uy; x = 6uy }) = true @@ -290,80 +290,80 @@ module Equals = (EEnumInt8.E3 5y == EEnumInt8.E3 5y) = true (EEnumInt8.E3 5y != EEnumInt8.E3 6y) = true - // aliases - (EEnum2Int128.E1 == EEnumInt128.E1) = true - (EEnum2Int128.E1 != EEnumInt128.E2) = true - (EEnum2UInt128.E1 == EEnumUInt128.E1) = true - (EEnum2UInt128.E1 != EEnumUInt128.E2) = true + // // aliases + // (EEnum2Int128.E1 == EEnumInt128.E1) = true + // (EEnum2Int128.E1 != EEnumInt128.E2) = true + // (EEnum2UInt128.E1 == EEnumUInt128.E1) = true + // (EEnum2UInt128.E1 != EEnumUInt128.E2) = true - (EEnum2.E1 == EEnum.E1) = true - (EEnum2.E1 != EEnum.E2) = true - (EEnum2UIn64.E1 == EEnumUIn64.E1) = true - (EEnum2UIn64.E1 != EEnumUIn64.E2) = true + // (EEnum2.E1 == EEnum.E1) = true + // (EEnum2.E1 != EEnum.E2) = true + // (EEnum2UIn64.E1 == EEnumUIn64.E1) = true + // (EEnum2UIn64.E1 != EEnumUIn64.E2) = true - (EEnum2Int32.E1 == EEnumInt32.E1) = true - (EEnum2Int32.E1 != EEnumInt32.E2) = true - (EEnum2UInt32.E1 == EEnumUInt32.E1) = true - (EEnum2UInt32.E1 != EEnumUInt32.E2) = true + // (EEnum2Int32.E1 == EEnumInt32.E1) = true + // (EEnum2Int32.E1 != EEnumInt32.E2) = true + // (EEnum2UInt32.E1 == EEnumUInt32.E1) = true + // (EEnum2UInt32.E1 != EEnumUInt32.E2) = true - (EEnum2Int16.E1 == EEnumInt16.E1) = true - (EEnum2Int16.E1 != EEnumInt16.E2) = true - (EEnum2UInt16.E1 == EEnumUInt16.E1) = true - (EEnum2UInt16.E1 != EEnumUInt16.E2) = true + // (EEnum2Int16.E1 == EEnumInt16.E1) = true + // (EEnum2Int16.E1 != EEnumInt16.E2) = true + // (EEnum2UInt16.E1 == EEnumUInt16.E1) = true + // (EEnum2UInt16.E1 != EEnumUInt16.E2) = true - (EEnum2Int8.E1 == EEnumInt8.E1) = true - (EEnum2Int8.E1 != EEnumInt8.E2) = true - (EEnum2UInt8.E1 == EEnumUInt8.E1) = true - (EEnum2UInt8.E1 != EEnumUInt8.E2) = true + // (EEnum2Int8.E1 == EEnumInt8.E1) = true + // (EEnum2Int8.E1 != EEnumInt8.E2) = true + // (EEnum2UInt8.E1 == EEnumUInt8.E1) = true + // (EEnum2UInt8.E1 != EEnumUInt8.E2) = true - (Stdlib.Option.Option.None == Stdlib.Option.Option.None) = true + // (Stdlib.Option.Option.None == Stdlib.Option.Option.None) = true - (Stdlib.Option.Option.None != Stdlib.Option.Option.Some Stdlib.Option.Option.None) = true + // (Stdlib.Option.Option.None != Stdlib.Option.Option.Some Stdlib.Option.Option.None) = true - (Stdlib.Option.Option.Some 5L == Stdlib.Option.Option.Some 5L) = true + // (Stdlib.Option.Option.Some 5L == Stdlib.Option.Option.Some 5L) = true - (Stdlib.Option.Option.Some 5L != Stdlib.Option.Option.Some 6L) = true + // (Stdlib.Option.Option.Some 5L != Stdlib.Option.Option.Some 6L) = true - (Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L) - != Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 1L)) = true + // (Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L) + // != Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 1L)) = true - (Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L) - == Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L)) = true + // (Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L) + // == Stdlib.Option.Option.Some(Stdlib.Option.Option.Some 0L)) = true - (Stdlib.Result.Result.Error 0L == Stdlib.Result.Result.Error 0L) = true + // (Stdlib.Result.Result.Error 0L == Stdlib.Result.Result.Error 0L) = true - (Stdlib.Result.Result.Ok 0L == Stdlib.Result.Result.Ok 0L) = true + // (Stdlib.Result.Result.Ok 0L == Stdlib.Result.Result.Ok 0L) = true - (Stdlib.Result.Result.Ok 0L != Stdlib.Result.Result.Error 0L) = true + // (Stdlib.Result.Result.Ok 0L != Stdlib.Result.Result.Error 0L) = true type MyDBType = { x: String; y: String } - [] - type MyDB = MyDBType + // [] + // type MyDB = MyDBType - (MyDB == MyDB) = true + // (MyDB == MyDB) = true - module TypeErrors = - (5.7 != 6L) = Builtin.testDerrorMessage "Both values must be the same type" - (5.7 != 5L) = Builtin.testDerrorMessage "Both values must be the same type" + // module TypeErrors = + // (5.7 != 6L) = Builtin.testDerrorMessage "Both values must be the same type" + // (5.7 != 5L) = Builtin.testDerrorMessage "Both values must be the same type" - (5us == 5s) = Builtin.testDerrorMessage "Both values must be the same type" - (5y == 5l) = Builtin.testDerrorMessage "Both values must be the same type" - (5L == 5l) = Builtin.testDerrorMessage "Both values must be the same type" - (5us != 6s) = Builtin.testDerrorMessage "Both values must be the same type" + // (5us == 5s) = Builtin.testDerrorMessage "Both values must be the same type" + // (5y == 5l) = Builtin.testDerrorMessage "Both values must be the same type" + // (5L == 5l) = Builtin.testDerrorMessage "Both values must be the same type" + // (5us != 6s) = Builtin.testDerrorMessage "Both values must be the same type" - (Builtin.testRuntimeError "test" != Builtin.testRuntimeError "different msg") = Builtin.testDerrorMessage - "test" + // (Builtin.testRuntimeError "test" != Builtin.testRuntimeError "different msg") = Builtin.testDerrorMessage + // "test" - (() != Stdlib.Option.Option.None) = Builtin.testDerrorMessage - "Both values must be the same type" + // (() != Stdlib.Option.Option.None) = Builtin.testDerrorMessage + // "Both values must be the same type" - (() != false) = Builtin.testDerrorMessage "Both values must be the same type" - (() != 0) = Builtin.testDerrorMessage "Both values must be the same type" - (() != 0.0) = Builtin.testDerrorMessage "Both values must be the same type" - (MyDB != 5L) = Builtin.testDerrorMessage "Both values must be the same type" + // (() != false) = Builtin.testDerrorMessage "Both values must be the same type" + // (() != 0) = Builtin.testDerrorMessage "Both values must be the same type" + // (() != 0.0) = Builtin.testDerrorMessage "Both values must be the same type" + // (MyDB != 5L) = Builtin.testDerrorMessage "Both values must be the same type" // Other ways to call it Stdlib.equals_v0 1Q 1Q = true diff --git a/backend/testfiles/execution/stdlib/string.dark b/backend/testfiles/execution/stdlib/string.dark new file mode 100644 index 0000000000..fa6392b283 --- /dev/null +++ b/backend/testfiles/execution/stdlib/string.dark @@ -0,0 +1,968 @@ +let c (arg: String) : Char = + (Builtin.testToChar_v0 arg) |> Builtin.unwrap + +module Equality = + "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + "Είναι προικισμένοι με λογική" = "Είναι προικισμένοι με λογική" + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + +module Append = + "" ++ "" = "" + "a" ++ "̂" = "â" + "hello" ++ " world" = "hello world" + "ᄀ" ++ "ᅡᆨ" = "각" + "" ++ "a" = "a" + "a" ++ "" = "a" + "a" ++ "̂" = "â" + + //Stdlib.String.append "a" "̂" = "â" + Stdlib.String.append "" "" = "" + Stdlib.String.append "hello" " world" = "hello world" + Stdlib.String.append "hello" "world" = "helloworld" // Stdlib.String.append works for ASCII range + //Stdlib.String.append "ᄀ" "ᅡᆨ" = "각" + Stdlib.String.append "żółw" "😄" = "żółw😄" // Stdlib.String.append works on non-ascii strings + Stdlib.String.append "🧑🏼‍💻" "🧑🏻‍🍼" = "🧑🏼‍💻🧑🏻‍🍼" + Stdlib.String.append "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.append "🧟‍♂️🧟‍♀️" "🧟‍♂️" = "🧟‍♂️🧟‍♀️🧟‍♂️" + Stdlib.String.append "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "👨‍❤️‍💋‍👨" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇👨‍❤️‍💋‍👨" + + +module Join = + (Stdlib.String.join_v0 [ "a"; "b"; "c"; "d" ] "|") = "a|b|c|d" + + (Stdlib.String.join_v0 [ "a"; "̂" ] "") |> Stdlib.String.base64UrlEncode_v0 = "w6I" + + Stdlib.String.join_v0 [ "hello"; " world" ] "" = "hello world" + Stdlib.String.join_v0 [ "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽"; "🧟‍♀️" ] "" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽🧟‍♀️" + + Stdlib.String.join_v0 [ "👱👱🏻👱🏼👱🏽👱🏾👱🏿"; "👨‍❤️‍💋‍👨"; "﷽﷽﷽" ] "" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿👨‍❤️‍💋‍👨﷽﷽﷽" + + Stdlib.String.join_v0 [ "🧟‍♀️🧟‍♂️"; "🧟‍♀️🧑🏽‍🦰" ] "" = "🧟‍♀️🧟‍♂️🧟‍♀️🧑🏽‍🦰" + + Stdlib.String.join_v0 [ "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️"; "‍⚧️‍️🇵🇷" ] "" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + + Stdlib.String.join_v0 [ "🧟‍♀️🧟‍♂️‍"; "🧟‍♀️🧑🏽‍🦰‍‍" ] "" = "🧟‍♀️🧟‍♂️‍🧟‍♀️🧑🏽‍🦰‍‍" + Stdlib.String.join_v0 [ "🧑🏽‍🦰‍"; "🧑🏼‍💻‍‍" ] "" = "🧑🏽‍🦰‍🧑🏼‍💻‍‍" + +module ToBytes = + Stdlib.List.length (Stdlib.String.toBytes_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿") = 62L + Stdlib.List.length (Stdlib.String.toBytes_v0 "😄APPLE🍏") = 13L + Stdlib.List.length (Stdlib.String.toBytes_v0 "Είναι προικισμένοι με λογική") = 53L + Stdlib.List.length (Stdlib.String.toBytes_v0 "") = 0L + Stdlib.List.length (Stdlib.String.toBytes_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿") = 62L + Stdlib.List.length (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = 48L + Stdlib.List.length (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = 44L + Stdlib.List.length (Stdlib.String.toBytes_v0 "🧟‍♀️🧟‍♂️") = 26L + Stdlib.List.length (Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷") = 82L + Stdlib.List.length (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = 49L + Stdlib.List.length (Stdlib.String.toBytes_v0 "") = 0L + + +module FromBytesWithReplacement = + Stdlib.String.fromBytesWithReplacement_v0 ( + (Stdlib.Base64.decode_v0 "w6I") |> Builtin.unwrap + ) = "â" + + Stdlib.String.fromBytesWithReplacement_v0 ( + (Stdlib.Base64.decode_v0 "aGVsbG8g8J+YgA==") |> Builtin.unwrap + ) = "hello 😀" + + Stdlib.String.fromBytesWithReplacement_v0 ( + (Stdlib.Base64.decode_v0 "ww==") |> Builtin.unwrap + ) = "�" + + Stdlib.String.fromBytesWithReplacement_v0 ( + (Stdlib.Base64.decode_v0 "7aCA") |> Builtin.unwrap + ) = "���" + + Stdlib.String.fromBytesWithReplacement_v0 ( + (Stdlib.Base64.decode_v0 "aMM=") |> Builtin.unwrap + ) = "h�" + + +// module FromBytes = +// Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "w6I") |> Builtin.unwrap) = Stdlib.Option.Option.Some +// "â" + +// Stdlib.String.fromBytes_v0 ( +// (Stdlib.Base64.decode_v0 "aGVsbG8g8J+YgA==") |> Builtin.unwrap +// ) = Stdlib.Option.Option.Some "hello 😀" + +// Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "ww==") |> Builtin.unwrap) = Stdlib.Option.Option.None + +// Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "7aCA") |> Builtin.unwrap) = Stdlib.Option.Option.None + +// Stdlib.String.fromBytes_v0 ((Stdlib.Base64.decode_v0 "aMM=") |> Builtin.unwrap) = Stdlib.Option.Option.None + + +module StartsWith = + Stdlib.String.startsWith_v0 "a string" "a s" = true + Stdlib.String.startsWith_v0 "a string" " s" = false + Stdlib.String.startsWith_v0 "żółw" "żó" = true + Stdlib.String.startsWith_v0 "żółw" "r22" = false + Stdlib.String.startsWith_v0 "👩🏻‍🚀🍇" "🍇" = false + Stdlib.String.startsWith_v0 "123456" "123" = true + Stdlib.String.startsWith_v0 "" "" = true + Stdlib.String.startsWith_v0 "E" "\u0014\u0004" = false + + Stdlib.String.startsWith_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏾‍🦰" = false + + Stdlib.String.startsWith_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" = true + + Stdlib.String.startsWith_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽﷽﷽" = true + Stdlib.String.startsWith_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏿" = false + Stdlib.String.startsWith_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = false + + Stdlib.String.startsWith_v0 + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" = true + + Stdlib.String.startsWith_v0 "a string" "" = true + +module EndsWith = + Stdlib.String.endsWith_v0 "a string" "in" = false + Stdlib.String.endsWith_v0 "a string" "ing" = true + Stdlib.String.endsWith_v0 "a string" "" = true + Stdlib.String.endsWith_v0 "żółw" "żó" = false + Stdlib.String.endsWith_v0 "żółw" "łw" = true + Stdlib.String.endsWith_v0 "👩🏻‍🚀🍇" "🍇" = true + Stdlib.String.endsWith_v0 "123456" "56" = true + Stdlib.String.endsWith_v0 "" "" = true + Stdlib.String.endsWith_v0 "E" "\u0014\u0004" = false + Stdlib.String.endsWith_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "✋✋🏿✋🏿" = false + + Stdlib.String.endsWith_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "ǧ̗͚̚o̙̔ͮ̇͐̇" = true + + Stdlib.String.endsWith_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "12xsd" = false + Stdlib.String.endsWith_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "﷽" = false + Stdlib.String.endsWith_v0 "🧟‍♀️🧟‍♂️" "🧟‍♀️" = false + + Stdlib.String.endsWith_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🏳️‍⚧️‍️🇵🇷" = true + + +// module Map = +// Stdlib.String.map "a string" (fun x -> x) = "a string" +// Stdlib.String.map "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" (fun x -> x) = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.map "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" (fun x -> x) = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" +// Stdlib.String.map "👱👱🏻👱🏼👱🏽👱🏾👱🏿" (fun x -> x) = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" +// Stdlib.String.map "🧟‍♀️🧟‍♂️" (fun x -> x) = "🧟‍♀️🧟‍♂️" + +// Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> x) = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + +// Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 'c') = "cccc" + +// // CLEANUP: it should be a type error on the function not returning a Char +// Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 5L) = Builtin.testDerrorMessage +// """PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ 5, 5, ...) was passed instead. + +// Expected: (lst: List) +// Actual: a List: [ +// 5, 5, 5, 5 +// ]""" + + +// // Check that map executes the right number of times +// (let v = +// Stdlib.String.map "a string" (fun x -> +// let _ = Builtin.testIncrementSideEffectCounter_v0 false in 'c') + +// (v, Builtin.testSideEffectCount_v0 ())) = ("cccccccc", 8L) + + +module FromChar = + Stdlib.String.fromChar 'a' = "a" + Stdlib.String.fromChar (c "1") = "1" + Stdlib.String.fromChar (c "👩‍👩‍👧‍👦") = "👩‍👩‍👧‍👦" + Stdlib.String.fromChar (c "🏳️‍⚧️‍️") = "🏳️‍⚧️‍️" + Stdlib.String.fromChar (c "👱🏾") = "👱🏾" + Stdlib.String.fromChar (c "Z̤͔ͧ̑̓") = "Z̤͔ͧ̑̓" + + + +module Base64Decode = + Stdlib.String.base64Decode_v0 "random string" = Stdlib.Result.Result.Error + "Not a valid base64 string" + + Stdlib.String.base64Decode_v0 "illegal chars&@:" = Stdlib.Result.Result.Error + "Not a valid base64 string" + + Stdlib.String.base64Decode_v0 "Kw" = Stdlib.Result.Result.Ok "+" + + Stdlib.String.base64Decode_v0 "yLo" = Stdlib.Result.Result.Ok "Ⱥ" + + Stdlib.String.base64Decode_v0 "xbzDs8WCdw" = Stdlib.Result.Result.Ok "żółw" + + Stdlib.String.base64Decode_v0 "LyotKygmQDk4NTIx" = Stdlib.Result.Result.Ok + "/*-+(&@98521" + + Stdlib.String.base64Decode_v0 "" = Stdlib.Result.Result.Ok "" // empty case + + + // Test cases from the spec with padding added + Stdlib.String.base64Decode_v0 "Zg" = Stdlib.Result.Result.Ok "f" + + Stdlib.String.base64Decode_v0 "Zg==" = Stdlib.Result.Result.Ok "f" + + Stdlib.String.base64Decode_v0 "Zm8" = Stdlib.Result.Result.Ok "fo" + + Stdlib.String.base64Decode_v0 "Zm8=" = Stdlib.Result.Result.Ok "fo" + + Stdlib.String.base64Decode_v0 "Zm9v" = Stdlib.Result.Result.Ok "foo" + + Stdlib.String.base64Decode_v0 "Zm9vYg" = Stdlib.Result.Result.Ok "foob" + + Stdlib.String.base64Decode_v0 "Zm9vYg==" = Stdlib.Result.Result.Ok "foob" + + Stdlib.String.base64Decode_v0 "Zm9vYmE" = Stdlib.Result.Result.Ok "fooba" + + Stdlib.String.base64Decode_v0 "Zm9vYmE=" = Stdlib.Result.Result.Ok "fooba" + + Stdlib.String.base64Decode_v0 "Zm9vYmFy" = Stdlib.Result.Result.Ok "foobar" + + + // "Impossible cases" from apache + // https://commons.apache.org/proper/commons-codec/xref-test/org/apache/commons/codec/binary/Base64Test.html + Stdlib.String.base64Decode_v0 "ZE==" = Stdlib.Result.Result.Ok "d" + + Stdlib.String.base64Decode_v0 "ZmC=" = Stdlib.Result.Result.Ok "f`" + + Stdlib.String.base64Decode_v0 "Zm9vYE==" = Stdlib.Result.Result.Ok "foo`" + + Stdlib.String.base64Decode_v0 "Zm9vYmC=" = Stdlib.Result.Result.Ok "foob`" + + Stdlib.String.base64Decode_v0 + "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" = Stdlib.Result.Result.Ok + "from=06/07/2013 query=\"Καλώς ορίσατε\"" + + Stdlib.String.base64Decode_v0 + "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" = Stdlib.Result.Result.Ok + "👱👱🏻👱🏼👱🏽👱🏾👱🏿" + + + Stdlib.String.base64Decode_v0 "-p" = Stdlib.Result.Result.Error + "Invalid UTF-8 string" + + Stdlib.String.base64Decode_v0 "lI" = Stdlib.Result.Result.Error + "Invalid UTF-8 string" + + Stdlib.String.base64Decode_v0 "5Sk" = Stdlib.Result.Result.Error + "Invalid UTF-8 string" + + +module Base64UrlEncode = + Stdlib.String.base64UrlEncode_v0 "+" = "Kw" + Stdlib.String.base64UrlEncode_v0 "Ⱥ" = "yLo" + Stdlib.String.base64UrlEncode_v0 "żółw" = "xbzDs8WCdw" + Stdlib.String.base64UrlEncode_v0 "/*-+(&@98521" = "LyotKygmQDk4NTIx" + Stdlib.String.base64UrlEncode_v0 "" = "" + Stdlib.String.base64UrlEncode_v0 "f" = "Zg" + Stdlib.String.base64UrlEncode_v0 "fo" = "Zm8" + Stdlib.String.base64UrlEncode_v0 "foo" = "Zm9v" + Stdlib.String.base64UrlEncode_v0 "foob" = "Zm9vYg" + Stdlib.String.base64UrlEncode_v0 "fooba" = "Zm9vYmE" + Stdlib.String.base64UrlEncode_v0 "foobar" = "Zm9vYmFy" + Stdlib.String.base64UrlEncode_v0 "Hello World" = "SGVsbG8gV29ybGQ" + + Stdlib.String.base64UrlEncode_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"" = "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" + + Stdlib.String.base64UrlEncode_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" + + +module Base64Encode = + Stdlib.String.base64Encode_v0 "+" = "Kw==" + Stdlib.String.base64Encode_v0 "Ⱥ" = "yLo=" + Stdlib.String.base64Encode_v0 "żółw" = "xbzDs8WCdw==" + Stdlib.String.base64Encode_v0 "/*-+(&@98521" = "LyotKygmQDk4NTIx" + Stdlib.String.base64Encode_v0 "" = "" + Stdlib.String.base64Encode_v0 "f" = "Zg==" + Stdlib.String.base64Encode_v0 "fo" = "Zm8=" + Stdlib.String.base64Encode_v0 "foo" = "Zm9v" + Stdlib.String.base64Encode_v0 "foob" = "Zm9vYg==" + Stdlib.String.base64Encode_v0 "fooba" = "Zm9vYmE=" + Stdlib.String.base64Encode_v0 "foobar" = "Zm9vYmFy" + Stdlib.String.base64Encode_v0 "Hello World" = "SGVsbG8gV29ybGQ=" + + Stdlib.String.base64Encode_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"" = "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs+CIM6/z4HOr8+DzrHPhM61Ig==" + + Stdlib.String.base64Encode_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "8J+RsfCfkbHwn4+78J+RsfCfj7zwn5Gx8J+PvfCfkbHwn4++8J+RsfCfj78=" + + +module Digest = + Stdlib.String.digest_v0 "" = "OLBgp1GsljhM2TJ-sbHjaiH9txEUvgdDTAzHv2P24donTt6_529l-9Ua0vFImLlb" + Stdlib.String.digest_v0 "😄" = "Z2Y7YuyYHR9miKrg6mLtxSTaHRpGZuaenmGQl3QFY58pwhPCK2bIYxJQ728ChJwA" + Stdlib.String.digest_v0 "ελπίδα" = "j4uJEeBe6g8QrzbuxoI2roUgapGQiExE8CWEQqZao61eZVN1iSZ8cV39IM1nGqsa" + Stdlib.String.digest_v0 "/*-+(&@98521" = "wSGXFkLMpPufNoF2mUBAjT4YlUEb9cl0Iliy4qohwt1XFpg51PRJVTWndn5PewSr" + Stdlib.String.digest_v0 "👩🏻‍🚀🍇" = "hVrNUSbFOfYXwZe6zQRUFFfGPe90qr-aROG2n-hMk8kAC-xodOyHOqecLWb9HIKJ" + Stdlib.String.digest_v0 "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" = "7Fo0ImavUzoUM_9kdjucgh6pYAHk5VovpTOUObvxacS31QoCTkcE4rpcQbJJpshE" + Stdlib.String.digest_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "U2v72uGbUR_UIiD5qF6L21pKzYi4B6OB76HGtbpM0o-2_4YB3ytPjJ7w9png3L9k" + Stdlib.String.digest_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "c1Wm67axXlBaejcJZxct80MvexdTtyyrTK9J9-_4RqgP1pf4Bk9SoMZpsnXpvLIx" + Stdlib.String.digest_v0 "🧟‍♀️🧟‍♂️" = "FBnrDureCzgPeGP9qOuW1BIiF2Wz5WejO5XtJWa81qCxcD6cZ4A_WAB0ZJzhOErc" + Stdlib.String.digest_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "3QFqrhTPpxeje6XUNObFt2eJZZ1t0pAcX42AFdFVv42hco0bTOopQK3py4KMBT0m" + + +// module Random = +// (Stdlib.String.random 5L) == (Stdlib.String.random 5L) = false + +// Stdlib.String.random -1L = Stdlib.Result.Result.Error +// "Expected `length` to be positive, but it was `-1`" + +// Stdlib.String.length ((Stdlib.String.random 10L) |> Builtin.unwrap) = 10L + +// Stdlib.String.length ((Stdlib.String.random 5L) |> Builtin.unwrap) = 5L + +// Stdlib.String.length ((Stdlib.String.random 0L) |> Builtin.unwrap) = 0L + + +// module HtmlEscape = +// Stdlib.String.htmlEscape_v0 "test<>&\"" = "test<>&"" // HTML escaping works reasonably + +// Stdlib.String.htmlEscape_v0 +// "

This is f#

" = "<html><head></head><body><h1>This is f#</h1></body></html>" // HTML escaping works reasonably + +// Stdlib.String.htmlEscape_v0 +// "" = "<html><head><!-- head definitions go here --></head><body><!-- the content goes here --></body></html>" + +// Stdlib.String.htmlEscape_v0 "" = "" +// Stdlib.String.htmlEscape_v0 "😄" = "😄" +// Stdlib.String.htmlEscape_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + +// Stdlib.String.htmlEscape_v0 "

﷽﷽﷽﷽﷽

" = "<html><head></head><body><h1>﷽﷽﷽﷽﷽</h1></body></html>" + +// Stdlib.String.htmlEscape_v0 "🧟‍♀️🧟‍♂️" = "<head>🧟‍♀️🧟‍♂️</head>" +// Stdlib.String.htmlEscape_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + + +module IsEmpty = + Stdlib.String.isEmpty_v0 "" = true + Stdlib.String.isEmpty_v0 "a" = false + Stdlib.String.isEmpty_v0 "🧑🏼‍💻🧑🏻‍🍼" = false + Stdlib.String.isEmpty_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = false + Stdlib.String.isEmpty_v0 "﷽﷽﷽﷽﷽" = false + Stdlib.String.isEmpty_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = false + Stdlib.String.isEmpty_v0 "🧟‍♀️🧟‍♂️" = false + Stdlib.String.isEmpty_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = false + + +module NewLine = + Stdlib.String.newline = "\n" + + +module Length = + Stdlib.String.length "😄" = 1L + Stdlib.String.length "" = 0L + Stdlib.String.length "abcdef" = 6L + Stdlib.String.length "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" = 6L + Stdlib.String.length "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = 5L + Stdlib.String.length "﷽﷽﷽﷽﷽" = 5L + Stdlib.String.length "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = 6L + Stdlib.String.length "🧟‍♀️🧟‍♂️" = 2L + Stdlib.String.length "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = 4L + + +module Prepend = + Stdlib.String.prepend_v0 "hello" "world" = "worldhello" // Stdlib.String.prepend works for ASCII range + Stdlib.String.prepend_v0 "hello" "" = "hello" + Stdlib.String.prepend_v0 "" "hello" = "hello" + Stdlib.String.prepend_v0 "żółw" "😄" = "😄żółw" // Stdlib.String.prepend works on non-ascii strings + Stdlib.String.prepend_v0 "123" "456" = "456123" + Stdlib.String.prepend_v0 "óñÜá" "abc" = "abcóñÜá" + Stdlib.String.prepend_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓" = "Z̤͔ͧ̑̓Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.prepend_v0 "﷽﷽﷽﷽﷽" "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨﷽﷽﷽﷽﷽" + Stdlib.String.prepend_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.prepend_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "✋🏻" = "✋🏻👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.prepend_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = "🧟‍♂️🧟‍♀️🧟‍♂️" + Stdlib.String.prepend_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.prepend_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧟‍♂️" = "🧟‍♂️żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + + +module ReplaceAll = + Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "b" "x" = "axcABCcxaCBA" + Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "" "x" = "xaxbxcxAxBxCxcxbxaxCxBxAx" + Stdlib.String.replaceAll_v0 "" "" "&" = "&" + Stdlib.String.replaceAll_v0 "abcABCcbaCBA" "b" "" = "acABCcaCBA" + + Stdlib.String.replaceAll_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "ä͖̭̈̇" "$" = "Z̤͔ͧ̑̓$lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + + Stdlib.String.replaceAll_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽" "$" = "$$$$$$$$" + Stdlib.String.replaceAll_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏽" "✋🏻" = "👱👱🏻👱🏼✋🏻👱🏾👱🏿" + Stdlib.String.replaceAll_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" "🧑🏽‍🦰" = "🧟‍♀️🧑🏽‍🦰" + + Stdlib.String.replaceAll_v0 + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + "👨‍❤️‍💋‍👨" + "👨‍❤️‍💋‍👨" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + + Stdlib.String.replaceAll_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" "🧟‍♂️" = "żółw🧑🏽‍🦰🧟‍♂️✋✋🏻✋🏿" + + +module Slugify = + Builtin.stringSlugify + " M@y 'super' Really- exce+llent *Uber_ ama\"zing* ~very 5x5 ~ \"clever\" thing: coffee😭!" = "my-super-really-excellent-uber-amazing-very-5x5-clever-thing-coffee" + + Builtin.stringSlugify + " m@y 'super' really- excellent *uber_ amazing* ~very ~ \"clever\" thing: coffee😭!" = "my-super-really-excellent-uber-amazing-very-clever-thing-coffee" + + Builtin.stringSlugify "" = "" + Builtin.stringSlugify "ABCD-45646sassa" = "abcd-45646sassa" + Builtin.stringSlugify "ddsd516ds125sd12sd12Ü" = "ddsd516ds125sd12sd12" + Builtin.stringSlugify "q=\u0002$\u001a<+MC" = "qmc" + Builtin.stringSlugify "🎁🎄Ǣʚ231" = "231" + Builtin.stringSlugify "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "" + Builtin.stringSlugify "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "zlo" + Builtin.stringSlugify "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "" + Builtin.stringSlugify "🧟‍♀️🧟‍♂️" = "" + Builtin.stringSlugify "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "" + + Builtin.stringSlugify + "b\x01c\x02d\x03e\x04f\x05g\x06h\x07i\x08j\x09k\x0Al\x0Bm\x0Cn\x0Do\x0Ep\x0Fq" = "bcdefghij-k-lm-n-opq" + + Builtin.stringSlugify + "a\x10b\x11c\x12d\x13e\x14f\x15g\x16h\x17i\x18j\x19k\x1Al\x1Bm\x1Cn\x1Do\x1Ep\x1Fq" = "abcdefghijklmnopq" + + Builtin.stringSlugify "!\"#$%&'()*+,-./" = "-" + Builtin.stringSlugify ":;<=>?@" = "" + Builtin.stringSlugify "[\\]^_`" = "-" + Builtin.stringSlugify "{|}~\x7F" = "" + + +// module FromList = +// Stdlib.String.fromList [] = "" +// Stdlib.String.fromList [ c "a" ] = "a" + +// Stdlib.String.fromList [ c "👩‍👩‍👧‍👦"; c "🏳️‍⚧️‍️"; c "👱🏾"; c "Z̤͔ͧ̑̓" ] = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" + +// Stdlib.String.fromList [ "a" ] = Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ \"a\"]) was passed instead. + +// Expected: (lst: List) +// Actual: a List: [\n \"a\"\n]" + + +module ToList = + Stdlib.String.toList "" = [] + Stdlib.String.toList "ab" = [ 'a'; 'b' ] + Stdlib.String.toList "👨‍👩‍👧‍👦" = [ c "👨‍👩‍👧‍👦" ] + + Stdlib.String.toList "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ (c "Z̤͔ͧ̑̓"); (c "ä͖̭̈̇"); (c "lͮ̒ͫ"); (c "ǧ̗͚̚"); (c "o̙̔ͮ̇͐̇") ] + + +// Stdlib.String.toList "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = [ (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") +// (c "﷽") ] + + Stdlib.String.toList "🧟‍♀️🧟‍♂️" = [ c "🧟‍♀️"; c "🧟‍♂️" ] + + Stdlib.String.toList "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = + [ (c "👱"); (c "👱🏻"); (c "👱🏼"); (c "👱🏽"); (c "👱🏾"); (c "👱🏿") ] + + +// Stdlib.String.toList "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = [ (c "ż") +// (c "ó") +// (c "ł") +// (c "w") +// (c "🧑🏽‍🦰") +// (c "🧑🏻‍🍼") +// (c "✋") +// (c "✋🏻") +// (c "✋🏿") ] + +// ("ab1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "ab1" + +// ("@Ǣá1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "@Ǣá1" + +// ("👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" +// |> Stdlib.String.toList +// |> Stdlib.String.fromList) = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" + + +module Split = + Stdlib.String.split "hello world" "notfound" = [ "hello world" ] + Stdlib.String.split "hello😄world" "😄" = [ "hello"; "world" ] + Stdlib.String.split "hello&&&&world" "&&&&" = [ "hello"; "world" ] + Stdlib.String.split "hello34564world34564sun" "😄" = [ "hello34564world34564sun" ] + + Stdlib.String.split "hello34564world34564sun" "34564" = [ "hello"; "world"; "sun" ] + + Stdlib.String.split "" "34564" = [ "" ] + Stdlib.String.split "34564" "" = [ "3"; "4"; "5"; "6"; "4" ] + + Stdlib.String.split "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" = [ "🧑🏽‍🦰🧑🏼‍💻" + "✋✋🏻✋🏿" ] + + // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ "" + // "" ] + + Stdlib.String.split "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽﷽﷽" = [ ""; ""; ""; ""; "" ] + + Stdlib.String.split "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = [ "👱👱🏻"; "👱🏾👱🏿" ] + + Stdlib.String.split "🧟‍♀️🧟‍♂️" "👱🏽" = [ "🧟‍♀️🧟‍♂️" ] + + // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = [ "👨‍❤️‍💋‍👨" + // "🏳️‍⚧️‍️🇵🇷" ] + + // Stdlib.String.split "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = [ "żółw" + // "🧑🏻‍🍼✋✋🏻✋🏿" ] + + // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" = [ "" + // "ǧ̗͚̚o̙̔ͮ̇͐̇" ] + + Stdlib.String.split "666666" "6" = [ ""; ""; ""; ""; ""; ""; "" ] + Stdlib.String.split "55555" "5" = [ ""; ""; ""; ""; ""; "" ] + Stdlib.String.split "4444" "4" = [ ""; ""; ""; ""; "" ] + Stdlib.String.split "333" "3" = [ ""; ""; ""; "" ] + Stdlib.String.split "22" "2" = [ ""; ""; "" ] + Stdlib.String.split "1" "1" = [ ""; "" ] + Stdlib.String.split "" "" = [] + + Stdlib.String.split "666666x" "6" = [ ""; ""; ""; ""; ""; ""; "x" ] + + Stdlib.String.split "55555x" "5" = [ ""; ""; ""; ""; ""; "x" ] + Stdlib.String.split "4444x" "4" = [ ""; ""; ""; ""; "x" ] + Stdlib.String.split "333x" "3" = [ ""; ""; ""; "x" ] + Stdlib.String.split "22x" "2" = [ ""; ""; "x" ] + Stdlib.String.split "1x" "1" = [ ""; "x" ] + + Stdlib.String.split "x666666" "6" = [ "x"; ""; ""; ""; ""; ""; "" ] + + Stdlib.String.split "x55555" "5" = [ "x"; ""; ""; ""; ""; "" ] + Stdlib.String.split "x4444" "4" = [ "x"; ""; ""; ""; "" ] + Stdlib.String.split "x333" "3" = [ "x"; ""; ""; "" ] + Stdlib.String.split "x22" "2" = [ "x"; ""; "" ] + Stdlib.String.split "x1" "1" = [ "x"; "" ] + + Stdlib.String.split "x666666y" "6" = [ "x"; ""; ""; ""; ""; ""; "y" ] + + Stdlib.String.split "x55555y" "5" = [ "x"; ""; ""; ""; ""; "y" ] + Stdlib.String.split "x4444y" "4" = [ "x"; ""; ""; ""; "y" ] + Stdlib.String.split "x333y" "3" = [ "x"; ""; ""; "y" ] + Stdlib.String.split "x22y" "2" = [ "x"; ""; "y" ] + Stdlib.String.split "x1y" "1" = [ "x"; "y" ] + + Stdlib.String.split "6a6aa6aaa6aaaa" "a" = [ "6" + "6" + "" + "6" + "" + "" + "6" + "" + "" + "" + "" ] + + // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "" = [ "👨‍❤️‍💋‍👨" + // "👩‍👩‍👧‍👦" + // "🏳️‍⚧️‍️" + // "🇵🇷" ] + + Stdlib.String.split "👨‍👩‍👧‍👦" "👩" = [ "👨‍👩‍👧‍👦" ] + + +// module ToLowercase = +// Stdlib.String.toLowercase "HELLO😄WORLD" = "hello😄world" +// Stdlib.String.toLowercase "" = "" +// Stdlib.String.toLowercase "ABCDEF" = "abcdef" // Stdlib.String.toLowercase_v0 works for ASCII range +// Stdlib.String.toLowercase "AB323CDEF" = "ab323cdef" +// Stdlib.String.toLowercase "SÁNCHEZ" = "sánchez" // not lowercase a +// Stdlib.String.toLowercase "sánchez" = "sánchez" +// Stdlib.String.toLowercase "ŻÓŁW" = "żółw" // Stdlib.String.toLowercase works on non-ascii strings +// Stdlib.String.toLowercase "😄ORANGE" = "😄orange" +// Stdlib.String.toLowercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.toLowercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" +// Stdlib.String.toLowercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" +// Stdlib.String.toLowercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" +// Stdlib.String.toLowercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" +// Stdlib.String.toLowercase "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.toLowercase "Ჾ" = "ჾ" +// Stdlib.String.toLowercase "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" = "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + +// Stdlib.String.toLowercase +// "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "h̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈w̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠b̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅt͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝w͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" + + + +// module ToUppercase = +// Stdlib.String.toUppercase "" = "" +// Stdlib.String.toUppercase "hello😄world" = "HELLO😄WORLD" +// Stdlib.String.toUppercase "abcdef" = "ABCDEF" +// Stdlib.String.toUppercase "ab323cdef" = "AB323CDEF" +// Stdlib.String.toUppercase "sánchez" = "SÁNCHEZ" // not lowercase a +// Stdlib.String.toUppercase "SÁNChEZ" = "SÁNCHEZ" +// Stdlib.String.toUppercase "żółw" = "ŻÓŁW" +// Stdlib.String.toUppercase "😄orange" = "😄ORANGE" +// Stdlib.String.toUppercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.toUppercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" +// Stdlib.String.toUppercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" +// Stdlib.String.toUppercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" +// Stdlib.String.toUppercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" +// Stdlib.String.toUppercase "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.toUppercase "ჾ" = "Ჾ" + +// // TODO: There are two types of unicode case "mapping" (conversion), "simple" +// // and "full". .NET supports simple mapping, which maps a single character to a +// // single character. It does not support "full" mapping, which maps a single +// // character to multiple characters. + +// // Discussed at https://github.com/dotnet/runtime/issues/30960, specifially +// // https://github.com/dotnet/runtime/issues/30960#issuecomment-535274401 + +// // A possible solution is to write our own case mapper, or reuse an existing +// // one. A potential candidate is +// // https://github.com/dotnet/corefxlab/tree/archive/src/System.Text.CaseFolding +// // (packaged at +// // https://dnceng.visualstudio.com/public/_packaging?_a=package&feed=dotnet-experimental&view=overview&package=System.Text.CaseFolding&version=0.1.2-alpha.21059.1&protocolType=NuGet) + +// Stdlib.String.toUppercase "fifl" = "fifl" // should be "FIFL" +// Stdlib.String.toUppercase "և" = "և" // should be "ԵՒ" + +// Stdlib.String.toUppercase "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" + +// Stdlib.String.toUppercase +// "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "H̬̤̗̤͝E͜ ̜̥̝̻͍̟́W̕H̖̯͓O̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭A̺̪͍Į͈͕̭͙̯̜T̶̼̮S̘͙͖̕ ̠̫̠B̻͍͙͉̳ΙE̵H̵̬͇̫͙I̹͓̳̳̮͎̫̕N͟D̴̪̜̖ ̰͉̩͇͙̲͞ΙT͖̼͓̪͢H͏͓̮̻E̬̝̟Ι ̤̹̝W͙̞̝͔͇͝ΙA͏͓͔̹̼̣L̴͔̰̤̟͔Ḽ̫.͕" + + + +// module TrimEnd = +// Stdlib.String.trimEnd_v0 " " = "" +// Stdlib.String.trimEnd_v0 "" = "" +// Stdlib.String.trimEnd_v0 " foo " = " foo" +// Stdlib.String.trimEnd_v0 " foo bar " = " foo bar" +// Stdlib.String.trimEnd_v0 " foo" = " foo" +// Stdlib.String.trimEnd_v0 " 😄foobar😄 " = " 😄foobar😄" +// Stdlib.String.trimEnd_v0 "  foo bar  " = "  foo bar" +// Stdlib.String.trimEnd_v0 "foo " = "foo" +// Stdlib.String.trimEnd_v0 "foo" = "foo" + +// Stdlib.String.trimEnd_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" + +// Stdlib.String.trimEnd_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" + +// Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.trimEnd_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.trimEnd_v0 " ﷽﷽ " = " ﷽﷽" +// Stdlib.String.trimEnd_v0 " 🧟‍♀️🧟‍♂️ " = " 🧟‍♀️🧟‍♂️" + +// Stdlib.String.trimEnd_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + +// Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.trimEnd_v0 "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" = "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" + + +// module TrimStart = +// Stdlib.String.trimStart_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " + +// Stdlib.String.trimStart_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " + +// Stdlib.String.trimStart_v0 " " = "" +// Stdlib.String.trimStart_v0 "" = "" +// Stdlib.String.trimStart_v0 " foo " = "foo " +// Stdlib.String.trimStart_v0 " foo bar " = "foo bar " +// Stdlib.String.trimStart_v0 " foo" = "foo" +// Stdlib.String.trimStart_v0 " 😄foobar😄 " = "😄foobar😄 " +// Stdlib.String.trimStart_v0 "  foo bar  " = "foo bar  " +// Stdlib.String.trimStart_v0 "foo " = "foo " +// Stdlib.String.trimStart_v0 "foo" = "foo" +// Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " +// Stdlib.String.trimStart_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " +// Stdlib.String.trimStart_v0 " ﷽﷽ " = "﷽﷽ " +// Stdlib.String.trimStart_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️ " + +// Stdlib.String.trimStart_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " + +// Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " + + +// module Trim = +// Stdlib.String.trim_v0 " " = "" +// Stdlib.String.trim_v0 "" = "" +// Stdlib.String.trim_v0 " foo " = "foo" // String trims both leading + trailing spaces +// Stdlib.String.trim_v0 " foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched +// Stdlib.String.trim_v0 " foo" = "foo" // String trims leading spaces +// Stdlib.String.trim_v0 " 😄foobar😄 " = "😄foobar😄" // String trims both leading + trailing spaces, preserving emoji +// Stdlib.String.trim_v0 "  foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched w/ unicode spaces +// Stdlib.String.trim_v0 "foo " = "foo" // String trims trailing spaces +// Stdlib.String.trim_v0 "foo" = "foo" // String trim noops +// Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.trim_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.trim_v0 " ﷽﷽" = "﷽﷽" +// Stdlib.String.trim_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️" +// Stdlib.String.trim_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" +// Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + +// Stdlib.String.trim_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" + +// Stdlib.String.trim_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" +// Stdlib.String.trim_v0 "쉆ꥨ逴皪巌䖑ⱝዓ淋" = "쉆ꥨ逴皪巌䖑ⱝዓ淋" + + +// module Reverse = +// Stdlib.String.reverse_v0 "abcde" = "edcba" +// Stdlib.String.reverse_v0 "0abcde" = "edcba0" +// Stdlib.String.reverse_v0 "a" = "a" +// Stdlib.String.reverse_v0 "" = "" +// Stdlib.String.reverse_v0 "ábc" = "cbá" +// Stdlib.String.reverse_v0 "🎁🧸DŽʠ123" = "321ʠDŽ🧸🎁" +// Stdlib.String.reverse_v0 "😄foobar👽" = "👽raboof😄" +// Stdlib.String.reverse_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "✋🏿✋🏻✋🧑🏻‍🍼🧑🏽‍🦰włóż" +// Stdlib.String.reverse_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" +// Stdlib.String.reverse_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱🏿👱🏾👱🏽👱🏼👱🏻👱" +// Stdlib.String.reverse_v0 "🧟‍♀️🧟‍♂️" = "🧟‍♂️🧟‍♀️" +// Stdlib.String.reverse_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "🇵🇷🏳️‍⚧️‍️👩‍👩‍👧‍👦👨‍❤️‍💋‍👨" +// Stdlib.String.reverse_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "o̙̔ͮ̇͐̇ǧ̗͚̚lͮ̒ͫä͖̭̈̇Z̤͔ͧ̑̓" + + +// module DropFirst = +// Stdlib.String.dropFirst_v0 "abcd" -3L = "abcd" +// Stdlib.String.dropFirst_v0 "abcd" 0L = "abcd" +// Stdlib.String.dropFirst_v0 "abcd" 3L = "d" +// Stdlib.String.dropFirst_v0 "" 3L = "" +// Stdlib.String.dropFirst_v0 "abcd" 3L = "d" +// Stdlib.String.dropFirst_v0 "🍏🍒🍒" 1L = "🍒🍒" +// Stdlib.String.dropFirst_v0 "🍏🍒🍍" 2L = "🍍" +// Stdlib.String.dropFirst_v0 "🍏a🍒b🍍c" 2L = "🍒b🍍c" +// Stdlib.String.dropFirst_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 5L = "🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L = "ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "ǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.dropFirst_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" +// Stdlib.String.dropFirst_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 1L = "👱🏻👱🏼👱🏽👱🏾👱🏿" +// Stdlib.String.dropFirst_v0 "🧟‍♀️🧟‍♂️" 20L = "" +// Stdlib.String.dropFirst_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "🇵🇷" + + +// module DropLast = +// Stdlib.String.dropLast_v0 "abcd" -3L = "abcd" +// Stdlib.String.dropLast_v0 "abcd" 0L = "abcd" +// Stdlib.String.dropLast_v0 "abcd" 3L = "a" +// Stdlib.String.dropLast_v0 "" 3L = "" +// Stdlib.String.dropLast_v0 "🍏🍒🍒" 1L = "🍏🍒" +// Stdlib.String.dropLast_v0 "🍏🍒🍍" 2L = "🍏" +// Stdlib.String.dropLast_v0 "🍏a🍒b🍍c" 2L = "🍏a🍒b" +// Stdlib.String.dropLast_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" +// Stdlib.String.dropLast_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 10L = "﷽﷽﷽﷽﷽﷽" +// Stdlib.String.dropLast_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱👱🏻👱🏼" +// Stdlib.String.dropLast_v0 "🧟‍♀️🧟‍♂️" 20L = "" +// Stdlib.String.dropLast_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" +// Stdlib.String.dropLast_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "żółw🧑🏽‍🦰" + + +// module Last = +// Stdlib.String.last_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "🧑🏻‍🍼✋✋🏻✋🏿" +// Stdlib.String.last_v0 "abcd" -3L = "" +// Stdlib.String.last_v0 "abcd" 0L = "" +// Stdlib.String.last_v0 "" 7L = "" +// Stdlib.String.last_v0 "abcd" 1L = "d" +// Stdlib.String.last_v0 "abcd" 2L = "cd" +// Stdlib.String.last_v0 "abcd" 3L = "bcd" +// Stdlib.String.last_v0 "🍍🍍🍏" 1L = "🍏" +// Stdlib.String.last_v0 "🍊🍍🍏" 2L = "🍍🍏" +// Stdlib.String.last_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿🧑🏻‍🍼" 1L = "🧑🏻‍🍼" +// Stdlib.String.last_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "ǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.last_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L = "﷽﷽" +// Stdlib.String.last_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱🏽👱🏾👱🏿" +// Stdlib.String.last_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♂️" +// Stdlib.String.last_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 1L = "🇵🇷" + + +// module Contains = +// Stdlib.String.contains_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "2223" = false +// Stdlib.String.contains_v0 "👱👱🏻👱🏼👱🏽👱🏾" "👱🏿" = false +// Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = true +// Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️🧟‍♂️" = false + +// Stdlib.String.contains_v0 +// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" +// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" = true + +// Stdlib.String.contains_v0 "اختبار" "اختبار" = true +// Stdlib.String.contains_v0 "" "" = true +// Stdlib.String.contains_v0 "a" "" = true +// Stdlib.String.contains_v0 "" "a" = false + + +// module Slice = +// Stdlib.String.slice_v0 "abcd" -2L 4L = "cd" +// Stdlib.String.slice_v0 "abcd" -5L -6L = "" +// Stdlib.String.slice_v0 "abcd" -5L 1L = "a" +// Stdlib.String.slice_v0 "abcd" 0L -1L = "abc" +// Stdlib.String.slice_v0 "abcd" 2L 3L = "c" +// Stdlib.String.slice_v0 "abcd" 2L 6L = "cd" +// Stdlib.String.slice_v0 "abcd" 3L 2L = "" +// Stdlib.String.slice_v0 "abcd" 5L 6L = "" +// Stdlib.String.slice_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 2L 10L = "✋✋🏻✋🏿" +// Stdlib.String.slice_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L 3L = "ä͖̭̈̇lͮ̒ͫ" +// Stdlib.String.slice_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L 6L = "﷽﷽﷽﷽" +// Stdlib.String.slice_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L 6L = "👱🏼👱🏽👱🏾👱🏿" +// Stdlib.String.slice_v0 "🧟‍♀️🧟‍♂️" 2L 4L = "" +// Stdlib.String.slice_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L 10L = "🏳️‍⚧️‍️🇵🇷" +// Stdlib.String.slice_v0 "abc" 0L 4503599627370498L = "abc" + + +// module First = +// Stdlib.String.first_v0 "abcd" -3L = "" +// Stdlib.String.first_v0 "abcd" 0L = "" +// Stdlib.String.first_v0 "abcd" 1L = "a" +// Stdlib.String.first_v0 "abcd" 2L = "ab" +// Stdlib.String.first_v0 "abcd" 3L = "abc" +// Stdlib.String.first_v0 "abcd" 3000000000000000L = "abcd" +// Stdlib.String.first_v0 "" 7L = "" +// Stdlib.String.first_v0 "🍊🍍🍏" 1L = "🍊" +// Stdlib.String.first_v0 "🍊🍍🍏" 2L = "🍊🍍" +// Stdlib.String.first_v0 "🍊🍍🍏" 3L = "🍊🍍🍏" +// Stdlib.String.first_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 1L = "🧑🏽‍🦰" +// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 10L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" +// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇" +// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" +// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 4L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" +// Stdlib.String.first_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽" +// Stdlib.String.first_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L = "👱👱🏻" +// Stdlib.String.first_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♀️" +// Stdlib.String.first_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" + + +// module PadStart = +// Stdlib.String.padStart_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" + +// Stdlib.String.padStart_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" + +// Stdlib.String.padStart_v0 "123" "_-" 4L = Stdlib.Result.Result.Error +// "Expected `padWith` to be 1 character long, but it was `\"_-\"`" + +// Stdlib.String.padStart_v0 "123" "" 10L = Stdlib.Result.Result.Error +// "Expected `padWith` to be 1 character long, but it was `\"\"`" + +// Stdlib.String.padStart_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "000123" + +// Stdlib.String.padStart_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" + +// Stdlib.String.padStart_v0 "123🍊🍊" "0" 3L = Stdlib.Result.Result.Ok "123🍊🍊" + +// Stdlib.String.padStart_v0 "🍍🍍🍊🍊" "0" 7L = Stdlib.Result.Result.Ok "000🍍🍍🍊🍊" + +// Stdlib.String.padStart_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok +// "0żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + +// Stdlib.String.padStart_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok +// "00000Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + +// Stdlib.String.padStart_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok +// "0000﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + +// Stdlib.String.padStart_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok +// "0000👱👱🏻👱🏼👱🏽👱🏾👱🏿" + +// Stdlib.String.padStart_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok +// "000🧟‍♀️🧟‍♂️" + +// Stdlib.String.padStart_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok +// "000000👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" + +// Stdlib.String.padStart_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" + + +// module PadEnd = +// Stdlib.String.padEnd_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" + +// Stdlib.String.padEnd_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" + +// Stdlib.String.padEnd_v0 "123" "_-" 3L = Stdlib.Result.Result.Error +// "Expected `padWith` to be 1 character long, but it was `\"_-\"`" + +// Stdlib.String.padEnd_v0 "123" "" 10L = Stdlib.Result.Result.Error +// "Expected `padWith` to be 1 character long, but it was `\"\"`" + +// Stdlib.String.padEnd_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "123000" + +// Stdlib.String.padEnd_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" + +// Stdlib.String.padEnd_v0 "123🍊🍊" "0" 8L = Stdlib.Result.Result.Ok "123🍊🍊000" + +// Stdlib.String.padEnd_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok +// "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿0" + +// Stdlib.String.padEnd_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok +// "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇00000" + +// Stdlib.String.padEnd_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok +// "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽0000" + +// Stdlib.String.padEnd_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok +// "👱👱🏻👱🏼👱🏽👱🏾👱🏿0000" + +// Stdlib.String.padEnd_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok +// "🧟‍♀️🧟‍♂️000" + +// Stdlib.String.padEnd_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok +// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷000000" + +// Stdlib.String.padEnd_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" + + +// module IndexOf = +// Stdlib.String.indexOf_v0 "hello world" "world" = Stdlib.Option.Option.Some 6L + +// Stdlib.String.indexOf_v0 "hello world" "earth" = Stdlib.Option.Option.None + +// Stdlib.String.indexOf_v0 "" "" = Stdlib.Option.Option.Some 0L + +// Stdlib.String.indexOf_v0 "hello" "" = Stdlib.Option.Option.Some 0L + +// Stdlib.String.indexOf_v0 "" "hello" = Stdlib.Option.Option.None + +// Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = Stdlib.Option.Option.Some +// 6L + +// Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏿" = Stdlib.Option.Option.None + +// Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = Stdlib.Option.Option.Some +// 11L + +// Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = Stdlib.Option.Option.Some +// 4L + +// Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "👱🏽" = Stdlib.Option.Option.None + +// Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🧑🏻‍🍼" = Stdlib.Option.Option.None + + +// module Ellipsis = +// Stdlib.String.ellipsis_v0 "hello world" 5L = "hello..." +// Stdlib.String.ellipsis_v0 "hello world" 9L = "hello wor..." +// Stdlib.String.ellipsis_v0 "hello world" 11L = "hello world" +// Stdlib.String.ellipsis_v0 "hello world" 12L = "hello world" +// Stdlib.String.ellipsis_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 5L = "👱👱🏻👱🏼👱🏽👱🏾..." +// Stdlib.String.ellipsis_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ..." +// Stdlib.String.ellipsis_v0 "👩‍👩‍👧‍👦" 2L = "👩‍👩‍👧‍👦" + +// Stdlib.String.ellipsis_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷✋✋🏻✋🏿" 4L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷..." + +// module Head = +// Stdlib.String.head "hello world" = Stdlib.Option.Option.Some 'h' + +// Stdlib.String.head "" = Stdlib.Option.Option.None +// // Commented out as Fantomas doesn't like unicode "characters" +// // Stdlib.String.head "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = Stdlib.Option.Option.Some '👱' +// // Stdlib.String.head "🧟‍♀️🧟‍♂️" = Stdlib.Option.Option.Some '🧟' +// // Stdlib.String.head "👨‍❤️‍💋‍👨" = Stdlib.Option.Option.Some '👨‍❤️‍💋‍👨' + +// module ArticleFor = +// Stdlib.String.articleFor "apple" = "an" +// Stdlib.String.articleFor "banana" = "a" +// Stdlib.String.articleFor "🍍" = "a" +// Stdlib.String.articleFor "🍊" = "a" +// Stdlib.String.articleFor "" = "" \ No newline at end of file From e0808a35c51220bc33df89f6e2cddff94468bc88 Mon Sep 17 00:00:00 2001 From: Ocean Date: Mon, 23 Sep 2024 08:11:53 +0000 Subject: [PATCH 56/60] 1400/9000 tests passing --- .../stdlib/{_crypto.dark => crypto.dark} | 0 .../stdlib/{_http.dark => http.dark} | 0 .../stdlib/ints/{_int128.dark => int128.dark} | 124 +++++++++--------- .../ints/{_uint128.dark => uint128.dark} | 90 ++++++------- 4 files changed, 107 insertions(+), 107 deletions(-) rename backend/testfiles/execution/stdlib/{_crypto.dark => crypto.dark} (100%) rename backend/testfiles/execution/stdlib/{_http.dark => http.dark} (100%) rename backend/testfiles/execution/stdlib/ints/{_int128.dark => int128.dark} (58%) rename backend/testfiles/execution/stdlib/ints/{_uint128.dark => uint128.dark} (53%) diff --git a/backend/testfiles/execution/stdlib/_crypto.dark b/backend/testfiles/execution/stdlib/crypto.dark similarity index 100% rename from backend/testfiles/execution/stdlib/_crypto.dark rename to backend/testfiles/execution/stdlib/crypto.dark diff --git a/backend/testfiles/execution/stdlib/_http.dark b/backend/testfiles/execution/stdlib/http.dark similarity index 100% rename from backend/testfiles/execution/stdlib/_http.dark rename to backend/testfiles/execution/stdlib/http.dark diff --git a/backend/testfiles/execution/stdlib/ints/_int128.dark b/backend/testfiles/execution/stdlib/ints/int128.dark similarity index 58% rename from backend/testfiles/execution/stdlib/ints/_int128.dark rename to backend/testfiles/execution/stdlib/ints/int128.dark index 2523f92d01..2b73910d1a 100644 --- a/backend/testfiles/execution/stdlib/ints/_int128.dark +++ b/backend/testfiles/execution/stdlib/ints/int128.dark @@ -1,8 +1,8 @@ Stdlib.Int128.absoluteValue_v0 -5Q = 5Q Stdlib.Int128.absoluteValue_v0 5Q = 5Q -Stdlib.Int128.absoluteValue_v0 -170141183460469231731687303715884105728Q = Builtin.testDerrorMessage - "Out of range" +// Stdlib.Int128.absoluteValue_v0 -170141183460469231731687303715884105728Q = Builtin.testDerrorMessage +// "Out of range" Stdlib.Int128.max_v0 5Q 6Q = 6Q Stdlib.Int128.max_v0 10Q 1Q = 10Q @@ -39,20 +39,20 @@ Stdlib.Int128.negate_v0 5Q = -5Q Stdlib.Int128.negate_v0 0Q = 0Q Stdlib.Int128.negate_v0 -0Q = 0Q -Stdlib.Int128.negate_v0 -170141183460469231731687303715884105728Q = Builtin.testDerrorMessage - "Out of range" +// Stdlib.Int128.negate_v0 -170141183460469231731687303715884105728Q = Builtin.testDerrorMessage +// "Out of range" -Stdlib.Int128.remainder_v0 15Q 6Q = Stdlib.Result.Result.Ok 3Q +// Stdlib.Int128.remainder_v0 15Q 6Q = Stdlib.Result.Result.Ok 3Q -Stdlib.Int128.remainder_v0 20Q 8Q = Stdlib.Result.Result.Ok 4Q +// Stdlib.Int128.remainder_v0 20Q 8Q = Stdlib.Result.Result.Ok 4Q -Stdlib.Int128.remainder_v0 -20Q 8Q = Stdlib.Result.Result.Ok -4Q +// Stdlib.Int128.remainder_v0 -20Q 8Q = Stdlib.Result.Result.Ok -4Q -Stdlib.Int128.remainder_v0 -20Q -8Q = Stdlib.Result.Result.Ok -4Q +// Stdlib.Int128.remainder_v0 -20Q -8Q = Stdlib.Result.Result.Ok -4Q -Stdlib.Int128.remainder_v0 -15Q 6Q = Stdlib.Result.Result.Ok -3Q +// Stdlib.Int128.remainder_v0 -15Q 6Q = Stdlib.Result.Result.Ok -3Q -Stdlib.Int128.remainder_v0 5Q 0Q = Builtin.testDerrorMessage "Division by zero" +// Stdlib.Int128.remainder_v0 5Q 0Q = Builtin.testDerrorMessage "Division by zero" Stdlib.Int128.add_v0 10Q 9Q = 19Q Stdlib.Int128.add_v0 88Q 9Q = 97Q @@ -62,8 +62,8 @@ Stdlib.Int128.add_v0 -55Q 55Q = 0Q Stdlib.Int128.add_v0 55Q 55Q = 110Q Stdlib.Int128.add_v0 9223372036854775807Q 2Q = 9223372036854775809Q -Stdlib.Int128.add_v0 170141183460469231731687303715884105726Q 4Q = Builtin.testDerrorMessage - "Out of range" +// Stdlib.Int128.add_v0 170141183460469231731687303715884105726Q 4Q = Builtin.testDerrorMessage +// "Out of range" @@ -73,8 +73,8 @@ Stdlib.Int128.subtract_v0 0Q 1Q = -1Q Stdlib.Int128.subtract_v0 1Q 0Q = 1Q Stdlib.Int128.subtract_v0 -55Q -55Q = 0Q -Stdlib.Int128.subtract_v0 -55Q 170141183460469231731687303715884105726Q = Builtin.testDerrorMessage - "Out of range" +// Stdlib.Int128.subtract_v0 -55Q 170141183460469231731687303715884105726Q = Builtin.testDerrorMessage +// "Out of range" Stdlib.Int128.multiply_v0 8Q 8Q = 64Q Stdlib.Int128.multiply_v0 1Q 0Q = 0Q @@ -84,10 +84,10 @@ Stdlib.Int128.divide_v0 17Q 3Q = 5Q Stdlib.Int128.divide_v0 -8Q 5Q = -1Q Stdlib.Int128.divide_v0 0Q 1Q = 0Q -Stdlib.Int128.divide_v0 1Q 0Q = Builtin.testDerrorMessage "Division by zero" +// Stdlib.Int128.divide_v0 1Q 0Q = Builtin.testDerrorMessage "Division by zero" -Stdlib.Int128.divide_v0 -170141183460469231731687303715884105728Q -1Q = Builtin.testDerrorMessage - "Out of range" +// Stdlib.Int128.divide_v0 -170141183460469231731687303715884105728Q -1Q = Builtin.testDerrorMessage +// "Out of range" Stdlib.Int128.greaterThan_v0 20Q 1Q = true @@ -144,78 +144,78 @@ Stdlib.Int128.mod_v0 -1Q 2Q = 1Q Stdlib.Int128.mod_v0 -128Q 53Q = 31Q Stdlib.Int128.mod_v0 127Q 3Q = 1Q -Stdlib.Int128.mod_v0 5Q 0Q = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.Int128.mod_v0 5Q 0Q = Builtin.testDerrorMessage "Zero modulus" -Stdlib.Int128.mod_v0 5Q -5Q = Builtin.testDerrorMessage "Negative modulus" +// Stdlib.Int128.mod_v0 5Q -5Q = Builtin.testDerrorMessage "Negative modulus" -Stdlib.Int128.parse_v0 "0" = Stdlib.Result.Result.Ok 0Q +// Stdlib.Int128.parse_v0 "0" = Stdlib.Result.Result.Ok 0Q -Stdlib.Int128.parse_v0 "1" = Stdlib.Result.Result.Ok 1Q +// Stdlib.Int128.parse_v0 "1" = Stdlib.Result.Result.Ok 1Q -Stdlib.Int128.parse_v0 " 1" = Stdlib.Result.Result.Ok 1Q +// Stdlib.Int128.parse_v0 " 1" = Stdlib.Result.Result.Ok 1Q -Stdlib.Int128.parse_v0 "1 " = Stdlib.Result.Result.Ok 1Q +// Stdlib.Int128.parse_v0 "1 " = Stdlib.Result.Result.Ok 1Q -Stdlib.Int128.parse_v0 "+1" = Stdlib.Result.Result.Ok 1Q +// Stdlib.Int128.parse_v0 "+1" = Stdlib.Result.Result.Ok 1Q -Stdlib.Int128.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1Q +// Stdlib.Int128.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1Q -Stdlib.Int128.parse_v0 "-1" = Stdlib.Result.Result.Ok -1Q +// Stdlib.Int128.parse_v0 "-1" = Stdlib.Result.Result.Ok -1Q -Stdlib.Int128.parse_v0 "078" = Stdlib.Result.Result.Ok 78Q // "octal" format ignored +// Stdlib.Int128.parse_v0 "078" = Stdlib.Result.Result.Ok 78Q // "octal" format ignored -Stdlib.Int128.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1Q +// Stdlib.Int128.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1Q -Stdlib.Int128.parse_v0 "170141183460469231731687303715884105727" = Stdlib.Result.Result.Ok - 170141183460469231731687303715884105727Q +// Stdlib.Int128.parse_v0 "170141183460469231731687303715884105727" = Stdlib.Result.Result.Ok +// 170141183460469231731687303715884105727Q -Stdlib.Int128.parse_v0 "-170141183460469231731687303715884105728" = Stdlib.Result.Result.Ok - -170141183460469231731687303715884105728Q +// Stdlib.Int128.parse_v0 "-170141183460469231731687303715884105728" = Stdlib.Result.Result.Ok +// -170141183460469231731687303715884105728Q -Stdlib.Int128.parse_v0 "170141183460469231731687303715884105729" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.OutOfRange +// Stdlib.Int128.parse_v0 "170141183460469231731687303715884105729" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.OutOfRange -Stdlib.Int128.parse_v0 "-170141183460469231731687303715884105729" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.OutOfRange +// Stdlib.Int128.parse_v0 "-170141183460469231731687303715884105729" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.OutOfRange -Stdlib.Int128.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "1Q" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "1Q" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat -Stdlib.Int128.parse_v0 "XQV" = Stdlib.Result.Result.Error - Stdlib.Int128.ParseError.BadFormat +// Stdlib.Int128.parse_v0 "XQV" = Stdlib.Result.Result.Error +// Stdlib.Int128.ParseError.BadFormat Stdlib.Int128.fromInt8_v0 0y = 0Q diff --git a/backend/testfiles/execution/stdlib/ints/_uint128.dark b/backend/testfiles/execution/stdlib/ints/uint128.dark similarity index 53% rename from backend/testfiles/execution/stdlib/ints/_uint128.dark rename to backend/testfiles/execution/stdlib/ints/uint128.dark index 80dfde6acc..0b01f59308 100644 --- a/backend/testfiles/execution/stdlib/ints/_uint128.dark +++ b/backend/testfiles/execution/stdlib/ints/uint128.dark @@ -19,8 +19,8 @@ Stdlib.UInt128.add_v0 9223372036854775807Z 2Z = 9223372036854775809Z Stdlib.UInt128.add_v0 170141183460469231731687303715884105726Z 4Z = 170141183460469231731687303715884105730Z -Stdlib.UInt128.add_v0 340282366920938463463374607431768211455Z 1Z = Builtin.testDerrorMessage - "Out of range" +// Stdlib.UInt128.add_v0 340282366920938463463374607431768211455Z 1Z = Builtin.testDerrorMessage +// "Out of range" Stdlib.UInt128.subtract_v0 10Z 9Z = 1Z Stdlib.UInt128.subtract_v0 88Z 9Z = 79Z @@ -29,14 +29,14 @@ Stdlib.UInt128.subtract_v0 1Z 0Z = 1Z Stdlib.UInt128.multiply_v0 8Z 8Z = 64Z Stdlib.UInt128.multiply_v0 1Z 0Z = 0Z -Stdlib.UInt128.multiply_v0 340282366920938463463374607431768211455Z 2Z = Builtin.testDerrorMessage - "Out of range" +// Stdlib.UInt128.multiply_v0 340282366920938463463374607431768211455Z 2Z = Builtin.testDerrorMessage +// "Out of range" Stdlib.UInt128.divide_v0 10Z 5Z = 2Z Stdlib.UInt128.divide_v0 17Z 3Z = 5Z Stdlib.UInt128.divide_v0 0Z 1Z = 0Z -Stdlib.UInt128.divide_v0 1Z 0Z = Builtin.testDerrorMessage "Division by zero" +// Stdlib.UInt128.divide_v0 1Z 0Z = Builtin.testDerrorMessage "Division by zero" Stdlib.UInt128.greaterThan_v0 20Z 1Z = true @@ -73,68 +73,68 @@ Stdlib.UInt128.mod_v0 15Z 6Z = 3Z Stdlib.UInt128.mod_v0 0Z 15Z = 0Z Stdlib.UInt128.mod_v0 127Z 3Z = 1Z -Stdlib.UInt128.mod_v0 5Z 0Z = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.UInt128.mod_v0 5Z 0Z = Builtin.testDerrorMessage "Zero modulus" -Stdlib.UInt128.parse_v0 "0" = Stdlib.Result.Result.Ok(0Z) +// Stdlib.UInt128.parse_v0 "0" = Stdlib.Result.Result.Ok(0Z) -Stdlib.UInt128.parse_v0 "1" = Stdlib.Result.Result.Ok(1Z) +// Stdlib.UInt128.parse_v0 "1" = Stdlib.Result.Result.Ok(1Z) -Stdlib.UInt128.parse_v0 " 1" = Stdlib.Result.Result.Ok(1Z) +// Stdlib.UInt128.parse_v0 " 1" = Stdlib.Result.Result.Ok(1Z) -Stdlib.UInt128.parse_v0 "1 " = Stdlib.Result.Result.Ok(1Z) +// Stdlib.UInt128.parse_v0 "1 " = Stdlib.Result.Result.Ok(1Z) -Stdlib.UInt128.parse_v0 "+1" = Stdlib.Result.Result.Ok(1Z) +// Stdlib.UInt128.parse_v0 "+1" = Stdlib.Result.Result.Ok(1Z) -Stdlib.UInt128.parse_v0 " +1 " = Stdlib.Result.Result.Ok(1Z) +// Stdlib.UInt128.parse_v0 " +1 " = Stdlib.Result.Result.Ok(1Z) -Stdlib.UInt128.parse_v0 "078" = Stdlib.Result.Result.Ok(78Z) // "octal" format ignored +// Stdlib.UInt128.parse_v0 "078" = Stdlib.Result.Result.Ok(78Z) // "octal" format ignored -Stdlib.UInt128.parse_v0 "170141183460469231731687303715884105727" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(170141183460469231731687303715884105727Z) +// Stdlib.UInt128.parse_v0 "170141183460469231731687303715884105727" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(170141183460469231731687303715884105727Z) -Stdlib.UInt128.parse_v0 "170141183460469231731687303715884105729" = Stdlib.Result.Result.Ok - 170141183460469231731687303715884105729Z +// Stdlib.UInt128.parse_v0 "170141183460469231731687303715884105729" = Stdlib.Result.Result.Ok +// 170141183460469231731687303715884105729Z -Stdlib.UInt128.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat -Stdlib.UInt128.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.UInt128.ParseError.BadFormat +// Stdlib.UInt128.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.UInt128.ParseError.BadFormat Stdlib.UInt128.fromUInt8_v0 0uy = 0Z From 86fef9467bc49d5e478a96879f1906285024e653 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Mon, 23 Sep 2024 10:40:30 -0400 Subject: [PATCH 57/60] 1800 tests passing --- .../testfiles/execution/stdlib/_tuple.dark | 77 ---- .../execution/stdlib/ints/_int16.dark | 329 ------------- .../execution/stdlib/ints/_int32.dark | 331 ------------- .../execution/stdlib/ints/_int64.dark | 436 ------------------ .../execution/stdlib/ints/_int8.dark | 370 --------------- .../execution/stdlib/ints/int16.dark | 242 ++++++++++ .../execution/stdlib/ints/int32.dark | 262 +++++++++++ .../execution/stdlib/ints/int64.dark | 369 +++++++++++++++ .../testfiles/execution/stdlib/ints/int8.dark | 307 ++++++++++++ backend/testfiles/execution/stdlib/tuple.dark | 77 ++++ 10 files changed, 1257 insertions(+), 1543 deletions(-) delete mode 100644 backend/testfiles/execution/stdlib/_tuple.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_int16.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_int32.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_int64.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_int8.dark create mode 100644 backend/testfiles/execution/stdlib/ints/int16.dark create mode 100644 backend/testfiles/execution/stdlib/ints/int32.dark create mode 100644 backend/testfiles/execution/stdlib/ints/int64.dark create mode 100644 backend/testfiles/execution/stdlib/ints/int8.dark create mode 100644 backend/testfiles/execution/stdlib/tuple.dark diff --git a/backend/testfiles/execution/stdlib/_tuple.dark b/backend/testfiles/execution/stdlib/_tuple.dark deleted file mode 100644 index 73d7228279..0000000000 --- a/backend/testfiles/execution/stdlib/_tuple.dark +++ /dev/null @@ -1,77 +0,0 @@ -// Tuple2 -Stdlib.Tuple2.create "one" 2L = ("one", 2L) -Stdlib.Tuple2.create 1L "two" = (1L, "two") - -Stdlib.Tuple2.first ("one", 2L) = "one" -Stdlib.Tuple2.first (1L, "two") = 1L -Stdlib.Tuple2.second ("one", 2L) = 2L -Stdlib.Tuple2.second (1L, "two") = "two" - -Stdlib.Tuple2.swap ("one", 2L) = (2L, "one") -Stdlib.Tuple2.swap (1L, "two") = ("two", 1L) - -Stdlib.Tuple2.swap (Stdlib.Tuple2.swap ("two swaps", "back to original")) = ("two swaps", - "back to original") - -Stdlib.Tuple2.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L) = ("ONE", - 2L) - -Stdlib.Tuple2.mapFirst (fun x -> x - 2L) (1L, "two") = (-1L, "two") -Stdlib.Tuple2.mapSecond (fun x -> x - 2L) ("one", 2L) = ("one", 0L) - -Stdlib.Tuple2.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two") = (1L, - "TWO") - -Stdlib.Tuple2.mapBoth - (fun x -> Stdlib.String.toUppercase x) - (fun x -> x - 2L) - ("one", 2L) = ("ONE", 0L) - -Stdlib.Tuple2.mapBoth - (fun x -> x - 2L) - (fun x -> Stdlib.String.toUppercase x) - (1L, "two") = (-1L, "TWO") - - -// Tuple3 -Stdlib.Tuple3.create "one" 2L "pi" = ("one", 2L, "pi") -Stdlib.Tuple3.create 1L "two" 3.14 = (1L, "two", 3.14) - -Stdlib.Tuple3.first (1L, "two", 3.14) = 1L -Stdlib.Tuple3.first ("one", 2L, "pi") = "one" -Stdlib.Tuple3.second (1L, "two", 3.14) = "two" -Stdlib.Tuple3.second ("one", 2L, "pi") = 2L -Stdlib.Tuple3.third (1L, "two", 3.14) = 3.14 -Stdlib.Tuple3.third ("one", 2L, "pi") = "pi" - -Stdlib.Tuple3.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("ONE", - 2L, - "pi") - -Stdlib.Tuple3.mapFirst (fun x -> x - 2L) (1L, "two", 3.14) = (-1L, "two", 3.14) - -Stdlib.Tuple3.mapSecond (fun x -> x - 2L) ("one", 2L, "pi") = ("one", 0L, "pi") - -Stdlib.Tuple3.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two", 3.14) = (1L, - "TWO", - 3.14) - -Stdlib.Tuple3.mapThird (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("one", - 2L, - "PI") - -Stdlib.Tuple3.mapThird (fun x -> Stdlib.Float.roundDown_v0 x) (1L, "two", 3.14) = (1L, - "two", - 3L) - -Stdlib.Tuple3.mapAllThree - (fun x -> Stdlib.String.toUppercase x) - (fun x -> x - 2L) - (fun x -> Stdlib.String.toUppercase x) - ("one", 2L, "pi") = ("ONE", 0L, "PI") - -Stdlib.Tuple3.mapAllThree - (fun x -> x - 2L) - (fun x -> Stdlib.String.toUppercase x) - (fun x -> Stdlib.Float.roundDown_v0 x) - (1L, "two", 3.14) = (-1L, "TWO", 3L) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_int16.dark b/backend/testfiles/execution/stdlib/ints/_int16.dark deleted file mode 100644 index 22647f7669..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_int16.dark +++ /dev/null @@ -1,329 +0,0 @@ -Stdlib.Int16.absoluteValue_v0 -5s = 5s -Stdlib.Int16.absoluteValue_v0 5s = 5s - -Stdlib.Int16.absoluteValue_v0 -32768s = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int16.clamp_v0 -5s -2s 5s = -2s -Stdlib.Int16.clamp_v0 -3s -2s 1s = -2s -Stdlib.Int16.clamp_v0 -5s 1s 1s = 1s -Stdlib.Int16.clamp_v0 1s 2s 1s = 1s -Stdlib.Int16.clamp_v0 3s 0s 2s = 2s - - -Stdlib.Int16.max_v0 5s 6s = 6s -Stdlib.Int16.max_v0 10s 1s = 10s -Stdlib.Int16.max_v0 -5s 6s = 6s -Stdlib.Int16.max_v0 32767s -32768s = 32767s - - -Stdlib.Int16.min_v0 5s 6s = 5s -Stdlib.Int16.min_v0 50s -10s = -10s -Stdlib.Int16.min_v0 -5s 6s = -5s -Stdlib.Int16.min_v0 32767s -32768s = -32768s - - -Stdlib.Int16.clamp_v0 -100s 0s 0s = 0s -Stdlib.Int16.clamp_v0 100s 0s 0s = 0s -Stdlib.Int16.clamp_v0 -100s 0s -1s = -1s -Stdlib.Int16.clamp_v0 100s 0s -1s = 0s -Stdlib.Int16.clamp_v0 -100s -1s 0s = -1s -Stdlib.Int16.clamp_v0 -100s 1s 0s = 0s -Stdlib.Int16.clamp_v0 100s 1s 0s = 1s - - -Stdlib.Int16.add_v0 10s 9s = 19s -Stdlib.Int16.add_v0 88s 9s = 97s -Stdlib.Int16.add_v0 -1s 2s = 1s -Stdlib.Int16.add_v0 1s 0s = 1s -Stdlib.Int16.add_v0 -55s 55s = 0s -Stdlib.Int16.add_v0 30000s 2767s = 32767s -Stdlib.Int16.add_v0 -30000s -2768s = -32768s - -Stdlib.Int16.add_v0 -30000s -2769s = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int16.add_v0 30000s 2768s = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int16.subtract_v0 10s 9s = 1s -Stdlib.Int16.subtract_v0 88s 9s = 79s -Stdlib.Int16.subtract_v0 0s 1s = -1s -Stdlib.Int16.subtract_v0 1s 0s = 1s -Stdlib.Int16.subtract_v0 -55s -55s = 0s - -Stdlib.Int16.subtract_v0 -2769s 30000s = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int16.multiply_v0 8s 8s = 64s -Stdlib.Int16.multiply_v0 1s 0s = 0s - -Stdlib.Int16.multiply_v0 5145s 5145s = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int16.power_v0 2s 3s = 8s -Stdlib.Int16.power_v0 0s 1s = 0s -Stdlib.Int16.power_v0 1s 0s = 1s -Stdlib.Int16.power_v0 0s 0s = 1s -Stdlib.Int16.power_v0 -2s 5s = -32s -Stdlib.Int16.power_v0 -1s 5s = -1s -Stdlib.Int16.power_v0 -1s 6s = 1s -Stdlib.Int16.power_v0 1s 32767s = 1s - -Stdlib.Int16.power_v0 2s 15s = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int16.power_v0 120s 20s = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int16.power_v0 2s -3s = Builtin.testDerrorMessage "Negative exponent" - - -Stdlib.Int16.divide_v0 10s 5s = 2s -Stdlib.Int16.divide_v0 17s 3s = 5s -Stdlib.Int16.divide_v0 -8s 5s = -1s -Stdlib.Int16.divide_v0 0s 1s = 0s - -Stdlib.Int16.divide_v0 1s 0s = Builtin.testDerrorMessage "Division by zero" - -Stdlib.Int16.divide_v0 -32768s -1s = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int16.divide_v0 -32768s 1s = -32768s - - -Stdlib.Int16.negate_v0 -5s = 5s -Stdlib.Int16.negate_v0 5s = -5s -Stdlib.Int16.negate_v0 0s = 0s -Stdlib.Int16.negate_v0 -0s = 0s - -Stdlib.Int16.negate_v0 -32768s = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int16.greaterThan_v0 20s 1s = true -Stdlib.Int16.greaterThan_v0 20s 130s = false - - -Stdlib.Int16.greaterThanOrEqualTo_v0 0s 1s = false -Stdlib.Int16.greaterThanOrEqualTo_v0 1s 0s = true -Stdlib.Int16.greaterThanOrEqualTo_v0 6s 1s = true -Stdlib.Int16.greaterThanOrEqualTo_v0 6s 8s = false -Stdlib.Int16.greaterThanOrEqualTo_v0 -5s -20s = true -Stdlib.Int16.greaterThanOrEqualTo_v0 -20s -1s = false -Stdlib.Int16.greaterThanOrEqualTo_v0 -20s -20s = true -Stdlib.Int16.greaterThanOrEqualTo_v0 -130s -20s = false -Stdlib.Int16.lessThanOrEqualTo_v0 6s 8s = true -Stdlib.Int16.lessThanOrEqualTo_v0 10s 1s = false - - -Stdlib.Int16.lessThan_v0 6s 8s = true -Stdlib.Int16.lessThan_v0 10s 1s = false -Stdlib.Int16.lessThan_v0 0s 1s = true -Stdlib.Int16.lessThan_v0 1s 0s = false -Stdlib.Int16.lessThan_v0 -100s 22544s = true -Stdlib.Int16.lessThan_v0 -999s -9999s = false -Stdlib.Int16.lessThan_v0 -8888s -8888s = false - -Stdlib.Int16.lessThanOrEqualTo_v0 0s 1s = true -Stdlib.Int16.lessThanOrEqualTo_v0 1s 0s = false -Stdlib.Int16.lessThanOrEqualTo_v0 -100s 22544s = true -Stdlib.Int16.lessThanOrEqualTo_v0 -999s -9999s = false -Stdlib.Int16.lessThanOrEqualTo_v0 -8888s -8888s = true - - -Stdlib.Int16.toString 0s = "0" -Stdlib.Int16.toString 1s = "1" -Stdlib.Int16.toString -1s = "-1" -Stdlib.Int16.toString -32768s = "-32768" // Int16 lower limit -Stdlib.Int16.toString 32767s = "32767" // Int16 upper limit - - -Stdlib.Int16.toFloat_v0 2s = 2.0 -Stdlib.Int16.toFloat_v0 -10s = -10.0 - - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 1s 2s) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int16.greaterThanOrEqualTo x 1s) - && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 10s 20s) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int16.greaterThanOrEqualTo x 10s) - && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 2s 1s) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int16.greaterThanOrEqualTo x 1s) - && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 20s 10s) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int16.greaterThanOrEqualTo x 10s) - && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 1s) - |> Stdlib.List.unique_v0) = [ 0s; 1s ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 2s) - |> Stdlib.List.unique_v0) = [ 0s; 1s; 2s ] - - -Stdlib.Int16.parse_v0 "0" = Stdlib.Result.Result.Ok 0s - -Stdlib.Int16.parse_v0 "1" = Stdlib.Result.Result.Ok 1s - -Stdlib.Int16.parse_v0 " 1" = Stdlib.Result.Result.Ok 1s - -Stdlib.Int16.parse_v0 "1 " = Stdlib.Result.Result.Ok 1s - -Stdlib.Int16.parse_v0 "+1" = Stdlib.Result.Result.Ok 1s - -Stdlib.Int16.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1s - -Stdlib.Int16.parse_v0 "-1" = Stdlib.Result.Result.Ok -1s - -Stdlib.Int16.parse_v0 "078" = Stdlib.Result.Result.Ok 78s // "octal" format ignored - -Stdlib.Int16.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1s - -Stdlib.Int16.parse_v0 "32767" = Stdlib.Result.Result.Ok 32767s - -Stdlib.Int16.parse_v0 "-32768" = Stdlib.Result.Result.Ok -32768s - -Stdlib.Int16.parse_v0 "32768" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.OutOfRange - -Stdlib.Int16.parse_v0 "-32769" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.OutOfRange - -Stdlib.Int16.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - -Stdlib.Int16.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.Int16.ParseError.BadFormat - - -Stdlib.Int16.fromInt8_v0 0y = 0s - -Stdlib.Int16.fromInt8_v0 1y = 1s - -Stdlib.Int16.fromInt8_v0 127y = 127s - -Stdlib.Int16.fromInt8_v0 (-1y) = -1s - -Stdlib.Int16.fromInt8_v0 (-128y) = -128s - -Stdlib.Int16.fromUInt8_v0 0uy = 0s - -Stdlib.Int16.fromUInt8_v0 1uy = 1s - -Stdlib.Int16.fromUInt8_v0 255uy = 255s - -Stdlib.Int16.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromUInt16_v0 32767us = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromInt32_v0 0l = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromInt32_v0 1l = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromInt32_v0 32767l = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromInt32_v0 32768l = Stdlib.Option.Option.None - -Stdlib.Int16.fromInt32_v0 (-1l) = Stdlib.Option.Option.Some -1s - -Stdlib.Int16.fromInt32_v0 (-32768l) = Stdlib.Option.Option.Some -32768s - -Stdlib.Int16.fromInt32_v0 (-32769l) = Stdlib.Option.Option.None - -Stdlib.Int16.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromUInt32_v0 32767ul = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromUInt32_v0 32768ul = Stdlib.Option.Option.None -Stdlib.Int16.fromUInt32_v0 65535ul = Stdlib.Option.Option.None - -Stdlib.Int16.fromInt64_v0 0L = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromInt64_v0 1L = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromInt64_v0 32767L = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromInt64_v0 32768L = Stdlib.Option.Option.None - -Stdlib.Int16.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1s - -Stdlib.Int16.fromInt64_v0 (-32768L) = Stdlib.Option.Option.Some -32768s - -Stdlib.Int16.fromInt64_v0 (-32769L) = Stdlib.Option.Option.None - -Stdlib.Int16.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromUInt64_v0 32767UL = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromUInt64_v0 32768UL = Stdlib.Option.Option.None - -Stdlib.Int16.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromInt128_v0 32767Q = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromInt128_v0 32768Q = Stdlib.Option.Option.None - -Stdlib.Int16.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1s - -Stdlib.Int16.fromInt128_v0 (-32768Q) = Stdlib.Option.Option.Some -32768s - -Stdlib.Int16.fromInt128_v0 (-32769Q) = Stdlib.Option.Option.None - -Stdlib.Int16.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0s - -Stdlib.Int16.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1s - -Stdlib.Int16.fromUInt128_v0 32767Z = Stdlib.Option.Option.Some 32767s - -Stdlib.Int16.fromUInt128_v0 32768Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_int32.dark b/backend/testfiles/execution/stdlib/ints/_int32.dark deleted file mode 100644 index b9b53eca29..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_int32.dark +++ /dev/null @@ -1,331 +0,0 @@ -Stdlib.Int32.absoluteValue_v0 -5l = 5l -Stdlib.Int32.absoluteValue_v0 5l = 5l - -Stdlib.Int32.max_v0 5l 6l = 6l -Stdlib.Int32.max_v0 10l 1l = 10l -Stdlib.Int32.max_v0 -5l 6l = 6l -Stdlib.Int32.max_v0 -100l -20000l = -100l -Stdlib.Int32.max_v0 250l -26l = 250l - -Stdlib.Int32.min_v0 5l 6l = 5l -Stdlib.Int32.min_v0 50l -10l = -10l -Stdlib.Int32.min_v0 -5l 6l = -5l -Stdlib.Int32.min_v0 -100l -20000l = -20000l -Stdlib.Int32.min_v0 250l -26l = -26l - - -Stdlib.Int32.clamp_v0 -5l -2l 5l = -2l // in bounds -Stdlib.Int32.clamp_v0 -3l -2l 1l = -2l // below min -Stdlib.Int32.clamp_v0 -5l 1l 1l = 1l // at limit -Stdlib.Int32.clamp_v0 1l 2l 1l = 1l // above max -Stdlib.Int32.clamp_v0 3l 0l 2l = 2l // below in -Stdlib.Int32.clamp_v0 -100l 0l 0l = 0l -Stdlib.Int32.clamp_v0 100l 0l 0l = 0l -Stdlib.Int32.clamp_v0 -100l 0l -1l = -1l -Stdlib.Int32.clamp_v0 100l 0l -1l = 0l -Stdlib.Int32.clamp_v0 -100l -1l 0l = -1l -Stdlib.Int32.clamp_v0 100l -1l 0l = 0l -Stdlib.Int32.clamp_v0 -100l 1l 0l = 0l -Stdlib.Int32.clamp_v0 100l 1l 0l = 1l -Stdlib.Int32.clamp_v0 -2147483647l 250l -26l = -26l -Stdlib.Int32.clamp_v0 2147483647l 250l -26l = 250l - -Stdlib.Int32.negate_v0 -5l = 5l -Stdlib.Int32.negate_v0 5l = -5l -Stdlib.Int32.negate_v0 0l = 0l -Stdlib.Int32.negate_v0 -0l = 0l - -Stdlib.Int32.remainder_v0 15l 6l = Stdlib.Result.Result.Ok 3l - -Stdlib.Int32.remainder_v0 20l 8l = Stdlib.Result.Result.Ok 4l - -Stdlib.Int32.remainder_v0 -20l 8l = Stdlib.Result.Result.Ok -4l - -Stdlib.Int32.remainder_v0 -20l -8l = Stdlib.Result.Result.Ok -4l - -Stdlib.Int32.remainder_v0 -15l 6l = Stdlib.Result.Result.Ok -3l - -Stdlib.Int32.remainder_v0 5l 0l = Builtin.testDerrorMessage "Division by zero" - - -Stdlib.Int32.mod_v0 15l 5l = 0l -Stdlib.Int32.mod_v0 15l 6l = 3l -Stdlib.Int32.mod_v0 0l 15l = 0l -Stdlib.Int32.mod_v0 -1l 2l = 1l -Stdlib.Int32.mod_v0 -754l 53l = 41l -Stdlib.Int32.mod_v0 222222222l 3l = 0l - -Stdlib.Int32.mod_v0 5l 0l = Builtin.testDerrorMessage "Zero modulus" - -Stdlib.Int32.mod_v0 5l -5l = Builtin.testDerrorMessage "Negative modulus" - -Stdlib.Int32.power_v0 2l 3l = 8l -Stdlib.Int32.power_v0 0l 1l = 0l -Stdlib.Int32.power_v0 1l 0l = 1l -Stdlib.Int32.power_v0 0l 0l = 1l -Stdlib.Int32.power_v0 -2l 5l = -32l -Stdlib.Int32.power_v0 -1l 5l = -1l -Stdlib.Int32.power_v0 -1l 6l = 1l -Stdlib.Int32.power_v0 1l 2147483647l = 1l - -Stdlib.Int32.power_v0 2l 31l = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int32.power_v0 120l 20l = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int32.power_v0 2l -3l = Builtin.testDerrorMessage "Negative exponent" - - -Stdlib.Int32.greaterThan_v0 20l 1l = true - -Stdlib.Int32.greaterThanOrEqualTo_v0 0l 1l = false -Stdlib.Int32.greaterThanOrEqualTo_v0 1l 0l = true -Stdlib.Int32.greaterThanOrEqualTo_v0 6l 1l = true -Stdlib.Int32.greaterThanOrEqualTo_v0 6l 8l = false -Stdlib.Int32.greaterThanOrEqualTo_v0 -5l -20l = true -Stdlib.Int32.greaterThanOrEqualTo_v0 -20l -1l = false -Stdlib.Int32.greaterThanOrEqualTo_v0 -20l -20l = true - - -Stdlib.Int32.lessThanOrEqualTo_v0 6l 8l = true -Stdlib.Int32.lessThanOrEqualTo_v0 10l 1l = false -Stdlib.Int32.lessThanOrEqualTo_v0 0l 1l = true -Stdlib.Int32.lessThanOrEqualTo_v0 1l 0l = false -Stdlib.Int32.lessThanOrEqualTo_v0 -100l 22544l = true -Stdlib.Int32.lessThanOrEqualTo_v0 -999l -9999l = false -Stdlib.Int32.lessThanOrEqualTo_v0 -8888l -8888l = true - -Stdlib.Int32.lessThan_v0 6l 8l = true -Stdlib.Int32.lessThan_v0 10l 1l = false -Stdlib.Int32.lessThan_v0 0l 1l = true -Stdlib.Int32.lessThan_v0 1l 0l = false -Stdlib.Int32.lessThan_v0 -100l 22544l = true -Stdlib.Int32.lessThan_v0 -999l -9999l = false -Stdlib.Int32.lessThan_v0 -8888l -8888l = false - -Stdlib.Int32.sqrt_v0 4l = 2.0 -Stdlib.Int32.sqrt_v0 100l = 10.0 -Stdlib.Int32.sqrt_v0 86l = 9.273618495495704 - -Stdlib.Int32.toFloat_v0 2l = 2.0 -Stdlib.Int32.toFloat_v0 955656l = 955656.0 -Stdlib.Int32.toFloat_v0 -10l = -10.0 - -Stdlib.Int32.add_v0 10l 9l = 19l -Stdlib.Int32.add_v0 88l 9l = 97l -Stdlib.Int32.add_v0 -1l 2l = 1l -Stdlib.Int32.add_v0 1l 0l = 1l -Stdlib.Int32.add_v0 -55l 55l = 0l -Stdlib.Int32.add_v0 2147483646l 1l = 2147483647l - -// Overflow tests -Stdlib.Int32.add_v0 2147483647l 1l = -2147483648l -Stdlib.Int32.add_v0 55l 2147483647l = -2147483594l -Stdlib.Int32.add_v0 -2147483648l -1l = 2147483647l - - -Stdlib.Int32.subtract_v0 10l 9l = 1l -Stdlib.Int32.subtract_v0 88l 9l = 79l -Stdlib.Int32.subtract_v0 0l 1l = -1l -Stdlib.Int32.subtract_v0 1l 0l = 1l -Stdlib.Int32.subtract_v0 -55l -55l = 0l - - -Stdlib.Int32.multiply_v0 8l 8l = 64l -Stdlib.Int32.multiply_v0 5145l 5145l = 26471025l - -Stdlib.Int32.divide_v0 10l 5l = 2l -Stdlib.Int32.divide_v0 17l 3l = 5l -Stdlib.Int32.divide_v0 -8l 5l = -1l -Stdlib.Int32.divide_v0 0l 1l = 0l - -Stdlib.Int32.divide_v0 1l 0l = Builtin.testDerrorMessage "Division by zero" - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 1l 2l) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int32.greaterThanOrEqualTo x 1l) - && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 10l 20l) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int32.greaterThanOrEqualTo x 10l) - && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 2l 1l) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int32.greaterThanOrEqualTo x 1l) - && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 20l 10l) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int32.greaterThanOrEqualTo x 10l) - && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 1l) - |> Stdlib.List.unique_v0) = [ 0l; 1l ] - - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 2l) - |> Stdlib.List.unique_v0) = [ 0l; 1l; 2l ] - - -Stdlib.Int32.sum_v0 [ 1l; 2l ] = 3l - -Stdlib.Int32.parse_v0 "0" = Stdlib.Result.Result.Ok 0l - -Stdlib.Int32.parse_v0 "1" = Stdlib.Result.Result.Ok 1l - -Stdlib.Int32.parse_v0 " 1" = Stdlib.Result.Result.Ok 1l - -Stdlib.Int32.parse_v0 "1 " = Stdlib.Result.Result.Ok 1l - -Stdlib.Int32.parse_v0 "+1" = Stdlib.Result.Result.Ok 1l - -Stdlib.Int32.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1l - -Stdlib.Int32.parse_v0 "-1" = Stdlib.Result.Result.Ok -1l - -Stdlib.Int32.parse_v0 "078" = Stdlib.Result.Result.Ok 78l // "octal" format ignored - -Stdlib.Int32.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1l - -Stdlib.Int32.parse_v0 "-10001" = Stdlib.Result.Result.Ok -10001l - -Stdlib.Int32.parse_v0 "-2147483648" = Stdlib.Result.Result.Ok -2147483648l - -Stdlib.Int32.parse_v0 "2147483647" = Stdlib.Result.Result.Ok 2147483647l - -Stdlib.Int32.parse_v0 "2147483648" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.OutOfRange - -Stdlib.Int32.parse_v0 "-2147483649" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.OutOfRange - -Stdlib.Int32.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - -Stdlib.Int32.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.Int32.ParseError.BadFormat - - -Stdlib.Int32.toString 0l = "0" -Stdlib.Int32.toString 1l = "1" -Stdlib.Int32.toString -1l = "-1" -Stdlib.Int32.toString -2147483648l = "-2147483648" // Int32 lower limit -Stdlib.Int32.toString 2147483647l = "2147483647" // Int32 upper limit - -Stdlib.Int32.fromInt8_v0 0y = 0l - -Stdlib.Int32.fromInt8_v0 1y = 1l - -Stdlib.Int32.fromInt8_v0 127y = 127l - -Stdlib.Int32.fromInt8_v0 (-128y) = -128l - -Stdlib.Int32.fromUInt8_v0 0uy = 0l - -Stdlib.Int32.fromUInt8_v0 1uy = 1l - -Stdlib.Int32.fromUInt8_v0 255uy = 255l - -Stdlib.Int32.fromInt16_v0 0s = 0l - -Stdlib.Int32.fromInt16_v0 1s = 1l - -Stdlib.Int32.fromInt16_v0 32767s = 32767l - -Stdlib.Int32.fromInt16_v0 (-32768s) = -32768l - -Stdlib.Int32.fromUInt16_v0 0us = 0l - -Stdlib.Int32.fromUInt16_v0 1us = 1l - -Stdlib.Int32.fromUInt16_v0 65535us = 65535l - -Stdlib.Int32.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0l - -Stdlib.Int32.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1l - -Stdlib.Int32.fromUInt32_v0 4294967295ul = Stdlib.Option.Option.None - -Stdlib.Int32.fromInt64_v0 0L = Stdlib.Option.Option.Some 0l - -Stdlib.Int32.fromInt64_v0 1L = Stdlib.Option.Option.Some 1l - -Stdlib.Int32.fromInt64_v0 2147483647L = Stdlib.Option.Option.Some 2147483647l - -Stdlib.Int32.fromInt64_v0 2147483648L = Stdlib.Option.Option.None - -Stdlib.Int32.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1l - -Stdlib.Int32.fromInt64_v0 (-2147483648L) = Stdlib.Option.Option.Some -2147483648l - -Stdlib.Int32.fromInt64_v0 (-2147483649L) = Stdlib.Option.Option.None - -Stdlib.Int32.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0l - -Stdlib.Int32.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1l - -Stdlib.Int32.fromUInt64_v0 2147483647UL = Stdlib.Option.Option.Some 2147483647l - -Stdlib.Int32.fromUInt64_v0 2147483648UL = Stdlib.Option.Option.None - -Stdlib.Int32.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0l - -Stdlib.Int32.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1l - -Stdlib.Int32.fromInt128_v0 2147483647Q = Stdlib.Option.Option.Some 2147483647l - -Stdlib.Int32.fromInt128_v0 2147483648Q = Stdlib.Option.Option.None - -Stdlib.Int32.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1l - -Stdlib.Int32.fromInt128_v0 (-2147483648Q) = Stdlib.Option.Option.Some -2147483648l - -Stdlib.Int32.fromInt128_v0 (-2147483649Q) = Stdlib.Option.Option.None - -Stdlib.Int32.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0l - -Stdlib.Int32.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1l - -Stdlib.Int32.fromUInt128_v0 2147483647Z = Stdlib.Option.Option.Some 2147483647l - -Stdlib.Int32.fromUInt128_v0 2147483648Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_int64.dark b/backend/testfiles/execution/stdlib/ints/_int64.dark deleted file mode 100644 index 82b400438e..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_int64.dark +++ /dev/null @@ -1,436 +0,0 @@ -Stdlib.Int64.absoluteValue_v0 -5L = 5L -Stdlib.Int64.absoluteValue_v0 5L = 5L - -Stdlib.Int64.max_v0 5L 6L = 6L -Stdlib.Int64.max_v0 10L 1L = 10L -Stdlib.Int64.max_v0 -5L 6L = 6L -Stdlib.Int64.max_v0 -100L -20000L = -100L -Stdlib.Int64.max_v0 250L -26L = 250L - -Stdlib.Int64.min_v0 5L 6L = 5L -Stdlib.Int64.min_v0 50L -10L = -10L -Stdlib.Int64.min_v0 -5L 6L = -5L -Stdlib.Int64.min_v0 -100L -20000L = -20000L -Stdlib.Int64.min_v0 250L -26L = -26L - - -Stdlib.Int64.clamp_v0 -5L -2L 5L = -2L // in bounds -Stdlib.Int64.clamp_v0 -3L -2L 1L = -2L // below min -Stdlib.Int64.clamp_v0 -5L 1L 1L = 1L // at limit -Stdlib.Int64.clamp_v0 1L 2L 1L = 1L // above max -Stdlib.Int64.clamp_v0 3L 0L 2L = 2L // below in -Stdlib.Int64.clamp_v0 -100L 0L 0L = 0L -Stdlib.Int64.clamp_v0 100L 0L 0L = 0L -Stdlib.Int64.clamp_v0 -100L 0L -1L = -1L -Stdlib.Int64.clamp_v0 100L 0L -1L = 0L -Stdlib.Int64.clamp_v0 -100L -1L 0L = -1L -Stdlib.Int64.clamp_v0 100L -1L 0L = 0L -Stdlib.Int64.clamp_v0 -100L 1L 0L = 0L -Stdlib.Int64.clamp_v0 100L 1L 0L = 1L -Stdlib.Int64.clamp_v0 -2147483647L 250L -26L = -26L -Stdlib.Int64.clamp_v0 2147483647L 250L -26L = 250L - -Stdlib.Int64.negate_v0 -5L = 5L -Stdlib.Int64.negate_v0 5L = -5L -Stdlib.Int64.negate_v0 0L = 0L -Stdlib.Int64.negate_v0 -0L = 0L - -Stdlib.Int64.remainder_v0 15L 6L = Stdlib.Result.Result.Ok 3L - -Stdlib.Int64.remainder_v0 20L 8L = Stdlib.Result.Result.Ok 4L - -Stdlib.Int64.remainder_v0 -20L 8L = Stdlib.Result.Result.Ok -4L - -Stdlib.Int64.remainder_v0 -20L -8L = Stdlib.Result.Result.Ok -4L - -Stdlib.Int64.remainder_v0 -15L 6L = Stdlib.Result.Result.Ok -3L - -Stdlib.Int64.remainder_v0 5L 0L = Builtin.testDerrorMessage "Division by zero" - -Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> - Stdlib.Int64.remainder_v0 v -4L) = [ Stdlib.Result.Result.Ok -1L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok -3L - Stdlib.Result.Result.Ok -2L - Stdlib.Result.Result.Ok -1L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok 1L - Stdlib.Result.Result.Ok 2L - Stdlib.Result.Result.Ok 3L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok 1L ] - -Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> - Stdlib.Int64.remainder_v0 v 4L) = [ Stdlib.Result.Result.Ok -1L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok -3L - Stdlib.Result.Result.Ok -2L - Stdlib.Result.Result.Ok -1L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok 1L - Stdlib.Result.Result.Ok 2L - Stdlib.Result.Result.Ok 3L - Stdlib.Result.Result.Ok 0L - Stdlib.Result.Result.Ok 1L ] - -Stdlib.Int64.mod_v0 15L 5L = 0L -Stdlib.Int64.mod_v0 15L 6L = 3L -Stdlib.Int64.mod_v0 0L 15L = 0L -Stdlib.Int64.mod_v0 -1L 2L = 1L -Stdlib.Int64.mod_v0 -754L 53L = 41L -Stdlib.Int64.mod_v0 9999999999998L 3L = 2L - -Stdlib.Int64.mod_v0 5L 0L = Builtin.testDerrorMessage "Zero modulus" - -Stdlib.Int64.mod_v0 5L -5L = Builtin.testDerrorMessage "Negative modulus" - -// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> -// Stdlib.Int64.mod_v0 v 4L) = [ 3L 0L 1L 2L 3L 0L 1L 2L 3L 0L 1L ] - -15L % 5L = 0L -5L % 0L = Builtin.testDerrorMessage "Zero modulus" -5L % -5L = Builtin.testDerrorMessage "Negative modulus" - -Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> v % 4L) = [ 3L - 0L - 1L - 2L - 3L - 0L - 1L - 2L - 3L - 0L - 1L ] - -Stdlib.Int64.power_v0 8L 5L = 32768L -Stdlib.Int64.power_v0 0L 1L = 0L -Stdlib.Int64.power_v0 0L 0L = 1L -Stdlib.Int64.power_v0 1L 0L = 1L -Stdlib.Int64.power_v0 1000L 0L = 1L -Stdlib.Int64.power_v0 -8L 5L = -32768L - -Stdlib.Int64.power_v0 200L 20L = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int64.power_v0 200L 7L = 12800000000000000L - -Stdlib.Int64.power_v0 1L 2147483649L = 1L - -Stdlib.Int64.power_v0 -1L 2147483649L = -1L - -Stdlib.Int64.power_v0 2L -3L = Builtin.testDerrorMessage "Negative exponent" - -5L ^ 2L = 25L --8L ^ 5L = -32768L -50L ^ 2L = 2500L - -Stdlib.Int64.greaterThan_v0 20L 1L = true -20L > 1L = true - -0L >= 1L = false -1L >= 0L = true -6L >= 1L = true -6L >= 8L = false --5L >= -20L = true --20L >= -1L = false --20L >= -20L = true - -Stdlib.Int64.greaterThanOrEqualTo_v0 0L 1L = false -Stdlib.Int64.greaterThanOrEqualTo_v0 1L 0L = true -Stdlib.Int64.greaterThanOrEqualTo_v0 6L 1L = true -Stdlib.Int64.greaterThanOrEqualTo_v0 6L 8L = false -Stdlib.Int64.greaterThanOrEqualTo_v0 -5L -20L = true -Stdlib.Int64.greaterThanOrEqualTo_v0 -20L -1L = false -Stdlib.Int64.greaterThanOrEqualTo_v0 -20L -20L = true - -6L <= 8L = true -10L <= 1L = false -0L <= 1L = true -1L <= 0L = false --100L <= 22544L = true --999L <= -9999L = false --8888L <= -8888L = true - -Stdlib.Int64.lessThanOrEqualTo_v0 6L 8L = true -Stdlib.Int64.lessThanOrEqualTo_v0 10L 1L = false -Stdlib.Int64.lessThanOrEqualTo_v0 0L 1L = true -Stdlib.Int64.lessThanOrEqualTo_v0 1L 0L = false -Stdlib.Int64.lessThanOrEqualTo_v0 -100L 22544L = true -Stdlib.Int64.lessThanOrEqualTo_v0 -999L -9999L = false -Stdlib.Int64.lessThanOrEqualTo_v0 -8888L -8888L = true - -Stdlib.Int64.lessThan_v0 6L 8L = true -Stdlib.Int64.lessThan_v0 10L 1L = false -Stdlib.Int64.lessThan_v0 0L 1L = true -Stdlib.Int64.lessThan_v0 1L 0L = false -Stdlib.Int64.lessThan_v0 -100L 22544L = true -Stdlib.Int64.lessThan_v0 -999L -9999L = false -Stdlib.Int64.lessThan_v0 -8888L -8888L = false -6L < 8L = true -10L < 1L = false -0L < 1L = true -1L < 0L = false --100L < 22544L = true --999L < -9999L = false --8888L < -8888L = false - -Stdlib.Int64.sqrt_v0 4L = 2.0 -Stdlib.Int64.sqrt_v0 100L = 10.0 -Stdlib.Int64.sqrt_v0 86L = 9.273618495495704 - -Stdlib.Int64.toFloat_v0 2L = 2.0 -Stdlib.Int64.toFloat_v0 955656L = 955656.0 -Stdlib.Int64.toFloat_v0 -10L = -10.0 - -Stdlib.Int64.add_v0 10L 9L = 19L -Stdlib.Int64.add_v0 88L 9L = 97L -Stdlib.Int64.add_v0 -1L 2L = 1L -Stdlib.Int64.add_v0 1L 0L = 1L -Stdlib.Int64.add_v0 -55L 55L = 0L -Stdlib.Int64.add_v0 9223372036854775806L 1L = 9223372036854775807L - -// Overflow tests -Stdlib.Int64.add_v0 9223372036854775807L 1L = -9223372036854775808L -Stdlib.Int64.add_v0 55L 9223372036854775807L = -9223372036854775754L -Stdlib.Int64.add_v0 (-9223372036854775808L) (-1L) = 9223372036854775807L - --2000L + 1950L = -50L --1993L + 2000L = 7L - -Stdlib.Int64.subtract_v0 10L 9L = 1L -Stdlib.Int64.subtract_v0 88L 9L = 79L -Stdlib.Int64.subtract_v0 0L 1L = -1L -Stdlib.Int64.subtract_v0 1L 0L = 1L -Stdlib.Int64.subtract_v0 -55L -55L = 0L - -2000L - 1950L = 50L --1993L - -2000L = 7L - -Stdlib.Int64.multiply_v0 8L 8L = 64L -Stdlib.Int64.multiply_v0 5145L 5145L = 26471025L - -1L * 1.0 = Builtin.testDerrorMessage - "int64Multiply's 2nd argument (`b`) should be an Int64. However, a Float (1.0) was passed instead. - -Expected: (b: Int64) -Actual: a Float: 1.0" - -8L * 8L = 64L -Stdlib.Int64.divide_v0 10L 5L = 2L -Stdlib.Int64.divide_v0 17L 3L = 5L -Stdlib.Int64.divide_v0 -8L 5L = -1L -Stdlib.Int64.divide_v0 0L 1L = 0L - -Stdlib.Int64.divide_v0 1L 0L = Builtin.testDerrorMessage "Division by zero" - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 1L 2L) -|> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true - true - true - true - true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 10L 20L) -|> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true - true - true - true - true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 2L 1L) -|> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true - true - true - true - true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 20L 10L) -|> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true - true - true - true - true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 1L) - |> Stdlib.List.unique_v0) = [ 0L; 1L ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 2L) - |> Stdlib.List.unique_v0) = [ 0L; 1L; 2L ] - -Stdlib.Int64.sum_v0 [ 1L; 2L ] = 3L - -Stdlib.Int64.parse_v0 "0" = Stdlib.Result.Result.Ok 0L - -Stdlib.Int64.parse_v0 "1" = Stdlib.Result.Result.Ok 1L - -Stdlib.Int64.parse_v0 " 1" = Stdlib.Result.Result.Ok 1L - -Stdlib.Int64.parse_v0 "1 " = Stdlib.Result.Result.Ok 1L - -Stdlib.Int64.parse_v0 "+1" = Stdlib.Result.Result.Ok 1L - -Stdlib.Int64.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1L - -Stdlib.Int64.parse_v0 "-1" = Stdlib.Result.Result.Ok -1L - -Stdlib.Int64.parse_v0 "078" = Stdlib.Result.Result.Ok 78L // "octal" format ignored - -Stdlib.Int64.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1L - -Stdlib.Int64.parse_v0 "-10001" = Stdlib.Result.Result.Ok -10001L - -Stdlib.Int64.parse_v0 "-4611686018427387904" = Stdlib.Result.Result.Ok - -4611686018427387904L // int63 lower limit - -Stdlib.Int64.parse_v0 "-4611686018427387905" = Stdlib.Result.Result.Ok - -4611686018427387905L // past the int63 upper limit - -Stdlib.Int64.parse_v0 "-9223372036854775808" = Stdlib.Result.Result.Ok - -9223372036854775808L // .NET lower limit - -Stdlib.Int64.parse_v0 "-9223372036854775809" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.OutOfRange - -Stdlib.Int64.parse_v0 "4611686018427387903" = Stdlib.Result.Result.Ok - 4611686018427387903L // int63 upper limit - -Stdlib.Int64.parse_v0 "4611686018427387904" = Stdlib.Result.Result.Ok - 4611686018427387904L // past the int63 upper limit - -Stdlib.Int64.parse_v0 "9223372036854775807" = Stdlib.Result.Result.Ok - 9223372036854775807L // .NET upper limit - -Stdlib.Int64.parse_v0 "9223372036854775808" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.OutOfRange - -Stdlib.Int64.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "9223372036854775808" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.OutOfRange - -Stdlib.Int64.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - -Stdlib.Int64.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.Int64.ParseError.BadFormat - - -Stdlib.Int64.toString 0L = "0" -Stdlib.Int64.toString 1L = "1" -Stdlib.Int64.toString -1L = "-1" -Stdlib.Int64.toString -4611686018427387904L = "-4611686018427387904" // int63 lower limit -Stdlib.Int64.toString -4611686018427387905L = "-4611686018427387905" // past the int63 upper limit" -Stdlib.Int64.toString -9223372036854775808L = "-9223372036854775808" // .NET lower limit -Stdlib.Int64.toString 4611686018427387903L = "4611686018427387903" // int63 upper limit -Stdlib.Int64.toString 4611686018427387904L = "4611686018427387904" // past the int63 upper limit -Stdlib.Int64.toString 9223372036854775807L = "9223372036854775807" // .NET upper limit - -Stdlib.Int64.fromInt8_v0 0y = 0L - -Stdlib.Int64.fromInt8_v0 1y = 1L - -Stdlib.Int64.fromInt8_v0 127y = 127L - -Stdlib.Int64.fromInt8_v0 -128y = -128L - -Stdlib.Int64.fromUInt8_v0 0uy = 0L - -Stdlib.Int64.fromUInt8_v0 1uy = 1L - -Stdlib.Int64.fromUInt8_v0 255uy = 255L - -Stdlib.Int64.fromInt16_v0 0s = 0L - -Stdlib.Int64.fromInt16_v0 1s = 1L - -Stdlib.Int64.fromInt16_v0 32767s = 32767L - -Stdlib.Int64.fromInt16_v0 -32768s = -32768L - -Stdlib.Int64.fromUInt16_v0 0us = 0L - -Stdlib.Int64.fromUInt16_v0 1us = 1L - -Stdlib.Int64.fromUInt16_v0 65535us = 65535L - -Stdlib.Int64.fromInt32_v0 0l = 0L - -Stdlib.Int64.fromInt32_v0 1l = 1L - -Stdlib.Int64.fromInt32_v0 2147483647l = 2147483647L - -Stdlib.Int64.fromInt32_v0 -2147483648l = -2147483648L - -Stdlib.Int64.fromUInt32_v0 0ul = 0L - -Stdlib.Int64.fromUInt32_v0 1ul = 1L - -Stdlib.Int64.fromUInt32_v0 4294967295ul = 4294967295L - -Stdlib.Int64.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0L - -Stdlib.Int64.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1L - -Stdlib.Int64.fromUInt64_v0 9223372036854775807UL = Stdlib.Option.Option.Some - 9223372036854775807L - -Stdlib.Int64.fromUInt64_v0 18446744073709551615UL = Stdlib.Option.Option.None - -Stdlib.Int64.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0L - -Stdlib.Int64.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1L - -Stdlib.Int64.fromInt128_v0 9223372036854775807Q = Stdlib.Option.Option.Some - 9223372036854775807L - -Stdlib.Int64.fromInt128_v0 -9223372036854775808Q = Stdlib.Option.Option.Some - -9223372036854775808L - -Stdlib.Int64.fromInt128_v0 9223372036854775808Q = Stdlib.Option.Option.None -Stdlib.Int64.fromInt128_v0 -9223372036854775809Q = Stdlib.Option.Option.None - -Stdlib.Int64.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0L - -Stdlib.Int64.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1L - -Stdlib.Int64.fromUInt128_v0 9223372036854775807Z = Stdlib.Option.Option.Some - 9223372036854775807L - -Stdlib.Int64.fromUInt128_v0 18446744073709551615Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_int8.dark b/backend/testfiles/execution/stdlib/ints/_int8.dark deleted file mode 100644 index 9910d25f35..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_int8.dark +++ /dev/null @@ -1,370 +0,0 @@ -Stdlib.Int8.absoluteValue_v0 -5y = 5y -Stdlib.Int8.absoluteValue_v0 5y = 5y - -//Stdlib.Int8.absoluteValue_v0 -128y = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int8.max_v0 5y 6y = 6y -Stdlib.Int8.max_v0 10y 1y = 10y -Stdlib.Int8.max_v0 -5y 6y = 6y -Stdlib.Int8.max_v0 127y -128y = 127y - -Stdlib.Int8.min_v0 5y 6y = 5y -Stdlib.Int8.min_v0 50y -10y = -10y -Stdlib.Int8.min_v0 -5y 6y = -5y -Stdlib.Int8.min_v0 127y -128y = -128y - - -Stdlib.Int8.clamp_v0 -5y -2y 5y = -2y -Stdlib.Int8.clamp_v0 -3y -2y 1y = -2y -Stdlib.Int8.clamp_v0 -5y 1y 1y = 1y -Stdlib.Int8.clamp_v0 1y 2y 1y = 1y -Stdlib.Int8.clamp_v0 3y 0y 2y = 2y -Stdlib.Int8.clamp_v0 -100y 0y 0y = 0y -Stdlib.Int8.clamp_v0 100y 0y 0y = 0y -Stdlib.Int8.clamp_v0 -100y 0y -1y = -1y -Stdlib.Int8.clamp_v0 100y 0y -1y = 0y -Stdlib.Int8.clamp_v0 -100y -1y 0y = -1y -Stdlib.Int8.clamp_v0 -100y 1y 0y = 0y -Stdlib.Int8.clamp_v0 100y 1y 0y = 1y - -Stdlib.Int8.negate_v0 -5y = 5y -Stdlib.Int8.negate_v0 5y = -5y -Stdlib.Int8.negate_v0 0y = 0y -Stdlib.Int8.negate_v0 -0y = 0y - -//Stdlib.Int8.negate_v0 -128y = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int8.remainder_v0 15y 6y = Stdlib.Result.Result.Ok 3y - -Stdlib.Int8.remainder_v0 20y 8y = Stdlib.Result.Result.Ok 4y - -Stdlib.Int8.remainder_v0 -20y 8y = Stdlib.Result.Result.Ok -4y - -Stdlib.Int8.remainder_v0 -20y -8y = Stdlib.Result.Result.Ok -4y - -Stdlib.Int8.remainder_v0 -15y 6y = Stdlib.Result.Result.Ok -3y - -//Stdlib.Int8.remainder_v0 5y 0y = Builtin.testDerrorMessage "Division by zero" - - -Stdlib.Int8.add_v0 10y 9y = 19y -Stdlib.Int8.add_v0 10y 0y = 10y -Stdlib.Int8.add_v0 88y 9y = 97y -Stdlib.Int8.add_v0 -1y 2y = 1y -Stdlib.Int8.add_v0 1y 0y = 1y -Stdlib.Int8.add_v0 -55y 55y = 0y -Stdlib.Int8.add_v0 55y 55y = 110y -Stdlib.Int8.add_v0 PACKAGE.Darklang.Test.Constants.int8Const 5y = 10y - -// Stdlib.Int8.add_v0 127y 1y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.add_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.add_v0 -100y -30y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.add_v0 100y 30y = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int8.subtract_v0 10y 9y = 1y -Stdlib.Int8.subtract_v0 88y 9y = 79y -Stdlib.Int8.subtract_v0 0y 1y = -1y -Stdlib.Int8.subtract_v0 1y 0y = 1y -Stdlib.Int8.subtract_v0 -55y -55y = 0y - -// Stdlib.Int8.subtract_v0 -2y 127y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.subtract_v0 -55y 100y = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int8.multiply_v0 8y 8y = 64y -Stdlib.Int8.multiply_v0 1y 0y = 0y - -// Stdlib.Int8.multiply_v0 64y 2y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.multiply_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" - -Stdlib.Int8.power_v0 2y 3y = 8y -Stdlib.Int8.power_v0 0y 1y = 0y -Stdlib.Int8.power_v0 1y 0y = 1y -Stdlib.Int8.power_v0 0y 0y = 1y -Stdlib.Int8.power_v0 -2y 5y = -32y -Stdlib.Int8.power_v0 -1y 5y = -1y -Stdlib.Int8.power_v0 -1y 6y = 1y -Stdlib.Int8.power_v0 1y 127y = 1y - -// Stdlib.Int8.power_v0 3y 5y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.power_v0 120y 20y = Builtin.testDerrorMessage "Out of range" - -// Stdlib.Int8.power_v0 2y -3y = Builtin.testDerrorMessage "Negative exponent" - - -Stdlib.Int8.divide_v0 10y 5y = 2y -Stdlib.Int8.divide_v0 17y 3y = 5y -Stdlib.Int8.divide_v0 -8y 5y = -1y -Stdlib.Int8.divide_v0 0y 1y = 0y - -// Stdlib.Int8.divide_v0 1y 0y = Builtin.testDerrorMessage "Division by zero" - -// Stdlib.Int8.divide_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" - - -Stdlib.Int8.greaterThan_v0 20y 1y = true -Stdlib.Int8.greaterThan_v0 20y 127y = false -Stdlib.Int8.greaterThanOrEqualTo_v0 0y 1y = false -Stdlib.Int8.greaterThanOrEqualTo_v0 1y 0y = true -Stdlib.Int8.greaterThanOrEqualTo_v0 6y 1y = true -Stdlib.Int8.greaterThanOrEqualTo_v0 6y 8y = false -Stdlib.Int8.greaterThanOrEqualTo_v0 -5y -20y = true -Stdlib.Int8.greaterThanOrEqualTo_v0 -20y -1y = false -Stdlib.Int8.greaterThanOrEqualTo_v0 -20y -20y = true -Stdlib.Int8.greaterThanOrEqualTo_v0 -128y -20y = false - -Stdlib.Int8.lessThanOrEqualTo_v0 6y 8y = true -Stdlib.Int8.lessThanOrEqualTo_v0 10y 1y = false -Stdlib.Int8.lessThanOrEqualTo_v0 0y 1y = true -Stdlib.Int8.lessThanOrEqualTo_v0 1y 0y = false -Stdlib.Int8.lessThan_v0 -128y 127y = true - -Stdlib.Int8.lessThan_v0 6y 8y = true -Stdlib.Int8.lessThan_v0 10y 1y = false -Stdlib.Int8.lessThan_v0 0y 1y = true -Stdlib.Int8.lessThan_v0 1y 0y = false -Stdlib.Int8.lessThan_v0 -128y 127y = true - -Stdlib.Int8.toString 0y = "0" -Stdlib.Int8.toString 1y = "1" -Stdlib.Int8.toString -1y = "-1" -Stdlib.Int8.toString -128y = "-128" // Int8 lower limit -Stdlib.Int8.toString 127y = "127" // Int8 upper limit - -Stdlib.Int8.toFloat_v0 2y = 2.0 -Stdlib.Int8.toFloat_v0 127y = 127.0 -Stdlib.Int8.toFloat_v0 -128y = -128.0 -Stdlib.Int8.toFloat_v0 -10y = -10.0 - -Stdlib.Int8.sqrt_v0 4y = 2.0 -Stdlib.Int8.sqrt_v0 100y = 10.0 -Stdlib.Int8.sqrt_v0 86y = 9.273618495495704 - -Stdlib.Int8.mod_v0 15y 5y = 0y -Stdlib.Int8.mod_v0 15y 6y = 3y -Stdlib.Int8.mod_v0 0y 15y = 0y -Stdlib.Int8.mod_v0 -1y 2y = 1y -Stdlib.Int8.mod_v0 -128y 53y = 31y -Stdlib.Int8.mod_v0 127y 3y = 1y - -// Stdlib.Int8.mod_v0 5y 0y = Builtin.testDerrorMessage "Zero modulus" - -// Stdlib.Int8.mod_v0 5y -5y = Builtin.testDerrorMessage "Negative modulus" - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 1y 2y) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true - true - true - true - true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 10y 20y) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int8.greaterThanOrEqualTo x 10y) - && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 2y 1y) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true - true - true - true - true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 20y 10y) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.Int8.greaterThanOrEqualTo x 10y) - && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 1y) - |> Stdlib.List.unique_v0) = [ 0y; 1y ] - - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 2y) - |> Stdlib.List.unique_v0) = [ 0y; 1y; 2y ] - - -Stdlib.Int8.parse_v0 "0" = Stdlib.Result.Result.Ok(0y) - -Stdlib.Int8.parse_v0 "1" = Stdlib.Result.Result.Ok(1y) - -Stdlib.Int8.parse_v0 " 1" = Stdlib.Result.Result.Ok(1y) - -Stdlib.Int8.parse_v0 "1 " = Stdlib.Result.Result.Ok(1y) - -Stdlib.Int8.parse_v0 "+1" = Stdlib.Result.Result.Ok(1y) - -Stdlib.Int8.parse_v0 " +1 " = Stdlib.Result.Result.Ok(1y) - -Stdlib.Int8.parse_v0 "-1" = Stdlib.Result.Result.Ok(-1y) - -Stdlib.Int8.parse_v0 "078" = Stdlib.Result.Result.Ok(78y) // "octal" format ignored - -Stdlib.Int8.parse_v0 "-00001" = Stdlib.Result.Result.Ok(-1y) - -Stdlib.Int8.parse_v0 "-10001" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.OutOfRange - -Stdlib.Int8.parse_v0 "127" = Stdlib.Result.Result.Ok(127y) - -Stdlib.Int8.parse_v0 "-128" = Stdlib.Result.Result.Ok(-128y) - -Stdlib.Int8.parse_v0 "128" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.OutOfRange - -Stdlib.Int8.parse_v0 "-129" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.OutOfRange - -Stdlib.Int8.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "" = Stdlib.Result.Result.Error Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - -Stdlib.Int8.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.Int8.ParseError.BadFormat - - -Stdlib.Int8.fromUInt8_v0 0uy = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromUInt8_v0 1uy = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromUInt8_v0 127uy = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromUInt8_v0 128uy = Stdlib.Option.Option.None -Stdlib.Int8.fromUInt8_v0 255uy = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt16_v0 0s = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromInt16_v0 1s = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromInt16_v0 127s = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromInt16_v0 128s = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt16_v0 (-1s) = Stdlib.Option.Option.Some -1y - -Stdlib.Int8.fromInt16_v0 (-128s) = Stdlib.Option.Option.Some -128y - -Stdlib.Int8.fromInt16_v0 (-129s) = Stdlib.Option.Option.None - -Stdlib.Int8.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromUInt16_v0 127us = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromUInt16_v0 128us = Stdlib.Option.Option.None -Stdlib.Int8.fromUInt16_v0 255us = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt32_v0 0l = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromInt32_v0 1l = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromInt32_v0 127l = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromInt32_v0 128l = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt32_v0 (-1l) = Stdlib.Option.Option.Some -1y - -Stdlib.Int8.fromInt32_v0 (-128l) = Stdlib.Option.Option.Some -128y - -Stdlib.Int8.fromInt32_v0 (-129l) = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt32_v0 2147483647l = Stdlib.Option.Option.None - -Stdlib.Int8.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromUInt32_v0 127ul = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromUInt32_v0 128ul = Stdlib.Option.Option.None -Stdlib.Int8.fromUInt32_v0 4294967295ul = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt64_v0 0L = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromInt64_v0 1L = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromInt64_v0 127L = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromInt64_v0 128L = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1y - -Stdlib.Int8.fromInt64_v0 (-128L) = Stdlib.Option.Option.Some -128y - -Stdlib.Int8.fromInt64_v0 (-129L) = Stdlib.Option.Option.None - -Stdlib.Int8.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromUInt64_v0 127UL = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromUInt64_v0 128UL = Stdlib.Option.Option.None -Stdlib.Int8.fromUInt64_v0 255UL = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromInt128_v0 127Q = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromInt128_v0 128Q = Stdlib.Option.Option.None - -Stdlib.Int8.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1y - -Stdlib.Int8.fromInt128_v0 (-128Q) = Stdlib.Option.Option.Some -128y - -Stdlib.Int8.fromInt128_v0 (-129Q) = Stdlib.Option.Option.None - -Stdlib.Int8.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0y - -Stdlib.Int8.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1y - -Stdlib.Int8.fromUInt128_v0 127Z = Stdlib.Option.Option.Some 127y - -Stdlib.Int8.fromUInt128_v0 128Z = Stdlib.Option.Option.None -Stdlib.Int8.fromUInt128_v0 255Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/int16.dark b/backend/testfiles/execution/stdlib/ints/int16.dark new file mode 100644 index 0000000000..c974e42ba5 --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/int16.dark @@ -0,0 +1,242 @@ +Stdlib.Int16.absoluteValue_v0 -5s = 5s +Stdlib.Int16.absoluteValue_v0 5s = 5s +//Stdlib.Int16.absoluteValue_v0 -32768s = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int16.clamp_v0 -5s -2s 5s = -2s +Stdlib.Int16.clamp_v0 -3s -2s 1s = -2s +Stdlib.Int16.clamp_v0 -5s 1s 1s = 1s +Stdlib.Int16.clamp_v0 1s 2s 1s = 1s +Stdlib.Int16.clamp_v0 3s 0s 2s = 2s + +Stdlib.Int16.max_v0 5s 6s = 6s +Stdlib.Int16.max_v0 10s 1s = 10s +Stdlib.Int16.max_v0 -5s 6s = 6s +Stdlib.Int16.max_v0 32767s -32768s = 32767s + +Stdlib.Int16.min_v0 5s 6s = 5s +Stdlib.Int16.min_v0 50s -10s = -10s +Stdlib.Int16.min_v0 -5s 6s = -5s +Stdlib.Int16.min_v0 32767s -32768s = -32768s + +Stdlib.Int16.clamp_v0 -100s 0s 0s = 0s +Stdlib.Int16.clamp_v0 100s 0s 0s = 0s +Stdlib.Int16.clamp_v0 -100s 0s -1s = -1s +Stdlib.Int16.clamp_v0 100s 0s -1s = 0s +Stdlib.Int16.clamp_v0 -100s -1s 0s = -1s +Stdlib.Int16.clamp_v0 -100s 1s 0s = 0s +Stdlib.Int16.clamp_v0 100s 1s 0s = 1s + +Stdlib.Int16.add_v0 10s 9s = 19s +Stdlib.Int16.add_v0 88s 9s = 97s +Stdlib.Int16.add_v0 -1s 2s = 1s +Stdlib.Int16.add_v0 1s 0s = 1s +Stdlib.Int16.add_v0 -55s 55s = 0s +Stdlib.Int16.add_v0 30000s 2767s = 32767s +Stdlib.Int16.add_v0 -30000s -2768s = -32768s +// Stdlib.Int16.add_v0 -30000s -2769s = Builtin.testDerrorMessage "Out of range" +//Stdlib.Int16.add_v0 30000s 2768s = Builtin.testDerrorMessage "Out of range" + + +Stdlib.Int16.subtract_v0 10s 9s = 1s +Stdlib.Int16.subtract_v0 88s 9s = 79s +Stdlib.Int16.subtract_v0 0s 1s = -1s +Stdlib.Int16.subtract_v0 1s 0s = 1s +Stdlib.Int16.subtract_v0 -55s -55s = 0s +//Stdlib.Int16.subtract_v0 -2769s 30000s = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int16.multiply_v0 8s 8s = 64s +Stdlib.Int16.multiply_v0 1s 0s = 0s +//Stdlib.Int16.multiply_v0 5145s 5145s = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int16.power_v0 2s 3s = 8s +Stdlib.Int16.power_v0 0s 1s = 0s +Stdlib.Int16.power_v0 1s 0s = 1s +Stdlib.Int16.power_v0 0s 0s = 1s +Stdlib.Int16.power_v0 -2s 5s = -32s +Stdlib.Int16.power_v0 -1s 5s = -1s +Stdlib.Int16.power_v0 -1s 6s = 1s +Stdlib.Int16.power_v0 1s 32767s = 1s +// Stdlib.Int16.power_v0 2s 15s = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int16.power_v0 120s 20s = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int16.power_v0 2s -3s = Builtin.testDerrorMessage "Negative exponent" + + +Stdlib.Int16.divide_v0 10s 5s = 2s +Stdlib.Int16.divide_v0 17s 3s = 5s +Stdlib.Int16.divide_v0 -8s 5s = -1s +Stdlib.Int16.divide_v0 0s 1s = 0s +// Stdlib.Int16.divide_v0 1s 0s = Builtin.testDerrorMessage "Division by zero" +// Stdlib.Int16.divide_v0 -32768s -1s = Builtin.testDerrorMessage "Out of range" +Stdlib.Int16.divide_v0 -32768s 1s = -32768s + + +Stdlib.Int16.negate_v0 -5s = 5s +Stdlib.Int16.negate_v0 5s = -5s +Stdlib.Int16.negate_v0 0s = 0s +Stdlib.Int16.negate_v0 -0s = 0s +//Stdlib.Int16.negate_v0 -32768s = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int16.greaterThan_v0 20s 1s = true +Stdlib.Int16.greaterThan_v0 20s 130s = false + +Stdlib.Int16.greaterThanOrEqualTo_v0 0s 1s = false +Stdlib.Int16.greaterThanOrEqualTo_v0 1s 0s = true +Stdlib.Int16.greaterThanOrEqualTo_v0 6s 1s = true +Stdlib.Int16.greaterThanOrEqualTo_v0 6s 8s = false +Stdlib.Int16.greaterThanOrEqualTo_v0 -5s -20s = true +Stdlib.Int16.greaterThanOrEqualTo_v0 -20s -1s = false +Stdlib.Int16.greaterThanOrEqualTo_v0 -20s -20s = true +Stdlib.Int16.greaterThanOrEqualTo_v0 -130s -20s = false + +Stdlib.Int16.lessThan_v0 6s 8s = true +Stdlib.Int16.lessThan_v0 10s 1s = false +Stdlib.Int16.lessThan_v0 0s 1s = true +Stdlib.Int16.lessThan_v0 1s 0s = false +Stdlib.Int16.lessThan_v0 -100s 22544s = true +Stdlib.Int16.lessThan_v0 -999s -9999s = false +Stdlib.Int16.lessThan_v0 -8888s -8888s = false + +Stdlib.Int16.lessThanOrEqualTo_v0 6s 8s = true +Stdlib.Int16.lessThanOrEqualTo_v0 10s 1s = false +Stdlib.Int16.lessThanOrEqualTo_v0 0s 1s = true +Stdlib.Int16.lessThanOrEqualTo_v0 1s 0s = false +Stdlib.Int16.lessThanOrEqualTo_v0 -100s 22544s = true +Stdlib.Int16.lessThanOrEqualTo_v0 -999s -9999s = false +Stdlib.Int16.lessThanOrEqualTo_v0 -8888s -8888s = true + +Stdlib.Int16.toString 0s = "0" +Stdlib.Int16.toString 1s = "1" +Stdlib.Int16.toString -1s = "-1" +Stdlib.Int16.toString -32768s = "-32768" // Int16 lower limit +Stdlib.Int16.toString 32767s = "32767" // Int16 upper limit + +Stdlib.Int16.toFloat_v0 2s = 2.0 +Stdlib.Int16.toFloat_v0 -10s = -10.0 + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 1s 2s) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int16.greaterThanOrEqualTo x 1s) +// && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 10s 20s) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int16.greaterThanOrEqualTo x 10s) +// && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 2s 1s) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int16.greaterThanOrEqualTo x 1s) +// && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 20s 10s) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int16.greaterThanOrEqualTo x 10s) +// && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 1s) +// |> Stdlib.List.unique_v0) = [ 0s; 1s ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 2s) +// |> Stdlib.List.unique_v0) = [ 0s; 1s; 2s ] + + +// Stdlib.Int16.parse_v0 "0" = Stdlib.Result.Result.Ok 0s +// Stdlib.Int16.parse_v0 "1" = Stdlib.Result.Result.Ok 1s +// Stdlib.Int16.parse_v0 " 1" = Stdlib.Result.Result.Ok 1s +// Stdlib.Int16.parse_v0 "1 " = Stdlib.Result.Result.Ok 1s +// Stdlib.Int16.parse_v0 "+1" = Stdlib.Result.Result.Ok 1s +// Stdlib.Int16.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1s +// Stdlib.Int16.parse_v0 "-1" = Stdlib.Result.Result.Ok -1s +// Stdlib.Int16.parse_v0 "078" = Stdlib.Result.Result.Ok 78s // "octal" format ignored +// Stdlib.Int16.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1s +// Stdlib.Int16.parse_v0 "32767" = Stdlib.Result.Result.Ok 32767s +// Stdlib.Int16.parse_v0 "-32768" = Stdlib.Result.Result.Ok -32768s +// Stdlib.Int16.parse_v0 "32768" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.OutOfRange +// Stdlib.Int16.parse_v0 "-32769" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.OutOfRange +// Stdlib.Int16.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat +// Stdlib.Int16.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.Int16.ParseError.BadFormat + + +Stdlib.Int16.fromInt8_v0 0y = 0s +Stdlib.Int16.fromInt8_v0 1y = 1s +Stdlib.Int16.fromInt8_v0 127y = 127s +Stdlib.Int16.fromInt8_v0 (-1y) = -1s +Stdlib.Int16.fromInt8_v0 (-128y) = -128s +Stdlib.Int16.fromUInt8_v0 0uy = 0s +Stdlib.Int16.fromUInt8_v0 1uy = 1s +Stdlib.Int16.fromUInt8_v0 255uy = 255s + +// Stdlib.Int16.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromUInt16_v0 32767us = Stdlib.Option.Option.Some 32767s + +// Stdlib.Int16.fromInt32_v0 0l = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromInt32_v0 1l = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromInt32_v0 32767l = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromInt32_v0 32768l = Stdlib.Option.Option.None +// Stdlib.Int16.fromInt32_v0 (-1l) = Stdlib.Option.Option.Some -1s +// Stdlib.Int16.fromInt32_v0 (-32768l) = Stdlib.Option.Option.Some -32768s +// Stdlib.Int16.fromInt32_v0 (-32769l) = Stdlib.Option.Option.None + +// Stdlib.Int16.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromUInt32_v0 32767ul = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromUInt32_v0 32768ul = Stdlib.Option.Option.None + +// Stdlib.Int16.fromInt64_v0 0L = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromInt64_v0 1L = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromInt64_v0 32767L = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromInt64_v0 32768L = Stdlib.Option.Option.None +// Stdlib.Int16.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1s +// Stdlib.Int16.fromInt64_v0 (-32768L) = Stdlib.Option.Option.Some -32768s +// Stdlib.Int16.fromInt64_v0 (-32769L) = Stdlib.Option.Option.None + +// Stdlib.Int16.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromUInt64_v0 32767UL = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromUInt64_v0 32768UL = Stdlib.Option.Option.None + +// Stdlib.Int16.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromInt128_v0 32767Q = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromInt128_v0 32768Q = Stdlib.Option.Option.None +// Stdlib.Int16.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1s +// Stdlib.Int16.fromInt128_v0 (-32768Q) = Stdlib.Option.Option.Some -32768s +// Stdlib.Int16.fromInt128_v0 (-32769Q) = Stdlib.Option.Option.None + +// Stdlib.Int16.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0s +// Stdlib.Int16.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1s +// Stdlib.Int16.fromUInt128_v0 32767Z = Stdlib.Option.Option.Some 32767s +// Stdlib.Int16.fromUInt128_v0 32768Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/int32.dark b/backend/testfiles/execution/stdlib/ints/int32.dark new file mode 100644 index 0000000000..1b2b69c9f4 --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/int32.dark @@ -0,0 +1,262 @@ +Stdlib.Int32.absoluteValue_v0 -5l = 5l +Stdlib.Int32.absoluteValue_v0 5l = 5l + +Stdlib.Int32.max_v0 5l 6l = 6l +Stdlib.Int32.max_v0 10l 1l = 10l +Stdlib.Int32.max_v0 -5l 6l = 6l +Stdlib.Int32.max_v0 -100l -20000l = -100l +Stdlib.Int32.max_v0 250l -26l = 250l + +Stdlib.Int32.min_v0 5l 6l = 5l +Stdlib.Int32.min_v0 50l -10l = -10l +Stdlib.Int32.min_v0 -5l 6l = -5l +Stdlib.Int32.min_v0 -100l -20000l = -20000l +Stdlib.Int32.min_v0 250l -26l = -26l + +Stdlib.Int32.clamp_v0 -5l -2l 5l = -2l // in bounds +Stdlib.Int32.clamp_v0 -3l -2l 1l = -2l // below min +Stdlib.Int32.clamp_v0 -5l 1l 1l = 1l // at limit +Stdlib.Int32.clamp_v0 1l 2l 1l = 1l // above max +Stdlib.Int32.clamp_v0 3l 0l 2l = 2l // below in +Stdlib.Int32.clamp_v0 -100l 0l 0l = 0l +Stdlib.Int32.clamp_v0 100l 0l 0l = 0l +Stdlib.Int32.clamp_v0 -100l 0l -1l = -1l +Stdlib.Int32.clamp_v0 100l 0l -1l = 0l +Stdlib.Int32.clamp_v0 -100l -1l 0l = -1l +Stdlib.Int32.clamp_v0 100l -1l 0l = 0l +Stdlib.Int32.clamp_v0 -100l 1l 0l = 0l +Stdlib.Int32.clamp_v0 100l 1l 0l = 1l +Stdlib.Int32.clamp_v0 -2147483647l 250l -26l = -26l +Stdlib.Int32.clamp_v0 2147483647l 250l -26l = 250l + +Stdlib.Int32.negate_v0 -5l = 5l +Stdlib.Int32.negate_v0 5l = -5l +Stdlib.Int32.negate_v0 0l = 0l +Stdlib.Int32.negate_v0 -0l = 0l + +// Stdlib.Int32.remainder_v0 15l 6l = Stdlib.Result.Result.Ok 3l +// Stdlib.Int32.remainder_v0 20l 8l = Stdlib.Result.Result.Ok 4l +// Stdlib.Int32.remainder_v0 -20l 8l = Stdlib.Result.Result.Ok -4l +// Stdlib.Int32.remainder_v0 -20l -8l = Stdlib.Result.Result.Ok -4l +// Stdlib.Int32.remainder_v0 -15l 6l = Stdlib.Result.Result.Ok -3l +// Stdlib.Int32.remainder_v0 5l 0l = Builtin.testDerrorMessage "Division by zero" + + +Stdlib.Int32.mod_v0 15l 5l = 0l +Stdlib.Int32.mod_v0 15l 6l = 3l +Stdlib.Int32.mod_v0 0l 15l = 0l +Stdlib.Int32.mod_v0 -1l 2l = 1l +Stdlib.Int32.mod_v0 -754l 53l = 41l +Stdlib.Int32.mod_v0 222222222l 3l = 0l +// Stdlib.Int32.mod_v0 5l 0l = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.Int32.mod_v0 5l -5l = Builtin.testDerrorMessage "Negative modulus" + +Stdlib.Int32.power_v0 2l 3l = 8l +Stdlib.Int32.power_v0 0l 1l = 0l +Stdlib.Int32.power_v0 1l 0l = 1l +Stdlib.Int32.power_v0 0l 0l = 1l +Stdlib.Int32.power_v0 -2l 5l = -32l +Stdlib.Int32.power_v0 -1l 5l = -1l +Stdlib.Int32.power_v0 -1l 6l = 1l +Stdlib.Int32.power_v0 1l 2147483647l = 1l +// Stdlib.Int32.power_v0 2l 31l = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int32.power_v0 120l 20l = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int32.power_v0 2l -3l = Builtin.testDerrorMessage "Negative exponent" + + +Stdlib.Int32.greaterThan_v0 20l 1l = true + +Stdlib.Int32.greaterThanOrEqualTo_v0 0l 1l = false +Stdlib.Int32.greaterThanOrEqualTo_v0 1l 0l = true +Stdlib.Int32.greaterThanOrEqualTo_v0 6l 1l = true +Stdlib.Int32.greaterThanOrEqualTo_v0 6l 8l = false +Stdlib.Int32.greaterThanOrEqualTo_v0 -5l -20l = true +Stdlib.Int32.greaterThanOrEqualTo_v0 -20l -1l = false +Stdlib.Int32.greaterThanOrEqualTo_v0 -20l -20l = true + +Stdlib.Int32.lessThanOrEqualTo_v0 6l 8l = true +Stdlib.Int32.lessThanOrEqualTo_v0 10l 1l = false +Stdlib.Int32.lessThanOrEqualTo_v0 0l 1l = true +Stdlib.Int32.lessThanOrEqualTo_v0 1l 0l = false +Stdlib.Int32.lessThanOrEqualTo_v0 -100l 22544l = true +Stdlib.Int32.lessThanOrEqualTo_v0 -999l -9999l = false +Stdlib.Int32.lessThanOrEqualTo_v0 -8888l -8888l = true + +Stdlib.Int32.lessThan_v0 6l 8l = true +Stdlib.Int32.lessThan_v0 10l 1l = false +Stdlib.Int32.lessThan_v0 0l 1l = true +Stdlib.Int32.lessThan_v0 1l 0l = false +Stdlib.Int32.lessThan_v0 -100l 22544l = true +Stdlib.Int32.lessThan_v0 -999l -9999l = false +Stdlib.Int32.lessThan_v0 -8888l -8888l = false + +Stdlib.Int32.sqrt_v0 4l = 2.0 +Stdlib.Int32.sqrt_v0 100l = 10.0 +Stdlib.Int32.sqrt_v0 86l = 9.273618495495704 + +Stdlib.Int32.toFloat_v0 2l = 2.0 +Stdlib.Int32.toFloat_v0 955656l = 955656.0 +Stdlib.Int32.toFloat_v0 -10l = -10.0 + +Stdlib.Int32.add_v0 10l 9l = 19l +Stdlib.Int32.add_v0 88l 9l = 97l +Stdlib.Int32.add_v0 -1l 2l = 1l +Stdlib.Int32.add_v0 1l 0l = 1l +Stdlib.Int32.add_v0 -55l 55l = 0l +Stdlib.Int32.add_v0 2147483646l 1l = 2147483647l + +// Overflow tests +Stdlib.Int32.add_v0 2147483647l 1l = -2147483648l +Stdlib.Int32.add_v0 55l 2147483647l = -2147483594l +Stdlib.Int32.add_v0 -2147483648l -1l = 2147483647l + + +Stdlib.Int32.subtract_v0 10l 9l = 1l +Stdlib.Int32.subtract_v0 88l 9l = 79l +Stdlib.Int32.subtract_v0 0l 1l = -1l +Stdlib.Int32.subtract_v0 1l 0l = 1l +Stdlib.Int32.subtract_v0 -55l -55l = 0l + +Stdlib.Int32.multiply_v0 8l 8l = 64l +Stdlib.Int32.multiply_v0 5145l 5145l = 26471025l + +Stdlib.Int32.divide_v0 10l 5l = 2l +Stdlib.Int32.divide_v0 17l 3l = 5l +Stdlib.Int32.divide_v0 -8l 5l = -1l +Stdlib.Int32.divide_v0 0l 1l = 0l + +// Stdlib.Int32.divide_v0 1l 0l = Builtin.testDerrorMessage "Division by zero" + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 1l 2l) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int32.greaterThanOrEqualTo x 1l) +// && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 10l 20l) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int32.greaterThanOrEqualTo x 10l) +// && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 2l 1l) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int32.greaterThanOrEqualTo x 1l) +// && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 20l 10l) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int32.greaterThanOrEqualTo x 10l) +// && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 1l) +// |> Stdlib.List.unique_v0) = [ 0l; 1l ] + + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 2l) +// |> Stdlib.List.unique_v0) = [ 0l; 1l; 2l ] + + +//Stdlib.Int32.sum_v0 [ 1l; 2l ] = 3l + +// Stdlib.Int32.parse_v0 "0" = Stdlib.Result.Result.Ok 0l +// Stdlib.Int32.parse_v0 "1" = Stdlib.Result.Result.Ok 1l +// Stdlib.Int32.parse_v0 " 1" = Stdlib.Result.Result.Ok 1l +// Stdlib.Int32.parse_v0 "1 " = Stdlib.Result.Result.Ok 1l +// Stdlib.Int32.parse_v0 "+1" = Stdlib.Result.Result.Ok 1l +// Stdlib.Int32.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1l +// Stdlib.Int32.parse_v0 "-1" = Stdlib.Result.Result.Ok -1l +// Stdlib.Int32.parse_v0 "078" = Stdlib.Result.Result.Ok 78l // "octal" format ignored +// Stdlib.Int32.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1l +// Stdlib.Int32.parse_v0 "-10001" = Stdlib.Result.Result.Ok -10001l +// Stdlib.Int32.parse_v0 "-2147483648" = Stdlib.Result.Result.Ok -2147483648l +// Stdlib.Int32.parse_v0 "2147483647" = Stdlib.Result.Result.Ok 2147483647l +// Stdlib.Int32.parse_v0 "2147483648" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.OutOfRange +// Stdlib.Int32.parse_v0 "-2147483649" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.OutOfRange +// Stdlib.Int32.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat +// Stdlib.Int32.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.Int32.ParseError.BadFormat + + +// Stdlib.Int32.toString 0l = "0" +// Stdlib.Int32.toString 1l = "1" +// Stdlib.Int32.toString -1l = "-1" +// Stdlib.Int32.toString -2147483648l = "-2147483648" // Int32 lower limit +// Stdlib.Int32.toString 2147483647l = "2147483647" // Int32 upper limit + +// Stdlib.Int32.fromInt8_v0 0y = 0l +// Stdlib.Int32.fromInt8_v0 1y = 1l +// Stdlib.Int32.fromInt8_v0 127y = 127l +// Stdlib.Int32.fromInt8_v0 (-128y) = -128l + +// Stdlib.Int32.fromUInt8_v0 0uy = 0l +// Stdlib.Int32.fromUInt8_v0 1uy = 1l +// Stdlib.Int32.fromUInt8_v0 255uy = 255l + +// Stdlib.Int32.fromInt16_v0 0s = 0l +// Stdlib.Int32.fromInt16_v0 1s = 1l +// Stdlib.Int32.fromInt16_v0 32767s = 32767l +// Stdlib.Int32.fromInt16_v0 (-32768s) = -32768l + +// Stdlib.Int32.fromUInt16_v0 0us = 0l +// Stdlib.Int32.fromUInt16_v0 1us = 1l +// Stdlib.Int32.fromUInt16_v0 65535us = 65535l + +// Stdlib.Int32.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0l +// Stdlib.Int32.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1l +// Stdlib.Int32.fromUInt32_v0 4294967295ul = Stdlib.Option.Option.None + +// Stdlib.Int32.fromInt64_v0 0L = Stdlib.Option.Option.Some 0l +// Stdlib.Int32.fromInt64_v0 1L = Stdlib.Option.Option.Some 1l +// Stdlib.Int32.fromInt64_v0 2147483647L = Stdlib.Option.Option.Some 2147483647l +// Stdlib.Int32.fromInt64_v0 2147483648L = Stdlib.Option.Option.None +// Stdlib.Int32.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1l +// Stdlib.Int32.fromInt64_v0 (-2147483648L) = Stdlib.Option.Option.Some -2147483648l +// Stdlib.Int32.fromInt64_v0 (-2147483649L) = Stdlib.Option.Option.None + +// Stdlib.Int32.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0l +// Stdlib.Int32.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1l +// Stdlib.Int32.fromUInt64_v0 2147483647UL = Stdlib.Option.Option.Some 2147483647l +// Stdlib.Int32.fromUInt64_v0 2147483648UL = Stdlib.Option.Option.None + +// Stdlib.Int32.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0l +// Stdlib.Int32.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1l +// Stdlib.Int32.fromInt128_v0 2147483647Q = Stdlib.Option.Option.Some 2147483647l +// Stdlib.Int32.fromInt128_v0 2147483648Q = Stdlib.Option.Option.None +// Stdlib.Int32.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1l +// Stdlib.Int32.fromInt128_v0 (-2147483648Q) = Stdlib.Option.Option.Some -2147483648l +// Stdlib.Int32.fromInt128_v0 (-2147483649Q) = Stdlib.Option.Option.None + +// Stdlib.Int32.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0l +// Stdlib.Int32.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1l +// Stdlib.Int32.fromUInt128_v0 2147483647Z = Stdlib.Option.Option.Some 2147483647l +// Stdlib.Int32.fromUInt128_v0 2147483648Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/int64.dark b/backend/testfiles/execution/stdlib/ints/int64.dark new file mode 100644 index 0000000000..d3906e66cf --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/int64.dark @@ -0,0 +1,369 @@ +Stdlib.Int64.absoluteValue_v0 -5L = 5L +Stdlib.Int64.absoluteValue_v0 5L = 5L + +Stdlib.Int64.max_v0 5L 6L = 6L +Stdlib.Int64.max_v0 10L 1L = 10L +Stdlib.Int64.max_v0 -5L 6L = 6L +Stdlib.Int64.max_v0 -100L -20000L = -100L +Stdlib.Int64.max_v0 250L -26L = 250L + +Stdlib.Int64.min_v0 5L 6L = 5L +Stdlib.Int64.min_v0 50L -10L = -10L +Stdlib.Int64.min_v0 -5L 6L = -5L +Stdlib.Int64.min_v0 -100L -20000L = -20000L +Stdlib.Int64.min_v0 250L -26L = -26L + +Stdlib.Int64.clamp_v0 -5L -2L 5L = -2L // in bounds +Stdlib.Int64.clamp_v0 -3L -2L 1L = -2L // below min +Stdlib.Int64.clamp_v0 -5L 1L 1L = 1L // at limit +Stdlib.Int64.clamp_v0 1L 2L 1L = 1L // above max +Stdlib.Int64.clamp_v0 3L 0L 2L = 2L // below in +Stdlib.Int64.clamp_v0 -100L 0L 0L = 0L +Stdlib.Int64.clamp_v0 100L 0L 0L = 0L +Stdlib.Int64.clamp_v0 -100L 0L -1L = -1L +Stdlib.Int64.clamp_v0 100L 0L -1L = 0L +Stdlib.Int64.clamp_v0 -100L -1L 0L = -1L +Stdlib.Int64.clamp_v0 100L -1L 0L = 0L +Stdlib.Int64.clamp_v0 -100L 1L 0L = 0L +Stdlib.Int64.clamp_v0 100L 1L 0L = 1L +Stdlib.Int64.clamp_v0 -2147483647L 250L -26L = -26L +Stdlib.Int64.clamp_v0 2147483647L 250L -26L = 250L + +Stdlib.Int64.negate_v0 -5L = 5L +Stdlib.Int64.negate_v0 5L = -5L +Stdlib.Int64.negate_v0 0L = 0L +Stdlib.Int64.negate_v0 -0L = 0L + +// Stdlib.Int64.remainder_v0 15L 6L = Stdlib.Result.Result.Ok 3L +// Stdlib.Int64.remainder_v0 20L 8L = Stdlib.Result.Result.Ok 4L +// Stdlib.Int64.remainder_v0 -20L 8L = Stdlib.Result.Result.Ok -4L +// Stdlib.Int64.remainder_v0 -20L -8L = Stdlib.Result.Result.Ok -4L +// Stdlib.Int64.remainder_v0 -15L 6L = Stdlib.Result.Result.Ok -3L +// Stdlib.Int64.remainder_v0 5L 0L = Builtin.testDerrorMessage "Division by zero" + +// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> +// Stdlib.Int64.remainder_v0 v -4L) = [ Stdlib.Result.Result.Ok -1L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok -3L +// Stdlib.Result.Result.Ok -2L +// Stdlib.Result.Result.Ok -1L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok 1L +// Stdlib.Result.Result.Ok 2L +// Stdlib.Result.Result.Ok 3L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok 1L ] + +// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> +// Stdlib.Int64.remainder_v0 v 4L) = [ Stdlib.Result.Result.Ok -1L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok -3L +// Stdlib.Result.Result.Ok -2L +// Stdlib.Result.Result.Ok -1L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok 1L +// Stdlib.Result.Result.Ok 2L +// Stdlib.Result.Result.Ok 3L +// Stdlib.Result.Result.Ok 0L +// Stdlib.Result.Result.Ok 1L ] + +Stdlib.Int64.mod_v0 15L 5L = 0L +Stdlib.Int64.mod_v0 15L 6L = 3L +Stdlib.Int64.mod_v0 0L 15L = 0L +Stdlib.Int64.mod_v0 -1L 2L = 1L +Stdlib.Int64.mod_v0 -754L 53L = 41L +Stdlib.Int64.mod_v0 9999999999998L 3L = 2L + +// Stdlib.Int64.mod_v0 5L 0L = Builtin.testDerrorMessage "Zero modulus" + +// Stdlib.Int64.mod_v0 5L -5L = Builtin.testDerrorMessage "Negative modulus" + +// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> +// Stdlib.Int64.mod_v0 v 4L) = [ 3L 0L 1L 2L 3L 0L 1L 2L 3L 0L 1L ] + +15L % 5L = 0L +// 5L % 0L = Builtin.testDerrorMessage "Zero modulus" +// 5L % -5L = Builtin.testDerrorMessage "Negative modulus" + +// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> v % 4L) = [ 3L +// 0L +// 1L +// 2L +// 3L +// 0L +// 1L +// 2L +// 3L +// 0L +// 1L ] + +Stdlib.Int64.power_v0 8L 5L = 32768L +Stdlib.Int64.power_v0 0L 1L = 0L +Stdlib.Int64.power_v0 0L 0L = 1L +Stdlib.Int64.power_v0 1L 0L = 1L +Stdlib.Int64.power_v0 1000L 0L = 1L +Stdlib.Int64.power_v0 -8L 5L = -32768L +//Stdlib.Int64.power_v0 200L 20L = Builtin.testDerrorMessage "Out of range" +Stdlib.Int64.power_v0 200L 7L = 12800000000000000L +Stdlib.Int64.power_v0 1L 2147483649L = 1L +Stdlib.Int64.power_v0 -1L 2147483649L = -1L +//Stdlib.Int64.power_v0 2L -3L = Builtin.testDerrorMessage "Negative exponent" + +5L ^ 2L = 25L +-8L ^ 5L = -32768L +50L ^ 2L = 2500L + +Stdlib.Int64.greaterThan_v0 20L 1L = true +20L > 1L = true + +0L >= 1L = false +1L >= 0L = true +6L >= 1L = true +6L >= 8L = false +-5L >= -20L = true +-20L >= -1L = false +-20L >= -20L = true + +Stdlib.Int64.greaterThanOrEqualTo_v0 0L 1L = false +Stdlib.Int64.greaterThanOrEqualTo_v0 1L 0L = true +Stdlib.Int64.greaterThanOrEqualTo_v0 6L 1L = true +Stdlib.Int64.greaterThanOrEqualTo_v0 6L 8L = false +Stdlib.Int64.greaterThanOrEqualTo_v0 -5L -20L = true +Stdlib.Int64.greaterThanOrEqualTo_v0 -20L -1L = false +Stdlib.Int64.greaterThanOrEqualTo_v0 -20L -20L = true + +6L <= 8L = true +10L <= 1L = false +0L <= 1L = true +1L <= 0L = false +-100L <= 22544L = true +-999L <= -9999L = false +-8888L <= -8888L = true + +Stdlib.Int64.lessThanOrEqualTo_v0 6L 8L = true +Stdlib.Int64.lessThanOrEqualTo_v0 10L 1L = false +Stdlib.Int64.lessThanOrEqualTo_v0 0L 1L = true +Stdlib.Int64.lessThanOrEqualTo_v0 1L 0L = false +Stdlib.Int64.lessThanOrEqualTo_v0 -100L 22544L = true +Stdlib.Int64.lessThanOrEqualTo_v0 -999L -9999L = false +Stdlib.Int64.lessThanOrEqualTo_v0 -8888L -8888L = true + +Stdlib.Int64.lessThan_v0 6L 8L = true +Stdlib.Int64.lessThan_v0 10L 1L = false +Stdlib.Int64.lessThan_v0 0L 1L = true +Stdlib.Int64.lessThan_v0 1L 0L = false +Stdlib.Int64.lessThan_v0 -100L 22544L = true +Stdlib.Int64.lessThan_v0 -999L -9999L = false +Stdlib.Int64.lessThan_v0 -8888L -8888L = false +6L < 8L = true +10L < 1L = false +0L < 1L = true +1L < 0L = false +-100L < 22544L = true +-999L < -9999L = false +-8888L < -8888L = false + +Stdlib.Int64.sqrt_v0 4L = 2.0 +Stdlib.Int64.sqrt_v0 100L = 10.0 +Stdlib.Int64.sqrt_v0 86L = 9.273618495495704 + +Stdlib.Int64.toFloat_v0 2L = 2.0 +Stdlib.Int64.toFloat_v0 955656L = 955656.0 +Stdlib.Int64.toFloat_v0 -10L = -10.0 + +Stdlib.Int64.add_v0 10L 9L = 19L +Stdlib.Int64.add_v0 88L 9L = 97L +Stdlib.Int64.add_v0 -1L 2L = 1L +Stdlib.Int64.add_v0 1L 0L = 1L +Stdlib.Int64.add_v0 -55L 55L = 0L +Stdlib.Int64.add_v0 9223372036854775806L 1L = 9223372036854775807L + +// Overflow tests +Stdlib.Int64.add_v0 9223372036854775807L 1L = -9223372036854775808L +Stdlib.Int64.add_v0 55L 9223372036854775807L = -9223372036854775754L +Stdlib.Int64.add_v0 (-9223372036854775808L) (-1L) = 9223372036854775807L + +-2000L + 1950L = -50L +-1993L + 2000L = 7L + +Stdlib.Int64.subtract_v0 10L 9L = 1L +Stdlib.Int64.subtract_v0 88L 9L = 79L +Stdlib.Int64.subtract_v0 0L 1L = -1L +Stdlib.Int64.subtract_v0 1L 0L = 1L +Stdlib.Int64.subtract_v0 -55L -55L = 0L + +2000L - 1950L = 50L +-1993L - -2000L = 7L + +Stdlib.Int64.multiply_v0 8L 8L = 64L +Stdlib.Int64.multiply_v0 5145L 5145L = 26471025L + +// 1L * 1.0 = Builtin.testDerrorMessage +// "int64Multiply's 2nd argument (`b`) should be an Int64. However, a Float (1.0) was passed instead. + +// Expected: (b: Int64) +// Actual: a Float: 1.0" + +8L * 8L = 64L +Stdlib.Int64.divide_v0 10L 5L = 2L +Stdlib.Int64.divide_v0 17L 3L = 5L +Stdlib.Int64.divide_v0 -8L 5L = -1L +Stdlib.Int64.divide_v0 0L 1L = 0L + +// Stdlib.Int64.divide_v0 1L 0L = Builtin.testDerrorMessage "Division by zero" + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 1L 2L) +// |> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true +// true +// true +// true +// true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 10L 20L) +// |> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true +// true +// true +// true +// true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 2L 1L) +// |> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true +// true +// true +// true +// true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 20L 10L) +// |> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true +// true +// true +// true +// true ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 1L) +// |> Stdlib.List.unique_v0) = [ 0L; 1L ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 2L) +// |> Stdlib.List.unique_v0) = [ 0L; 1L; 2L ] + +//Stdlib.Int64.sum_v0 [ 1L; 2L ] = 3L + +// Stdlib.Int64.parse_v0 "0" = Stdlib.Result.Result.Ok 0L +// Stdlib.Int64.parse_v0 "1" = Stdlib.Result.Result.Ok 1L +// Stdlib.Int64.parse_v0 " 1" = Stdlib.Result.Result.Ok 1L +// Stdlib.Int64.parse_v0 "1 " = Stdlib.Result.Result.Ok 1L +// Stdlib.Int64.parse_v0 "+1" = Stdlib.Result.Result.Ok 1L +// Stdlib.Int64.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1L +// Stdlib.Int64.parse_v0 "-1" = Stdlib.Result.Result.Ok -1L +// Stdlib.Int64.parse_v0 "078" = Stdlib.Result.Result.Ok 78L // "octal" format ignored +// Stdlib.Int64.parse_v0 "-00001" = Stdlib.Result.Result.Ok -1L +// Stdlib.Int64.parse_v0 "-10001" = Stdlib.Result.Result.Ok -10001L +// Stdlib.Int64.parse_v0 "-4611686018427387904" = Stdlib.Result.Result.Ok +// -4611686018427387904L // int63 lower limit +// Stdlib.Int64.parse_v0 "-4611686018427387905" = Stdlib.Result.Result.Ok +// -4611686018427387905L // past the int63 upper limit +// Stdlib.Int64.parse_v0 "-9223372036854775808" = Stdlib.Result.Result.Ok +// -9223372036854775808L // .NET lower limit +// Stdlib.Int64.parse_v0 "-9223372036854775809" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.OutOfRange +// Stdlib.Int64.parse_v0 "4611686018427387903" = Stdlib.Result.Result.Ok +// 4611686018427387903L // int63 upper limit +// Stdlib.Int64.parse_v0 "4611686018427387904" = Stdlib.Result.Result.Ok +// 4611686018427387904L // past the int63 upper limit +// Stdlib.Int64.parse_v0 "9223372036854775807" = Stdlib.Result.Result.Ok +// 9223372036854775807L // .NET upper limit +// Stdlib.Int64.parse_v0 "9223372036854775808" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.OutOfRange +// Stdlib.Int64.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "9223372036854775808" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.OutOfRange +// Stdlib.Int64.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat +// Stdlib.Int64.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.Int64.ParseError.BadFormat + + +Stdlib.Int64.toString 0L = "0" +Stdlib.Int64.toString 1L = "1" +Stdlib.Int64.toString -1L = "-1" +Stdlib.Int64.toString -4611686018427387904L = "-4611686018427387904" // int63 lower limit +Stdlib.Int64.toString -4611686018427387905L = "-4611686018427387905" // past the int63 upper limit" +Stdlib.Int64.toString -9223372036854775808L = "-9223372036854775808" // .NET lower limit +Stdlib.Int64.toString 4611686018427387903L = "4611686018427387903" // int63 upper limit +Stdlib.Int64.toString 4611686018427387904L = "4611686018427387904" // past the int63 upper limit +Stdlib.Int64.toString 9223372036854775807L = "9223372036854775807" // .NET upper limit + +// Stdlib.Int64.fromInt8_v0 0y = 0L +// Stdlib.Int64.fromInt8_v0 1y = 1L +// Stdlib.Int64.fromInt8_v0 127y = 127L +// Stdlib.Int64.fromInt8_v0 -128y = -128L + +// Stdlib.Int64.fromUInt8_v0 0uy = 0L +// Stdlib.Int64.fromUInt8_v0 1uy = 1L +// Stdlib.Int64.fromUInt8_v0 255uy = 255L + +// Stdlib.Int64.fromInt16_v0 0s = 0L +// Stdlib.Int64.fromInt16_v0 1s = 1L +// Stdlib.Int64.fromInt16_v0 32767s = 32767L +// Stdlib.Int64.fromInt16_v0 -32768s = -32768L + +// Stdlib.Int64.fromUInt16_v0 0us = 0L +// Stdlib.Int64.fromUInt16_v0 1us = 1L +// Stdlib.Int64.fromUInt16_v0 65535us = 65535L + +// Stdlib.Int64.fromInt32_v0 0l = 0L +// Stdlib.Int64.fromInt32_v0 1l = 1L +// Stdlib.Int64.fromInt32_v0 2147483647l = 2147483647L +// Stdlib.Int64.fromInt32_v0 -2147483648l = -2147483648L + +// Stdlib.Int64.fromUInt32_v0 0ul = 0L +// Stdlib.Int64.fromUInt32_v0 1ul = 1L +// Stdlib.Int64.fromUInt32_v0 4294967295ul = 4294967295L + +// Stdlib.Int64.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0L +// Stdlib.Int64.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1L +// Stdlib.Int64.fromUInt64_v0 9223372036854775807UL = Stdlib.Option.Option.Some +// 9223372036854775807L +// Stdlib.Int64.fromUInt64_v0 18446744073709551615UL = Stdlib.Option.Option.None + +// Stdlib.Int64.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0L +// Stdlib.Int64.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1L +// Stdlib.Int64.fromInt128_v0 9223372036854775807Q = Stdlib.Option.Option.Some +// 9223372036854775807L +// Stdlib.Int64.fromInt128_v0 -9223372036854775808Q = Stdlib.Option.Option.Some +// -9223372036854775808L +// Stdlib.Int64.fromInt128_v0 9223372036854775808Q = Stdlib.Option.Option.None +// Stdlib.Int64.fromInt128_v0 -9223372036854775809Q = Stdlib.Option.Option.None + +// Stdlib.Int64.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0L +// Stdlib.Int64.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1L +// Stdlib.Int64.fromUInt128_v0 9223372036854775807Z = Stdlib.Option.Option.Some +// 9223372036854775807L +// Stdlib.Int64.fromUInt128_v0 18446744073709551615Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/int8.dark b/backend/testfiles/execution/stdlib/ints/int8.dark new file mode 100644 index 0000000000..077e18f03c --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/int8.dark @@ -0,0 +1,307 @@ +Stdlib.Int8.absoluteValue_v0 -5y = 5y +Stdlib.Int8.absoluteValue_v0 5y = 5y + +//Stdlib.Int8.absoluteValue_v0 -128y = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int8.max_v0 5y 6y = 6y +Stdlib.Int8.max_v0 10y 1y = 10y +Stdlib.Int8.max_v0 -5y 6y = 6y +Stdlib.Int8.max_v0 127y -128y = 127y + +Stdlib.Int8.min_v0 5y 6y = 5y +Stdlib.Int8.min_v0 50y -10y = -10y +Stdlib.Int8.min_v0 -5y 6y = -5y +Stdlib.Int8.min_v0 127y -128y = -128y + + +Stdlib.Int8.clamp_v0 -5y -2y 5y = -2y +Stdlib.Int8.clamp_v0 -3y -2y 1y = -2y +Stdlib.Int8.clamp_v0 -5y 1y 1y = 1y +Stdlib.Int8.clamp_v0 1y 2y 1y = 1y +Stdlib.Int8.clamp_v0 3y 0y 2y = 2y +Stdlib.Int8.clamp_v0 -100y 0y 0y = 0y +Stdlib.Int8.clamp_v0 100y 0y 0y = 0y +Stdlib.Int8.clamp_v0 -100y 0y -1y = -1y +Stdlib.Int8.clamp_v0 100y 0y -1y = 0y +Stdlib.Int8.clamp_v0 -100y -1y 0y = -1y +Stdlib.Int8.clamp_v0 -100y 1y 0y = 0y +Stdlib.Int8.clamp_v0 100y 1y 0y = 1y + +Stdlib.Int8.negate_v0 -5y = 5y +Stdlib.Int8.negate_v0 5y = -5y +Stdlib.Int8.negate_v0 0y = 0y +Stdlib.Int8.negate_v0 -0y = 0y +//Stdlib.Int8.negate_v0 -128y = Builtin.testDerrorMessage "Out of range" + +// Stdlib.Int8.remainder_v0 15y 6y = Stdlib.Result.Result.Ok 3y +// Stdlib.Int8.remainder_v0 20y 8y = Stdlib.Result.Result.Ok 4y +// Stdlib.Int8.remainder_v0 -20y 8y = Stdlib.Result.Result.Ok -4y +// Stdlib.Int8.remainder_v0 -20y -8y = Stdlib.Result.Result.Ok -4y +// Stdlib.Int8.remainder_v0 -15y 6y = Stdlib.Result.Result.Ok -3y +//Stdlib.Int8.remainder_v0 5y 0y = Builtin.testDerrorMessage "Division by zero" + + +Stdlib.Int8.add_v0 10y 9y = 19y +Stdlib.Int8.add_v0 10y 0y = 10y +Stdlib.Int8.add_v0 88y 9y = 97y +Stdlib.Int8.add_v0 -1y 2y = 1y +Stdlib.Int8.add_v0 1y 0y = 1y +Stdlib.Int8.add_v0 -55y 55y = 0y +Stdlib.Int8.add_v0 55y 55y = 110y +Stdlib.Int8.add_v0 PACKAGE.Darklang.Test.Constants.int8Const 5y = 10y +// Stdlib.Int8.add_v0 127y 1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 -100y -30y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.add_v0 100y 30y = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int8.subtract_v0 10y 9y = 1y +Stdlib.Int8.subtract_v0 88y 9y = 79y +Stdlib.Int8.subtract_v0 0y 1y = -1y +Stdlib.Int8.subtract_v0 1y 0y = 1y +Stdlib.Int8.subtract_v0 -55y -55y = 0y +// Stdlib.Int8.subtract_v0 -2y 127y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.subtract_v0 -55y 100y = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int8.multiply_v0 8y 8y = 64y +Stdlib.Int8.multiply_v0 1y 0y = 0y +// Stdlib.Int8.multiply_v0 64y 2y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.multiply_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int8.power_v0 2y 3y = 8y +Stdlib.Int8.power_v0 0y 1y = 0y +Stdlib.Int8.power_v0 1y 0y = 1y +Stdlib.Int8.power_v0 0y 0y = 1y +Stdlib.Int8.power_v0 -2y 5y = -32y +Stdlib.Int8.power_v0 -1y 5y = -1y +Stdlib.Int8.power_v0 -1y 6y = 1y +Stdlib.Int8.power_v0 1y 127y = 1y +// Stdlib.Int8.power_v0 3y 5y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.power_v0 120y 20y = Builtin.testDerrorMessage "Out of range" +// Stdlib.Int8.power_v0 2y -3y = Builtin.testDerrorMessage "Negative exponent" + +Stdlib.Int8.divide_v0 10y 5y = 2y +Stdlib.Int8.divide_v0 17y 3y = 5y +Stdlib.Int8.divide_v0 -8y 5y = -1y +Stdlib.Int8.divide_v0 0y 1y = 0y +// Stdlib.Int8.divide_v0 1y 0y = Builtin.testDerrorMessage "Division by zero" +// Stdlib.Int8.divide_v0 -128y -1y = Builtin.testDerrorMessage "Out of range" + +Stdlib.Int8.greaterThan_v0 20y 1y = true +Stdlib.Int8.greaterThan_v0 20y 127y = false + +Stdlib.Int8.greaterThanOrEqualTo_v0 0y 1y = false +Stdlib.Int8.greaterThanOrEqualTo_v0 1y 0y = true +Stdlib.Int8.greaterThanOrEqualTo_v0 6y 1y = true +Stdlib.Int8.greaterThanOrEqualTo_v0 6y 8y = false +Stdlib.Int8.greaterThanOrEqualTo_v0 -5y -20y = true +Stdlib.Int8.greaterThanOrEqualTo_v0 -20y -1y = false +Stdlib.Int8.greaterThanOrEqualTo_v0 -20y -20y = true +Stdlib.Int8.greaterThanOrEqualTo_v0 -128y -20y = false + +Stdlib.Int8.lessThanOrEqualTo_v0 6y 8y = true +Stdlib.Int8.lessThanOrEqualTo_v0 10y 1y = false +Stdlib.Int8.lessThanOrEqualTo_v0 0y 1y = true +Stdlib.Int8.lessThanOrEqualTo_v0 1y 0y = false + +Stdlib.Int8.lessThan_v0 -128y 127y = true +Stdlib.Int8.lessThan_v0 6y 8y = true +Stdlib.Int8.lessThan_v0 10y 1y = false +Stdlib.Int8.lessThan_v0 0y 1y = true +Stdlib.Int8.lessThan_v0 1y 0y = false +Stdlib.Int8.lessThan_v0 -128y 127y = true + +Stdlib.Int8.toString 0y = "0" +Stdlib.Int8.toString 1y = "1" +Stdlib.Int8.toString -1y = "-1" +Stdlib.Int8.toString -128y = "-128" // Int8 lower limit +Stdlib.Int8.toString 127y = "127" // Int8 upper limit + +Stdlib.Int8.toFloat_v0 2y = 2.0 +Stdlib.Int8.toFloat_v0 127y = 127.0 +Stdlib.Int8.toFloat_v0 -128y = -128.0 +Stdlib.Int8.toFloat_v0 -10y = -10.0 + +Stdlib.Int8.sqrt_v0 4y = 2.0 +Stdlib.Int8.sqrt_v0 100y = 10.0 +Stdlib.Int8.sqrt_v0 86y = 9.273618495495704 + +Stdlib.Int8.mod_v0 15y 5y = 0y +Stdlib.Int8.mod_v0 15y 6y = 3y +Stdlib.Int8.mod_v0 0y 15y = 0y +Stdlib.Int8.mod_v0 -1y 2y = 1y +Stdlib.Int8.mod_v0 -128y 53y = 31y +Stdlib.Int8.mod_v0 127y 3y = 1y +// Stdlib.Int8.mod_v0 5y 0y = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.Int8.mod_v0 5y -5y = Builtin.testDerrorMessage "Negative modulus" + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 1y 2y) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true +// true +// true +// true +// true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 10y 20y) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int8.greaterThanOrEqualTo x 10y) +// && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 2y 1y) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true +// true +// true +// true +// true ] + +// (Stdlib.List.range_v0 1L 5L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 20y 10y) +// |> Stdlib.List.map_v0 (fun x -> +// (Stdlib.Int8.greaterThanOrEqualTo x 10y) +// && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 1y) +// |> Stdlib.List.unique_v0) = [ 0y; 1y ] + + +// ((Stdlib.List.range_v0 1L 100L) +// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 2y) +// |> Stdlib.List.unique_v0) = [ 0y; 1y; 2y ] + + +// Stdlib.Int8.parse_v0 "0" = Stdlib.Result.Result.Ok(0y) + +// Stdlib.Int8.parse_v0 "1" = Stdlib.Result.Result.Ok(1y) + +// Stdlib.Int8.parse_v0 " 1" = Stdlib.Result.Result.Ok(1y) + +// Stdlib.Int8.parse_v0 "1 " = Stdlib.Result.Result.Ok(1y) + +// Stdlib.Int8.parse_v0 "+1" = Stdlib.Result.Result.Ok(1y) + +// Stdlib.Int8.parse_v0 " +1 " = Stdlib.Result.Result.Ok(1y) + +// Stdlib.Int8.parse_v0 "-1" = Stdlib.Result.Result.Ok(-1y) + +// Stdlib.Int8.parse_v0 "078" = Stdlib.Result.Result.Ok(78y) // "octal" format ignored + +// Stdlib.Int8.parse_v0 "-00001" = Stdlib.Result.Result.Ok(-1y) + +// Stdlib.Int8.parse_v0 "-10001" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.OutOfRange + +// Stdlib.Int8.parse_v0 "127" = Stdlib.Result.Result.Ok(127y) + +// Stdlib.Int8.parse_v0 "-128" = Stdlib.Result.Result.Ok(-128y) + +// Stdlib.Int8.parse_v0 "128" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.OutOfRange + +// Stdlib.Int8.parse_v0 "-129" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.OutOfRange + +// Stdlib.Int8.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "" = Stdlib.Result.Result.Error Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + +// Stdlib.Int8.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.Int8.ParseError.BadFormat + + +// Stdlib.Int8.fromUInt8_v0 0uy = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromUInt8_v0 1uy = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromUInt8_v0 127uy = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromUInt8_v0 128uy = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt8_v0 255uy = Stdlib.Option.Option.None + +// Stdlib.Int8.fromInt16_v0 0s = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromInt16_v0 1s = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromInt16_v0 127s = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromInt16_v0 128s = Stdlib.Option.Option.None +// Stdlib.Int8.fromInt16_v0 (-1s) = Stdlib.Option.Option.Some -1y +// Stdlib.Int8.fromInt16_v0 (-128s) = Stdlib.Option.Option.Some -128y +// Stdlib.Int8.fromInt16_v0 (-129s) = Stdlib.Option.Option.None + +// Stdlib.Int8.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromUInt16_v0 127us = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromUInt16_v0 128us = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt16_v0 255us = Stdlib.Option.Option.None + +// Stdlib.Int8.fromInt32_v0 0l = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromInt32_v0 1l = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromInt32_v0 127l = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromInt32_v0 128l = Stdlib.Option.Option.None +// Stdlib.Int8.fromInt32_v0 (-1l) = Stdlib.Option.Option.Some -1y +// Stdlib.Int8.fromInt32_v0 (-128l) = Stdlib.Option.Option.Some -128y +// Stdlib.Int8.fromInt32_v0 (-129l) = Stdlib.Option.Option.None +// Stdlib.Int8.fromInt32_v0 2147483647l = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromUInt32_v0 127ul = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromUInt32_v0 128ul = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt32_v0 4294967295ul = Stdlib.Option.Option.None + +// Stdlib.Int8.fromInt64_v0 0L = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromInt64_v0 1L = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromInt64_v0 127L = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromInt64_v0 128L = Stdlib.Option.Option.None +// Stdlib.Int8.fromInt64_v0 (-1L) = Stdlib.Option.Option.Some -1y +// Stdlib.Int8.fromInt64_v0 (-128L) = Stdlib.Option.Option.Some -128y +// Stdlib.Int8.fromInt64_v0 (-129L) = Stdlib.Option.Option.None + +// Stdlib.Int8.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromUInt64_v0 127UL = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromUInt64_v0 128UL = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt64_v0 255UL = Stdlib.Option.Option.None + +// Stdlib.Int8.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromInt128_v0 127Q = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromInt128_v0 128Q = Stdlib.Option.Option.None +// Stdlib.Int8.fromInt128_v0 (-1Q) = Stdlib.Option.Option.Some -1y +// Stdlib.Int8.fromInt128_v0 (-128Q) = Stdlib.Option.Option.Some -128y +// Stdlib.Int8.fromInt128_v0 (-129Q) = Stdlib.Option.Option.None + +// Stdlib.Int8.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0y +// Stdlib.Int8.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1y +// Stdlib.Int8.fromUInt128_v0 127Z = Stdlib.Option.Option.Some 127y +// Stdlib.Int8.fromUInt128_v0 128Z = Stdlib.Option.Option.None +// Stdlib.Int8.fromUInt128_v0 255Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/tuple.dark b/backend/testfiles/execution/stdlib/tuple.dark new file mode 100644 index 0000000000..7570c91665 --- /dev/null +++ b/backend/testfiles/execution/stdlib/tuple.dark @@ -0,0 +1,77 @@ +// Tuple2 +Stdlib.Tuple2.create "one" 2L = ("one", 2L) +Stdlib.Tuple2.create 1L "two" = (1L, "two") + +Stdlib.Tuple2.first ("one", 2L) = "one" +Stdlib.Tuple2.first (1L, "two") = 1L +Stdlib.Tuple2.second ("one", 2L) = 2L +Stdlib.Tuple2.second (1L, "two") = "two" + +Stdlib.Tuple2.swap ("one", 2L) = (2L, "one") +Stdlib.Tuple2.swap (1L, "two") = ("two", 1L) + +Stdlib.Tuple2.swap (Stdlib.Tuple2.swap ("two swaps", "back to original")) = ("two swaps", + "back to original") + +// Stdlib.Tuple2.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L) = ("ONE", +// 2L) + +// Stdlib.Tuple2.mapFirst (fun x -> x - 2L) (1L, "two") = (-1L, "two") +// Stdlib.Tuple2.mapSecond (fun x -> x - 2L) ("one", 2L) = ("one", 0L) + +// Stdlib.Tuple2.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two") = (1L, +// "TWO") + +// Stdlib.Tuple2.mapBoth +// (fun x -> Stdlib.String.toUppercase x) +// (fun x -> x - 2L) +// ("one", 2L) = ("ONE", 0L) + +// Stdlib.Tuple2.mapBoth +// (fun x -> x - 2L) +// (fun x -> Stdlib.String.toUppercase x) +// (1L, "two") = (-1L, "TWO") + + +// Tuple3 +Stdlib.Tuple3.create "one" 2L "pi" = ("one", 2L, "pi") +Stdlib.Tuple3.create 1L "two" 3.14 = (1L, "two", 3.14) + +Stdlib.Tuple3.first (1L, "two", 3.14) = 1L +Stdlib.Tuple3.first ("one", 2L, "pi") = "one" +Stdlib.Tuple3.second (1L, "two", 3.14) = "two" +Stdlib.Tuple3.second ("one", 2L, "pi") = 2L +Stdlib.Tuple3.third (1L, "two", 3.14) = 3.14 +Stdlib.Tuple3.third ("one", 2L, "pi") = "pi" + +// Stdlib.Tuple3.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("ONE", +// 2L, +// "pi") + +// Stdlib.Tuple3.mapFirst (fun x -> x - 2L) (1L, "two", 3.14) = (-1L, "two", 3.14) + +// Stdlib.Tuple3.mapSecond (fun x -> x - 2L) ("one", 2L, "pi") = ("one", 0L, "pi") + +// Stdlib.Tuple3.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two", 3.14) = (1L, +// "TWO", +// 3.14) + +// Stdlib.Tuple3.mapThird (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("one", +// 2L, +// "PI") + +// Stdlib.Tuple3.mapThird (fun x -> Stdlib.Float.roundDown_v0 x) (1L, "two", 3.14) = (1L, +// "two", +// 3L) + +// Stdlib.Tuple3.mapAllThree +// (fun x -> Stdlib.String.toUppercase x) +// (fun x -> x - 2L) +// (fun x -> Stdlib.String.toUppercase x) +// ("one", 2L, "pi") = ("ONE", 0L, "PI") + +// Stdlib.Tuple3.mapAllThree +// (fun x -> x - 2L) +// (fun x -> Stdlib.String.toUppercase x) +// (fun x -> Stdlib.Float.roundDown_v0 x) +// (1L, "two", 3.14) = (-1L, "TWO", 3L) \ No newline at end of file From aba7ee3409986e88a2044d02b61162f484012467 Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 26 Sep 2024 09:29:20 -0400 Subject: [PATCH 58/60] commit simplest failing test for fn issue --- backend/testfiles/execution/stdlib/list.dark | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/list.dark index 7af6689535..0c52dceafc 100644 --- a/backend/testfiles/execution/stdlib/list.dark +++ b/backend/testfiles/execution/stdlib/list.dark @@ -1,3 +1,6 @@ +Stdlib.List.map [1L; 2L] (fun x -> x + 1L) = [ 2L; 3L] + + // CLEANUP the following tests should fail on having mixed types //[1; 2.3] = Builtin.testDerrorMessage "Cannot form a list of mixed types - the 2nd element does not match the type of previous elements" //[(1,10);10;(3,30)] = Builtin.testDerrorMessage "Cannot form a list of mixed types ..." @@ -12,7 +15,6 @@ Stdlib.List.append_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 2L; 3L; 4L; 5L; 6L ] - Stdlib.List.append_v0 [ 3L; 4L ] [ 5L; 6L ] = [ 3L; 4L; 5L; 6L ] Stdlib.List.append_v0 [ 1L ] [ 2L ] = [ 1L; 2L ] Stdlib.List.append_v0 [] [] = [] @@ -35,13 +37,9 @@ Stdlib.List.drop_v0 [] 4L = [] // Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage // "If only supports Booleans" - // Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 3L; 4L ] - // Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item >= 1L) = [] - // Stdlib.List.dropWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 5L; 2L; 2L ] - // Stdlib.List.dropWhile_v0 [] (fun item -> item < 3L) = [] Stdlib.List.empty_v0 = [] From 4c11b8bfd0e8ffc864f2fe3a8dd558f892eadb18 Mon Sep 17 00:00:00 2001 From: Ocean Date: Tue, 1 Oct 2024 14:48:04 +0000 Subject: [PATCH 59/60] PT2RT: fix symbols in EMatch, Interpreter: remove some usage of Map.findUnsafe, and uncomment more tests (2200 passing) --- backend/src/LibExecution/Interpreter.fs | 33 +- .../ProgramTypesToRuntimeTypes.fs | 12 +- .../testfiles/execution/language/derror.dark | 2 +- .../testfiles/execution/stdlib/_parser.dark | 158 ------ backend/testfiles/execution/stdlib/_uuid.dark | 25 - .../stdlib/{_alt-json.dark => alt-json.dark} | 130 ++--- .../stdlib/{_date.dark => date.dark} | 2 +- backend/testfiles/execution/stdlib/list.dark | 512 +++++++++--------- .../stdlib/{_option.dark => option.dark} | 36 +- .../testfiles/execution/stdlib/parser.dark | 158 ++++++ backend/testfiles/execution/stdlib/uuid.dark | 25 + backend/tests/Tests/Interpreter.Tests.fs | 14 +- backend/tests/Tests/PT2RT.Tests.fs | 45 +- backend/tests/Tests/TestValues.fs | 40 ++ 14 files changed, 654 insertions(+), 538 deletions(-) delete mode 100644 backend/testfiles/execution/stdlib/_parser.dark delete mode 100644 backend/testfiles/execution/stdlib/_uuid.dark rename backend/testfiles/execution/stdlib/{_alt-json.dark => alt-json.dark} (50%) rename backend/testfiles/execution/stdlib/{_date.dark => date.dark} (99%) rename backend/testfiles/execution/stdlib/{_option.dark => option.dark} (92%) create mode 100644 backend/testfiles/execution/stdlib/parser.dark create mode 100644 backend/testfiles/execution/stdlib/uuid.dark diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index d5d9941fdf..d52f8da478 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -185,8 +185,14 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | Lambda(parentContext, lambdaID) -> let lambda = - Map.findUnsafe (parentContext, lambdaID) vm.lambdaInstrCache + (match Map.tryFind (parentContext, lambdaID) vm.lambdaInstrCache with + | Some l -> l + | None -> + match Map.tryFind (Source, lambdaID) vm.lambdaInstrCache with + | Some l -> l + | None -> raiseRTE (RTE.VariableNotFound "lambda not found")) // TODO better error |> _.instructions + { instructions = List.toArray lambda.instructions resultReg = lambda.resultIn } |> Ply @@ -425,7 +431,10 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = | CreateLambda(lambdaReg, impl) -> vm.lambdaInstrCache <- - Map.add (currentFrame.context, impl.exprId) impl vm.lambdaInstrCache + vm.lambdaInstrCache + |> Map.add (currentFrame.context, impl.exprId) impl + |> Map.add (Source, impl.exprId) impl + registers[lambdaReg] <- { exprId = impl.exprId closedRegisters = @@ -467,9 +476,18 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = match applicable with | AppLambda applicableLambda -> let foundLambda = - Map.findUnsafe - (currentFrame.context, applicableLambda.exprId) - vm.lambdaInstrCache + match + Map.tryFind + (currentFrame.context, applicableLambda.exprId) + vm.lambdaInstrCache + with + | Some lambda -> lambda + | None -> + match + Map.tryFind (Source, applicableLambda.exprId) vm.lambdaInstrCache + with + | Some lambda -> lambda + | None -> raiseRTE (RTE.VariableNotFound "lambda not found") // TODO better error let allArgs = applicableLambda.argsSoFar @ newArgDvals @@ -480,7 +498,7 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = // TODO: fail if we try to apply a lambda with type args if argCount = paramCount then - frameToPush <- + let newFrame = { id = guuid () parent = Some(vm.currentFrameID, putResultIn, counter + 1) programCounter = 0 @@ -494,7 +512,8 @@ let execute (exeState : ExecutionState) (vm : VMState) : Ply = r context = Lambda(currentFrame.context, applicableLambda.exprId) } - |> Some + + frameToPush <- Some newFrame else if argCount > paramCount then // TODO diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index 9897cfccc0..c6e46c6958 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -675,21 +675,23 @@ module Expr = let casesAfterFirstPhase : List = cases |> List.map (fun c -> - let (pat, symbols, rcAfterPat) = + let (pat, patSymbols, rcAfterPat) = MatchPattern.toRT Map.empty rcAfterResultIsReserved c.pat + let mergedSymbols = Map.mergeFavoringRight symbols patSymbols + // compile the `when` condition, if it exists, as much as we can let rcAfterWhenCond, whenCondInstrs, whenCondJump = match c.whenCondition with | None -> (rcAfterPat, [], None) | Some whenCond -> - let whenCond = toRT symbols rcAfterPat whenCond + let whenCond = toRT mergedSymbols rcAfterPat whenCond (whenCond.registerCount, whenCond.instructions, Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCond.resultIn))) // compile the `rhs` of the case - let rhs = toRT symbols rcAfterWhenCond c.rhs + let rhs = toRT mergedSymbols rcAfterWhenCond c.rhs // return the intermediate results, as far along as they are { matchValueInstrFn = @@ -872,7 +874,7 @@ module Expr = ([], Map.empty, 0) let (registersToCloseOver, - symbolsOfNewFrameAfterOnesOnlyUsedInBoty, + symbolsOfNewFrameAfterOnesOnlyUsedInBody, rcOfNewFrame) : (List * Map * int) = symbolsUsedInBodyNotDefinedInPats |> Set.toList @@ -887,7 +889,7 @@ module Expr = patterns = pats |> NEList.ofListUnsafe "" [] registersToCloseOver = registersToCloseOver instructions = - toRT symbolsOfNewFrameAfterOnesOnlyUsedInBoty rcOfNewFrame body } + toRT symbolsOfNewFrameAfterOnesOnlyUsedInBody rcOfNewFrame body } { registerCount = rc + 1 instructions = [ RT.CreateLambda(rc, impl) ] diff --git a/backend/testfiles/execution/language/derror.dark b/backend/testfiles/execution/language/derror.dark index bcdc459f62..83f87b259b 100644 --- a/backend/testfiles/execution/language/derror.dark +++ b/backend/testfiles/execution/language/derror.dark @@ -1,4 +1,4 @@ -module Error = +// module Error = // Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L; 5L ] (fun x y -> x) = Builtin.testDerrorMessage // "Expected 2 arguments, got 1" diff --git a/backend/testfiles/execution/stdlib/_parser.dark b/backend/testfiles/execution/stdlib/_parser.dark deleted file mode 100644 index 36d557b38c..0000000000 --- a/backend/testfiles/execution/stdlib/_parser.dark +++ /dev/null @@ -1,158 +0,0 @@ -// aliases and helper fns -type Point = PACKAGE.Darklang.LanguageTools.Parser.Point -type Range = PACKAGE.Darklang.LanguageTools.Parser.Range -type ParsedNode = PACKAGE.Darklang.LanguageTools.Parser.ParsedNode - -let range (s: Int64 * Int64) (e: Int64 * Int64) : Range = - let (startRow, startColumn) = s - let (endRow, endColumn) = e - - Range - { start = Point { row = startRow; column = startColumn } - end_ = Point { row = endRow; column = endColumn } } - - - -/// These tests are a huge pain to write and maintain -/// Let's focus on roundtripping tests, largely, -/// and just have one of these for some base-line checking. -/// -/// TODO: make that one test much more comprehensive -module ParseToSimplifiedTree = - // super basic test just to make sure we don't throw an exception - (let parsed = - Builtin.parserParseToSimplifiedTree - "let add (a: Int) (b: Int): Int =\n let sum = a + b\n sum" - - parsed.typ) = "source_file" - - - // simplest type alias - ("type ID = Int64" |> Builtin.parserParseToSimplifiedTree) = ParsedNode - { typ = "source_file" - fieldName = Stdlib.Option.Option.None - text = "type ID = Int64" - range = range (0L, 0L) (0L, 15L) - children = - [ ParsedNode - { fieldName = Stdlib.Option.Option.None - typ = "type_decl" - text = "type ID = Int64" - range = range (0L, 0L) (0L, 15L) - children = - [ ParsedNode - { fieldName = Stdlib.Option.Option.Some "keyword_type" - typ = "keyword" - text = "type" - range = range (0L, 0L) (0L, 4L) - children = [] } - - ParsedNode - { fieldName = Stdlib.Option.Option.Some "name" - typ = "type_identifier" - text = "ID" - range = range (0L, 5L) (0L, 7L) - children = [] } - - ParsedNode - { fieldName = Stdlib.Option.Option.Some "symbol_equals" - typ = "symbol" - text = "=" - range = range (0L, 8L) (0L, 9L) - children = [] } - - ParsedNode - { fieldName = Stdlib.Option.Option.Some "typ" - typ = "type_decl_def" - text = "Int64" - range = range (0L, 10L) (0L, 15L) - children = - [ ParsedNode - { fieldName = Stdlib.Option.Option.None - typ = "type_decl_def_alias" - text = "Int64" - range = range (0L, 10L) (0L, 15L) - children = - [ ParsedNode - { fieldName = Stdlib.Option.Option.None - typ = "type_reference" - text = "Int64" - range = range (0L, 10L) (0L, 15L) - children = - [ ParsedNode - { fieldName = Stdlib.Option.Option.None - typ = "builtin_type" - text = "Int64" - range = range (0L, 10L) (0L, 15L) - children = [] } ] } ] } ] } ] } ] } - - - ("" |> Builtin.parserParseToSimplifiedTree) = ParsedNode - { typ = "source_file" - fieldName = Stdlib.Option.Option.None - text = "" - range = range (0L, 0L) (0L, 0L) - children = [] } - -// These tests are a huge pain to write and maintain -// Let's focus on roundtripping tests, largely, -// and just have one of these for some base-line checking. -/// -/// TODO: make that one test much more comprehensive -module ParseNodeToWrittenTypes = - ("type MyID = Int64" - |> PACKAGE.Darklang.LanguageTools.Parser.parseToSimplifiedTree - |> PACKAGE.Darklang.LanguageTools.Parser.parseFromTree - |> Builtin.unwrap) = PACKAGE - .Darklang - .LanguageTools - .WrittenTypes - .ParsedFile - .SourceFile( - PACKAGE.Darklang.LanguageTools.WrittenTypes.SourceFile.SourceFile - { range = range (0L, 0L) (0L, 17L) - declarations = - [ PACKAGE - .Darklang - .LanguageTools - .WrittenTypes - .SourceFile - .SourceFileDeclaration - .Type( - (PACKAGE.Darklang.LanguageTools.WrittenTypes.TypeDeclaration.TypeDeclaration - { range = range (0L, 0L) (0L, 17L) - name = - PACKAGE.Darklang.LanguageTools.WrittenTypes.TypeIdentifier - { range = range (0L, 5L) (0L, 9L) - name = "MyID" } - typeParams = [] - definition = - PACKAGE - .Darklang - .LanguageTools - .WrittenTypes - .TypeDeclaration - .Definition - .Alias( - PACKAGE - .Darklang - .LanguageTools - .WrittenTypes - .TypeReference - .TypeReference - .Builtin( - PACKAGE - .Darklang - .LanguageTools - .WrittenTypes - .TypeReference - .Builtin - .TInt64(range (0L, 12L) (0L, 17L)) - ) - ) - keywordType = range (0L, 0L) (0L, 4L) - symbolEquals = range (0L, 10L) (0L, 11L) }) - ) ] - unparseableStuff = [] - exprsToEval = [] } - ) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_uuid.dark b/backend/testfiles/execution/stdlib/_uuid.dark deleted file mode 100644 index 805d7b07c6..0000000000 --- a/backend/testfiles/execution/stdlib/_uuid.dark +++ /dev/null @@ -1,25 +0,0 @@ -Stdlib.Uuid.parse_v0 "👱🏼" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -Stdlib.Uuid.parse_v0 "1111111🍇-2222-3333-4444-555555555555" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -Stdlib.Uuid.parse_v0 "psp-soslsls==" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -Stdlib.Uuid.parse_v0 "123456" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -Stdlib.Uuid.parse_v0 "d388ff30-667f-11eb-ae93" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -Stdlib.Uuid.parse_v0 "d388ff30-667f-11eb-ae93-0242ac13000" = Stdlib.Result.Result.Error - Stdlib.Uuid.ParseError.BadFormat - -(Stdlib.Uuid.parse_v0 "3700adbc-7a46-4ff4-81d3-45afb03f6e2d") -|> Builtin.unwrap -|> Stdlib.Uuid.toString = "3700adbc-7a46-4ff4-81d3-45afb03f6e2d" - -(Stdlib.Uuid.parse_v0 "11111111-2222-3333-4444-555555555555") -|> Builtin.unwrap -|> Stdlib.Uuid.toString = "11111111-2222-3333-4444-555555555555" \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_alt-json.dark b/backend/testfiles/execution/stdlib/alt-json.dark similarity index 50% rename from backend/testfiles/execution/stdlib/_alt-json.dark rename to backend/testfiles/execution/stdlib/alt-json.dark index 69c1cc0734..bb03eddb0a 100644 --- a/backend/testfiles/execution/stdlib/_alt-json.dark +++ b/backend/testfiles/execution/stdlib/alt-json.dark @@ -29,25 +29,25 @@ let parseError (err: ParseError) : Stdlib.Result.Result = // tests module Null = format Json.Null = "null" - parse "null" = parsedOk Json.Null +// parse "null" = parsedOk Json.Null - parse "NULL" = parseError ParseError.NotJson - parse "Null" = parseError ParseError.NotJson - parse "unit" = parseError ParseError.NotJson - parse "()" = parseError ParseError.NotJson - parse "" = parseError ParseError.NotJson +// parse "NULL" = parseError ParseError.NotJson +// parse "Null" = parseError ParseError.NotJson +// parse "unit" = parseError ParseError.NotJson +// parse "()" = parseError ParseError.NotJson +// parse "" = parseError ParseError.NotJson module Bool = format (Json.Bool true) = "true" format (Json.Bool false) = "false" - parse "true" = parsedOk (Json.Bool true) - parse "false" = parsedOk (Json.Bool false) +// parse "true" = parsedOk (Json.Bool true) +// parse "false" = parsedOk (Json.Bool false) - parse "False" = parseError ParseError.NotJson - parse "f" = parseError ParseError.NotJson - parse "True" = parseError ParseError.NotJson - parse "t" = parseError ParseError.NotJson +// parse "False" = parseError ParseError.NotJson +// parse "f" = parseError ParseError.NotJson +// parse "True" = parseError ParseError.NotJson +// parse "t" = parseError ParseError.NotJson module Number = @@ -57,16 +57,16 @@ module Number = // - huge numbers (esp at Float's limits) // - other notation format (Json.Number 0.0) = "0" // TODO: any reason we need to make this `0.0`? - parse "0" = parsedOk (Json.Number 0.0) + // parse "0" = parsedOk (Json.Number 0.0) format (Json.Number 0.1) = "0.1" - parse "0.1" = parsedOk (Json.Number 0.1) + // parse "0.1" = parsedOk (Json.Number 0.1) format (Json.Number -1.0) = "-1" - parse "-1" = parsedOk (Json.Number -1.0) + // parse "-1" = parsedOk (Json.Number -1.0) format (Json.Number -1337.0) = "-1337" - parse "-1337" = parsedOk (Json.Number -1337.0) +// parse "-1337" = parsedOk (Json.Number -1337.0) @@ -75,10 +75,10 @@ module String = // - strings with quotes in them // - ' instead of " format (Json.String "hi") = "\"hi\"" - parse "\"hi\"" = parsedOk (Json.String "hi") +// parse "\"hi\"" = parsedOk (Json.String "hi") - parse "hi" = parseError ParseError.NotJson - parse "\'hi\'" = parseError ParseError.NotJson +// parse "hi" = parseError ParseError.NotJson +// parse "\'hi\'" = parseError ParseError.NotJson module Array = @@ -87,11 +87,11 @@ module Array = // empty format (Json.Array []) = "[]" - parse "[]" = parsedOk (Json.Array []) + // parse "[]" = parsedOk (Json.Array []) // simple single null format (Json.Array [ Json.Null ]) = "[null]" - parse "[ null ]" = parsedOk (Json.Array [ Json.Null ]) + // parse "[ null ]" = parsedOk (Json.Array [ Json.Null ]) // first fibonnaci numbers format ( @@ -108,31 +108,31 @@ module Array = Json.Number 34.0 ] ) = "[0,1,1,2,3,5,8,13,21,34]" - parse "[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]" = parsedOk ( - Json.Array - [ Json.Number 0.0 - Json.Number 1.0 - Json.Number 1.0 - Json.Number 2.0 - Json.Number 3.0 - Json.Number 5.0 - Json.Number 8.0 - Json.Number 13.0 - Json.Number 21.0 - Json.Number 34.0 ] - ) - - // nested arrays - parse - """ - [ [1, 2, 3], - [4, 5, 6], - [7, 8, 9] ]""" = parsedOk ( - Json.Array - [ Json.Array [ Json.Number 1.0; Json.Number 2.0; Json.Number 3.0 ] - Json.Array [ Json.Number 4.0; Json.Number 5.0; Json.Number 6.0 ] - Json.Array [ Json.Number 7.0; Json.Number 8.0; Json.Number 9.0 ] ] - ) + // parse "[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]" = parsedOk ( + // Json.Array + // [ Json.Number 0.0 + // Json.Number 1.0 + // Json.Number 1.0 + // Json.Number 2.0 + // Json.Number 3.0 + // Json.Number 5.0 + // Json.Number 8.0 + // Json.Number 13.0 + // Json.Number 21.0 + // Json.Number 34.0 ] + // ) + + // // nested arrays + // parse + // """ + // [ [1, 2, 3], + // [4, 5, 6], + // [7, 8, 9] ]""" = parsedOk ( + // Json.Array + // [ Json.Array [ Json.Number 1.0; Json.Number 2.0; Json.Number 3.0 ] + // Json.Array [ Json.Number 4.0; Json.Number 5.0; Json.Number 6.0 ] + // Json.Array [ Json.Number 7.0; Json.Number 8.0; Json.Number 9.0 ] ] + // ) format ( Json.Array @@ -145,26 +145,26 @@ module Array = // mixed types format (Json.Array [ Json.Null; Json.Number 1.2 ]) = "[null,1.2]" - parse "[ null, 1.2 ]" = parsedOk (Json.Array [ Json.Null; Json.Number 1.2 ]) +// parse "[ null, 1.2 ]" = parsedOk (Json.Array [ Json.Null; Json.Number 1.2 ]) module Object = // blank format (Json.Object []) = """{}""" - parse """{}""" = parsedOk (Json.Object []) + // parse """{}""" = parsedOk (Json.Object []) // single name format (Json.Object [ ("n", Json.Null) ]) = """{"n":null}""" - parse """{ "n": null }""" = parsedOk (Json.Object[("n", Json.Null)]) + // parse """{ "n": null }""" = parsedOk (Json.Object[("n", Json.Null)]) // dupe name - parse """{ "n": null, "n": 1 }""" = parsedOk ( - Json.Object [ ("n", Json.Null); ("n", Json.Number 1.0) ] - ) + // parse """{ "n": null, "n": 1 }""" = parsedOk ( + // Json.Object [ ("n", Json.Null); ("n", Json.Number 1.0) ] + // ) format (Json.Object [ ("n", Json.Null); ("n", Json.Number 1.0) ]) = """{"n":null,"n":1}""" @@ -172,21 +172,21 @@ module Object = // blank name format (Json.Object [ ("", Json.Null) ]) = """{"":null}""" - parse """{ "": null }""" = parsedOk (Json.Object[("", Json.Null)]) +// parse """{ "": null }""" = parsedOk (Json.Object[("", Json.Null)]) - // name with newline - // TODO not sure what's right here - //format (Json.Object [ ("a\nb", Json.Null) ]) = "{\"a\nb\": null}" - // parse "{\"a\nb\": null}" = parsedOk (Json.Object [ ("a\nb", Json.Null) ]) +// name with newline +// TODO not sure what's right here +//format (Json.Object [ ("a\nb", Json.Null) ]) = "{\"a\nb\": null}" +// parse "{\"a\nb\": null}" = parsedOk (Json.Object [ ("a\nb", Json.Null) ]) - module Errors = - // names must be strings - parse """{ 1: 1}""" = parseError ParseError.NotJson +// module Errors = +// // names must be strings +// parse """{ 1: 1}""" = parseError ParseError.NotJson - parse """{ null: 1}""" = parseError ParseError.NotJson +// parse """{ null: 1}""" = parseError ParseError.NotJson - // names must be in quotes - parse """{ invalidName: 1}""" = parseError ParseError.NotJson +// // names must be in quotes +// parse """{ invalidName: 1}""" = parseError ParseError.NotJson - // ..._double_ quotes - parse """{ 'invalidName': 1}""" = parseError ParseError.NotJson \ No newline at end of file +// // ..._double_ quotes +// parse """{ 'invalidName': 1}""" = parseError ParseError.NotJson \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_date.dark b/backend/testfiles/execution/stdlib/date.dark similarity index 99% rename from backend/testfiles/execution/stdlib/_date.dark rename to backend/testfiles/execution/stdlib/date.dark index ec6945f7f2..e0122c82b3 100644 --- a/backend/testfiles/execution/stdlib/_date.dark +++ b/backend/testfiles/execution/stdlib/date.dark @@ -10,7 +10,7 @@ module DateParsing = |> Stdlib.Result.map (fun x -> Stdlib.DateTime.toString_v0 x) = Stdlib.Result.Result.Ok "2019-07-28T22:42:36Z" - Stdlib.DateTime.parse "asd" = Stdlib.Result.Result.Error "Invalid date format" +// Stdlib.DateTime.parse "asd" = Stdlib.Result.Result.Error "Invalid date format" // Parse in both p "2018-09-24T18:01:24Z" = Stdlib.Result.Result.Ok "2018-09-24T18:01:24Z" diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/list.dark index 0c52dceafc..ffb0d1c050 100644 --- a/backend/testfiles/execution/stdlib/list.dark +++ b/backend/testfiles/execution/stdlib/list.dark @@ -1,4 +1,4 @@ -Stdlib.List.map [1L; 2L] (fun x -> x + 1L) = [ 2L; 3L] +Stdlib.List.map [ 1L; 2L ] (fun x -> x + 1L) = [ 2L; 3L ] // CLEANUP the following tests should fail on having mixed types @@ -7,11 +7,11 @@ Stdlib.List.map [1L; 2L] (fun x -> x + 1L) = [ 2L; 3L] //[(1,10);(2,20);(3,30,40)] = Builtin.testDerrorMessage "Cannot form a list of mixed types" -// Stdlib.List.all_v0 [] (fun item -> item < 3L) = true -// Stdlib.List.all_v0 [ 2L ] (fun item -> item < 3L) = true -// Stdlib.List.all_v0 [ 1L; 2L ] (fun item -> item < 3L) = true -// Stdlib.List.all_v0 [ 4L ] (fun item -> item < 3L) = false -// Stdlib.List.all_v0 [ 1L; 4L ] (fun item -> item < 3L) = false +Stdlib.List.all_v0 [] (fun item -> item < 3L) = true +Stdlib.List.all_v0 [ 2L ] (fun item -> item < 3L) = true +Stdlib.List.all_v0 [ 1L; 2L ] (fun item -> item < 3L) = true +Stdlib.List.all_v0 [ 4L ] (fun item -> item < 3L) = false +Stdlib.List.all_v0 [ 1L; 4L ] (fun item -> item < 3L) = false Stdlib.List.append_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 2L; 3L; 4L; 5L; 6L ] @@ -22,53 +22,53 @@ Stdlib.List.append_v0 [] [] = [] Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] -3L = [ "a"; "b"; "c"; "d" ] -//Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "d" ] +Stdlib.List.drop_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "d" ] Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] -1L = [ 1L; 2L; 3L; 4L ] Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 0L = [ 1L; 2L; 3L; 4L ] -//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 440737095L = [] -//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 1184467440737095L = [] -//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 2L = [ 3L; 4L ] -//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 4L = [] -//Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 5L = [] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 440737095L = [] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 1184467440737095L = [] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 2L = [ 3L; 4L ] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 4L = [] +Stdlib.List.drop_v0 [ 1L; 2L; 3L; 4L ] 5L = [] Stdlib.List.drop_v0 [ 3L; 3L; 3L ] 0L = [ 3L; 3L; 3L ] -//Stdlib.List.drop_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [] -//Stdlib.List.drop_v0 [ 5L ] 4L = [] +Stdlib.List.drop_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [] +Stdlib.List.drop_v0 [ 5L ] 4L = [] Stdlib.List.drop_v0 [] 4L = [] // Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage // "If only supports Booleans" -// Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 3L; 4L ] -// Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item >= 1L) = [] -// Stdlib.List.dropWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 5L; 2L; 2L ] -// Stdlib.List.dropWhile_v0 [] (fun item -> item < 3L) = [] +Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 3L; 4L ] +Stdlib.List.dropWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item >= 1L) = [] +Stdlib.List.dropWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 5L; 2L; 2L ] +Stdlib.List.dropWhile_v0 [] (fun item -> item < 3L) = [] Stdlib.List.empty_v0 = [] -// (Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> Builtin.testIncrementSideEffectCounter ()) +(Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> Builtin.testIncrementSideEffectCounter ()) -// Builtin.testSideEffectCount ()) = 3L + Builtin.testSideEffectCount ()) = 3L -// (Stdlib.List.iter [ 1L; 2L; 3L; 4L; 5L ] (fun x -> -// if x % 2L == 0L then -// Builtin.testIncrementSideEffectCounter ()) +(Stdlib.List.iter [ 1L; 2L; 3L; 4L; 5L ] (fun x -> + if x % 2L == 0L then + Builtin.testIncrementSideEffectCounter ()) -// Builtin.testSideEffectCount ()) = 2L + Builtin.testSideEffectCount ()) = 2L -// (Stdlib.List.iter [] (fun x -> Builtin.testIncrementSideEffectCounter ()) +(Stdlib.List.iter [] (fun x -> Builtin.testIncrementSideEffectCounter ()) -// Builtin.testSideEffectCount ()) = 0L + Builtin.testSideEffectCount ()) = 0L -// (Stdlib.List.iter [ 10L; 20L; 30L ] (fun x -> -// Builtin.testIncrementSideEffectCounter () -// Builtin.testIncrementSideEffectCounter ()) +(Stdlib.List.iter [ 10L; 20L; 30L ] (fun x -> + Builtin.testIncrementSideEffectCounter () + Builtin.testIncrementSideEffectCounter ()) -// Builtin.testSideEffectCount ()) = 6L + Builtin.testSideEffectCount ()) = 6L -// (Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> -// if x > 2L then -// Builtin.testIncrementSideEffectCounter ()) +(Stdlib.List.iter [ 1L; 2L; 3L ] (fun x -> + if x > 2L then + Builtin.testIncrementSideEffectCounter ()) -// Builtin.testSideEffectCount ()) = 1L + Builtin.testSideEffectCount ()) = 1L // Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> @@ -80,35 +80,35 @@ Stdlib.List.empty_v0 = [] // Stdlib.List.filter [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage // "If only supports Booleans" -// Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> -// match item with -// | 1L -> true -// | 2L -> false -// | 3L -> true) = [ 1L; 3L ] +Stdlib.List.filter [ 1L; 2L; 3L ] (fun item -> + match item with + | 1L -> true + | 2L -> false + | 3L -> true) = [ 1L; 3L ] -// Stdlib.List.filter [] (fun item -> true) = [] -// Stdlib.List.filter [ -20L; 5L; 9L ] (fun x -> x > 20L) = [] -// Stdlib.List.filter [] (fun item -> "a") = [] +Stdlib.List.filter [] (fun item -> true) = [] +Stdlib.List.filter [ -20L; 5L; 9L ] (fun x -> x > 20L) = [] +Stdlib.List.filter [] (fun item -> "a") = [] -// Stdlib.List.filterMap_v0 [ 1L; 2L; 3L ] (fun item -> -// if item == 2L then -// Stdlib.Option.Option.None -// else -// (Stdlib.Option.Option.Some(item * 2L))) = [ 2L; 6L ] +Stdlib.List.filterMap_v0 [ 1L; 2L; 3L ] (fun item -> + if item == 2L then + Stdlib.Option.Option.None + else + (Stdlib.Option.Option.Some(item * 2L))) = [ 2L; 6L ] -// Stdlib.List.filterMap_v0 [] (fun item -> 0L) = [] +Stdlib.List.filterMap_v0 [] (fun item -> 0L) = [] -// Stdlib.List.findFirst [ 1L; 2L; 3L ] (fun x -> x > 5L) = Stdlib.Option.Option.None -// Stdlib.List.findFirst [] (fun x -> x) = Stdlib.Option.Option.None +Stdlib.List.findFirst [ 1L; 2L; 3L ] (fun x -> x > 5L) = Stdlib.Option.Option.None +Stdlib.List.findFirst [] (fun x -> x) = Stdlib.Option.Option.None -// Stdlib.List.findFirst [ 1L; 2L; 3L; 1L; 4L ] (fun x -> x > 1L) = Stdlib.Option.Option.Some -// 2L +Stdlib.List.findFirst [ 1L; 2L; 3L; 1L; 4L ] (fun x -> x > 1L) = Stdlib.Option.Option.Some + 2L -// Stdlib.List.findFirst [ 0L; 5L; -6L; -10L ] (fun x -> x < 0L) = Stdlib.Option.Option.Some -// -6L +Stdlib.List.findFirst [ 0L; 5L; -6L; -10L ] (fun x -> x < 0L) = Stdlib.Option.Option.Some + -6L -// Stdlib.List.findFirst [ 1L; -33L; 3L; -2L; 12L ] (fun x -> (x < 0L && x % 2L == 0L)) = Stdlib.Option.Option.Some -// -2L +Stdlib.List.findFirst [ 1L; -33L; 3L; -2L; 12L ] (fun x -> (x < 0L && x % 2L == 0L)) = Stdlib.Option.Option.Some + -2L // CLEANUP once DList contains typeRefs, this test may be uncommented and the error message updated: // Stdlib.List.flatten_v0 [1;2;3] = @@ -122,29 +122,29 @@ Stdlib.List.flatten_v0 [ [ [] ] ] = [ [] ] Stdlib.List.flatten_v0 [ [] ] = [] Stdlib.List.flatten_v0 [] = [] -// Stdlib.List.fold_v0 [ "a"; "b"; "c"; "d" ] "x" (fun accum curr -> accum ++ curr) = "xabcd" +Stdlib.List.fold_v0 [ "a"; "b"; "c"; "d" ] "x" (fun accum curr -> accum ++ curr) = "xabcd" -// Stdlib.List.fold_v0 [ 1L; 2L; 3L; 4L; 5L ] [] (fun accum curr -> -// Stdlib.List.pushBack_v0 accum (curr + 1L)) = [ 2L; 3L; 4L; 5L; 6L ] +Stdlib.List.fold_v0 [ 1L; 2L; 3L; 4L; 5L ] [] (fun accum curr -> + Stdlib.List.pushBack_v0 accum (curr + 1L)) = [ 2L; 3L; 4L; 5L; 6L ] -// Stdlib.List.fold_v0 [] [] (fun accum curr -> 5L) = [] +Stdlib.List.fold_v0 [] [] (fun accum curr -> 5L) = [] -// Stdlib.List.getAt [ "a"; "b"; "c"; "d" ] -1L = Stdlib.Option.Option.None -// Stdlib.List.getAt [ 0L ] 1L = Stdlib.Option.Option.None -// Stdlib.List.getAt [] 1L = Stdlib.Option.Option.None -// Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 6018427387902L = Stdlib.Option.Option.None +Stdlib.List.getAt [ "a"; "b"; "c"; "d" ] -1L = Stdlib.Option.Option.None +Stdlib.List.getAt [ 0L ] 1L = Stdlib.Option.Option.None +Stdlib.List.getAt [] 1L = Stdlib.Option.Option.None +Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 6018427387902L = Stdlib.Option.Option.None -// Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Option.Option.Some 1L +Stdlib.List.getAt [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Option.Option.Some 1L -// Stdlib.List.getAt [ 3L; 3L; 3L ] -5L = Stdlib.Option.Option.None -// Stdlib.List.getAt [ 3L; 3L; 3L ] 2147483648L = Stdlib.Option.Option.None +Stdlib.List.getAt [ 3L; 3L; 3L ] -5L = Stdlib.Option.Option.None +Stdlib.List.getAt [ 3L; 3L; 3L ] 2147483648L = Stdlib.Option.Option.None -// Stdlib.List.head [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 1L +Stdlib.List.head [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 1L // Stdlib.List.head [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage // "test" -// Stdlib.List.head [] = Stdlib.Option.Option.None +Stdlib.List.head [] = Stdlib.Option.Option.None // Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> v - i) = [ 3L; 1L; -1L ] @@ -152,20 +152,20 @@ Stdlib.List.flatten_v0 [] = [] // Stdlib.List.indexedMap_v0 [ 3L; 2L; 1L ] (fun i v -> i) = [ 0L; 1L; 2L ] -// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 2L; 5L; 3L; 6L ] +Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 2L; 5L; 3L; 6L ] -// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L ] = [ 1L; 4L; 2L; 3L ] -// Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [] = [ 1L; 2L; 3L ] -// Stdlib.List.interleave_v0 [ 1L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 5L; 6L ] -// Stdlib.List.interleave_v0 [] [ 4L; 5L; 6L ] = [ 4L; 5L; 6L ] -// Stdlib.List.interleave_v0 [] [] = [] +Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [ 4L ] = [ 1L; 4L; 2L; 3L ] +Stdlib.List.interleave_v0 [ 1L; 2L; 3L ] [] = [ 1L; 2L; 3L ] +Stdlib.List.interleave_v0 [ 1L ] [ 4L; 5L; 6L ] = [ 1L; 4L; 5L; 6L ] +Stdlib.List.interleave_v0 [] [ 4L; 5L; 6L ] = [ 4L; 5L; 6L ] +Stdlib.List.interleave_v0 [] [] = [] // Stdlib.List.interleave_v0 [ "a"; "b"; "c" ] [ 0L ] = Builtin.testDerrorMessage // "Could not merge types List and List" -// Stdlib.List.interpose_v0 [ 1L; 2L; 3L ] 5L = [ 1L; 5L; 2L; 5L; 3L ] -// Stdlib.List.interpose_v0 [ 1L ] 5L = [ 1L ] -// Stdlib.List.interpose_v0 [] 5L = [] +Stdlib.List.interpose_v0 [ 1L; 2L; 3L ] 5L = [ 1L; 5L; 2L; 5L; 3L ] +Stdlib.List.interpose_v0 [ 1L ] 5L = [ 1L ] +Stdlib.List.interpose_v0 [] 5L = [] // Stdlib.List.interpose_v0 [ "a"; "b"; "c" ] 0L = Builtin.testDerrorMessage // "Could not merge types List and List" @@ -173,7 +173,7 @@ Stdlib.List.flatten_v0 [] = [] Stdlib.List.isEmpty_v0 [ 1L ] = false Stdlib.List.isEmpty_v0 [] = true -//Stdlib.List.last [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 3L +Stdlib.List.last [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some 3L // Stdlib.List.last [ Builtin.testRuntimeError "test" ] = Builtin.testDerrorMessage // "test" @@ -183,51 +183,51 @@ Stdlib.List.last [] = Stdlib.Option.Option.None Stdlib.List.length_v0 [ 1L; 2L; 3L ] = 3L Stdlib.List.length_v0 [] = 0L -// Stdlib.List.map_v0 (Stdlib.List.range_v0 1L 5L) (fun x -> x + 1L) = [ 2L -// 3L -// 4L -// 5L -// 6L ] +Stdlib.List.map_v0 (Stdlib.List.range_v0 1L 5L) (fun x -> x + 1L) = [ 2L + 3L + 4L + 5L + 6L ] -// Stdlib.List.map_v0 [ 1L; 2L; 3L ] (fun x -> -// Stdlib.Bool.and_v0 -// (Stdlib.Int64.greaterThanOrEqualTo_v0 x 0L) -// (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = [ true; true; true ] +Stdlib.List.map_v0 [ 1L; 2L; 3L ] (fun x -> + Stdlib.Bool.and_v0 + (Stdlib.Int64.greaterThanOrEqualTo_v0 x 0L) + (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = [ true; true; true ] -// Stdlib.List.map_v0 [ 1L; 2L ] (fun x -> x + 1L) = [ 2L; 3L ] -// Stdlib.List.map_v0 [] (fun x -> x + 1L) = [] +Stdlib.List.map_v0 [ 1L; 2L ] (fun x -> x + 1L) = [ 2L; 3L ] +Stdlib.List.map_v0 [] (fun x -> x + 1L) = [] -// Stdlib.List.map2_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.Some -// [ 9L; 18L; 27L ] +Stdlib.List.map2_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.Some + [ 9L; 18L; 27L ] -// Stdlib.List.map2_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.None +Stdlib.List.map2_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = Stdlib.Option.Option.None -// Stdlib.List.map2_v0 [] [] (fun a b -> a - b) = Stdlib.Option.Option.Some [] +Stdlib.List.map2_v0 [] [] (fun a b -> a - b) = Stdlib.Option.Option.Some [] -// Stdlib.List.map2shortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L -// 18L -// 27L ] +Stdlib.List.map2shortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L + 18L + 27L ] -// Stdlib.List.map2shortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L -// 18L ] +Stdlib.List.map2shortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] (fun a b -> a - b) = [ 9L + 18L ] -// Stdlib.List.map2shortest_v0 [] [ 1L; 2L; 3L ] (fun a b -> a - b) = [] -// Stdlib.List.map2shortest_v0 [ 1L; 2L; 3L ] [] (fun a b -> a - b) = [] +Stdlib.List.map2shortest_v0 [] [ 1L; 2L; 3L ] (fun a b -> a - b) = [] +Stdlib.List.map2shortest_v0 [ 1L; 2L; 3L ] [] (fun a b -> a - b) = [] -// Stdlib.List.member_v0 [ 1L; 2L; 3L ] 2L = true -// Stdlib.List.member_v0 [ 1L; 2L; 3L ] 4L = false -// Stdlib.List.member_v0 [] 1L = false +Stdlib.List.member_v0 [ 1L; 2L; 3L ] 2L = true +Stdlib.List.member_v0 [ 1L; 2L; 3L ] 4L = false +Stdlib.List.member_v0 [] 1L = false -// Stdlib.List.partition_v0 [ -20L; 5L; 9L ] (fun x -> x > 0L) = ([ 5L; 9L ], [ -20L ]) +Stdlib.List.partition_v0 [ -20L; 5L; 9L ] (fun x -> x > 0L) = ([ 5L; 9L ], [ -20L ]) -// Stdlib.List.partition_v0 [] (fun item -> true) = ([], []) -// Stdlib.List.partition_v0 [] (fun item -> "a") = ([], []) +Stdlib.List.partition_v0 [] (fun item -> true) = ([], []) +Stdlib.List.partition_v0 [] (fun item -> "a") = ([], []) -// Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> -// match item with -// | 1L -> true -// | 2L -> false -// | 3L -> true) = ([ 1L; 3L ], [ 2L ]) +Stdlib.List.partition_v0 [ 1L; 2L; 3L ] (fun item -> + match item with + | 1L -> true + | 2L -> false + | 3L -> true) = ([ 1L; 3L ], [ 2L ]) // Stdlib.List.partition_v0 [ true; false; true ] (fun item -> "a") = Builtin.testDerrorMessage // "If only supports Booleans" @@ -239,11 +239,11 @@ Stdlib.List.length_v0 [] = 0L // | 2L -> false // | 3L -> true) = Builtin.testDerrorMessage "If only supports Booleans" -// Stdlib.List.pushBack_v0 [ 2L; 3L ] 1L = [ 2L; 3L; 1L ] -// Stdlib.List.pushBack_v0 [] 1L = [ 1L ] +Stdlib.List.pushBack_v0 [ 2L; 3L ] 1L = [ 2L; 3L; 1L ] +Stdlib.List.pushBack_v0 [] 1L = [ 1L ] -// Stdlib.List.push_v0 [ 2L; 3L ] 1L = [ 1L; 2L; 3L ] -// Stdlib.List.push_v0 [] 1L = [ 1L ] +Stdlib.List.push_v0 [ 2L; 3L ] 1L = [ 1L; 2L; 3L ] +Stdlib.List.push_v0 [] 1L = [ 1L ] // Stdlib.List.randomElement_v0 [ 1L ] = Stdlib.Option.Option.Some 1L @@ -252,144 +252,144 @@ Stdlib.List.length_v0 [] = 0L //Stdlib.List.randomElement_v0 [] = Stdlib.Option.Option.None -// Stdlib.List.range_v0 -1L 0L = [ -1L; 0L ] +Stdlib.List.range_v0 -1L 0L = [ -1L; 0L ] -// Stdlib.List.range_v0 -5L 5L = [ -5L; -4L; -3L; -2L; -1L; 0L; 1L; 2L; 3L; 4L; 5L ] +Stdlib.List.range_v0 -5L 5L = [ -5L; -4L; -3L; -2L; -1L; 0L; 1L; 2L; 3L; 4L; 5L ] -// Stdlib.List.range_v0 5L 0L = [] +Stdlib.List.range_v0 5L 0L = [] -// Stdlib.List.repeat_v0 0L 1L = Stdlib.Result.Result.Ok [] +Stdlib.List.repeat_v0 0L 1L = Stdlib.Result.Result.Ok [] -// Stdlib.List.repeat_v0 1L "a" = Stdlib.Result.Result.Ok [ "a" ] +Stdlib.List.repeat_v0 1L "a" = Stdlib.Result.Result.Ok [ "a" ] -// Stdlib.List.repeat_v0 1L 1L = Stdlib.Result.Result.Ok [ 1L ] +Stdlib.List.repeat_v0 1L 1L = Stdlib.Result.Result.Ok [ 1L ] -// Stdlib.List.repeat_v0 3L 1L = Stdlib.Result.Result.Ok [ 1L; 1L; 1L ] +Stdlib.List.repeat_v0 3L 1L = Stdlib.Result.Result.Ok [ 1L; 1L; 1L ] -// Stdlib.List.repeat_v0 3L 3L = Stdlib.Result.Result.Ok [ 3L; 3L; 3L ] +Stdlib.List.repeat_v0 3L 3L = Stdlib.Result.Result.Ok [ 3L; 3L; 3L ] -// Stdlib.List.repeat_v0 5L "a" = Stdlib.Result.Result.Ok [ "a"; "a"; "a"; "a"; "a" ] +Stdlib.List.repeat_v0 5L "a" = Stdlib.Result.Result.Ok [ "a"; "a"; "a"; "a"; "a" ] -// Stdlib.List.repeat_v0 -4L "a" = Stdlib.Result.Result.Error -// "Expected `times` to be positive, but it was `-4`" +Stdlib.List.repeat_v0 -4L "a" = Stdlib.Result.Result.Error + "Expected `times` to be positive, but it was `-4`" -// Stdlib.List.repeat_v0 3L [ 1L; 2L; 3L ] = Stdlib.Result.Result.Ok -// [ [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ] ] +Stdlib.List.repeat_v0 3L [ 1L; 2L; 3L ] = Stdlib.Result.Result.Ok + [ [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ]; [ 1L; 2L; 3L ] ] -// Stdlib.List.repeat_v0 3L [] = Stdlib.Result.Result.Ok [ []; []; [] ] +Stdlib.List.repeat_v0 3L [] = Stdlib.Result.Result.Ok [ []; []; [] ] -// Stdlib.List.reverse_v0 [ "a"; "b"; "c"; "d" ] = [ "d"; "c"; "b"; "a" ] +Stdlib.List.reverse_v0 [ "a"; "b"; "c"; "d" ] = [ "d"; "c"; "b"; "a" ] -// Stdlib.List.reverse_v0 [ 5L; 4L; 3L; 2L; 1L ] = [ 1L; 2L; 3L; 4L; 5L ] +Stdlib.List.reverse_v0 [ 5L; 4L; 3L; 2L; 1L ] = [ 1L; 2L; 3L; 4L; 5L ] -// Stdlib.List.reverse_v0 [] = [] +Stdlib.List.reverse_v0 [] = [] -// Stdlib.List.singleton_v0 1L = [ 1L ] +Stdlib.List.singleton_v0 1L = [ 1L ] -// Stdlib.List.sortBy_v0 [ 6L; 2L; 8L; 3L ] (fun x -> 0L - x) = [ 8L; 6L; 3L; 2L ] +Stdlib.List.sortBy_v0 [ 6L; 2L; 8L; 3L ] (fun x -> 0L - x) = [ 8L; 6L; 3L; 2L ] -// Stdlib.List.sortBy_v0 [] (fun x -> 0L - x) = [] +Stdlib.List.sortBy_v0 [] (fun x -> 0L - x) = [] -// Stdlib.List.sort_v0 [ "6"; "2"; "8"; "3" ] = [ "2"; "3"; "6"; "8" ] -// Stdlib.List.sort_v0 [ 6L; 2L; 8L; 3L ] = [ 2L; 3L; 6L; 8L ] -// Stdlib.List.sort_v0 [] = [] +Stdlib.List.sort_v0 [ "6"; "2"; "8"; "3" ] = [ "2"; "3"; "6"; "8" ] +Stdlib.List.sort_v0 [ 6L; 2L; 8L; 3L ] = [ 2L; 3L; 6L; 8L ] +Stdlib.List.sort_v0 [] = [] -// // CLEANUP: it should be a type error on the function not returning an Int64 +// CLEANUP: it should be a type error on the function not returning an Int64 // Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 0.1) = Builtin.testDerrorMessage // // "Function return value should be an Int64. However, a Float (0.1) was returned instead.\n\nExpected: Int64\nActual: a Float: 0.1" // "Both values must be the same type" -// Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 3L) = Stdlib.Result.Result.Error -// "Expected comparator function to return -1, 0, or 1, but it returned 3" +Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> 3L) = Stdlib.Result.Result.Error + "Expected comparator function to return -1, 0, or 1, but it returned 3" -// // CLEANUP: it should be a type error on the function not returning an Int64 +// CLEANUP: it should be a type error on the function not returning an Int64 // Stdlib.List.sortByComparator_v0 [ 1L; 2L; 3L ] (fun a b -> "㧑༷釺") = Builtin.testDerrorMessage // // "Function return value should be an Int64. However, a String (\"㧑༷釺\") was returned instead.\n\nExpected: Int64\nActual: a String: \"㧑༷釺\"" // "Both values must be the same type" -// Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> -// if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok -// [ 1L; 2L; 3L ] - -// Stdlib.List.sortByComparator_v0 [] (fun a b -> -// if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok [] - -// Stdlib.List.sortByComparator_v0 -// [ 3L -// 1L -// 2L -// 67L -// 3L -// -1L -// 6L -// 3L -// 5L -// 6L -// 2L -// 5L -// 63L -// 2L -// 3L -// 5L -// -1L -// -1L -// -1L ] -// (fun a b -> if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok -// [ -1L -// -1L -// -1L -// -1L -// 1L -// 2L -// 2L -// 2L -// 3L -// 3L -// 3L -// 3L -// 5L -// 5L -// 5L -// 6L -// 6L -// 63L -// 67L ] - -// // CLEANUP this error message is not ideal in 2 ways: -// // - The error does not provide context that the issue is with the fn specifically -// // - it seems to be from the perspective of the lambda -// // (I'm a lambda and I'm expecting 2 arguments, but I got 1!!) -// // rather than from the perspective of the function it's being used in +Stdlib.List.sortByComparator_v0 [ 3L; 1L; 2L ] (fun a b -> + if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok + [ 1L; 2L; 3L ] + +Stdlib.List.sortByComparator_v0 [] (fun a b -> + if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok [] + +Stdlib.List.sortByComparator_v0 + [ 3L + 1L + 2L + 67L + 3L + -1L + 6L + 3L + 5L + 6L + 2L + 5L + 63L + 2L + 3L + 5L + -1L + -1L + -1L ] + (fun a b -> if Stdlib.Int64.lessThan_v0 a b then -1L else 1L) = Stdlib.Result.Result.Ok + [ -1L + -1L + -1L + -1L + 1L + 2L + 2L + 2L + 3L + 3L + 3L + 3L + 5L + 5L + 5L + 6L + 6L + 63L + 67L ] + +// CLEANUP this error message is not ideal in 2 ways: +// - The error does not provide context that the issue is with the fn specifically +// - it seems to be from the perspective of the lambda +// (I'm a lambda and I'm expecting 2 arguments, but I got 1!!) +// rather than from the perspective of the function it's being used in // Stdlib.List.sortByComparator_v0 [ 6.0; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage // "Expected 1 arguments, got 2" -// Stdlib.List.tail_v0 [ 10L; 20L; 30L; 40L ] = Stdlib.Option.Option.Some -// [ 20L; 30L; 40L ] +Stdlib.List.tail_v0 [ 10L; 20L; 30L; 40L ] = Stdlib.Option.Option.Some + [ 20L; 30L; 40L ] -// Stdlib.List.tail_v0 [] = Stdlib.Option.Option.None +Stdlib.List.tail_v0 [] = Stdlib.Option.Option.None -// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] -1L = [] +Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] -1L = [] -// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 2147483648L = [ "a"; "b"; "c"; "d" ] +Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 2147483648L = [ "a"; "b"; "c"; "d" ] -// Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "a"; "b"; "c" ] -// Stdlib.List.take_v0 [ 3L; 3L; 3L ] 0L = [] +Stdlib.List.take_v0 [ "a"; "b"; "c"; "d" ] 3L = [ "a"; "b"; "c" ] +Stdlib.List.take_v0 [ 3L; 3L; 3L ] 0L = [] -// Stdlib.List.take_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [ 5L; 4L; 3L; 2L; 1L ] +Stdlib.List.take_v0 [ 5L; 4L; 3L; 2L; 1L ] 5L = [ 5L; 4L; 3L; 2L; 1L ] -// Stdlib.List.take_v0 [ 5L ] 4L = [ 5L ] -// Stdlib.List.take_v0 [] 4L = [] +Stdlib.List.take_v0 [ 5L ] 4L = [ 5L ] +Stdlib.List.take_v0 [] 4L = [] -// //TODO: better error message +//TODO: better error message // Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> 0L - 1L) = Builtin.testDerrorMessage // "If only supports Booleans" -// Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 1L) = [] +Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 1L) = [] -// Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 1L; 2L ] +Stdlib.List.takeWhile_v0 [ 1L; 2L; 3L; 4L ] (fun item -> item < 3L) = [ 1L; 2L ] -// Stdlib.List.takeWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 1L ] -// Stdlib.List.takeWhile_v0 [] (fun item -> item < 3L) = [] +Stdlib.List.takeWhile_v0 [ 1L; 5L; 2L; 2L ] (fun item -> item < 3L) = [ 1L ] +Stdlib.List.takeWhile_v0 [] (fun item -> item < 3L) = [] // // it isn't specified which is the right value to keep when there are duplicates // Stdlib.List.uniqueBy_v0 [ 1L; 2L; 3L; 4L ] (fun x -> Stdlib.Int64.divide_v0 x 2L) = [ 1L // 2L @@ -406,47 +406,47 @@ Stdlib.List.length_v0 [] = 0L // Stdlib.List.uniqueBy_v0 [ 6L; 2.0 ] (fun x -> x) = Builtin.testDerrorMessage // "Could not merge types List and List" -// Stdlib.List.unique_v0 [ 1L; 2L; 3L; 4L ] = [ 1L; 2L; 3L; 4L ] -// Stdlib.List.unique_v0 [ 1L; 1L; 1L; 1L ] = [ 1L ] +Stdlib.List.unique_v0 [ 1L; 2L; 3L; 4L ] = [ 1L; 2L; 3L; 4L ] +Stdlib.List.unique_v0 [ 1L; 1L; 1L; 1L ] = [ 1L ] -// Stdlib.List.unique_v0 [ 7L; 42L; 7L; 2L; 10L ] = [ 2L; 7L; 10L; 42L ] +Stdlib.List.unique_v0 [ 7L; 42L; 7L; 2L; 10L ] = [ 2L; 7L; 10L; 42L ] -// Stdlib.List.unique_v0 [] = [] -// // TODO: more tests, with values of more complex types +Stdlib.List.unique_v0 [] = [] +// TODO: more tests, with values of more complex types -// Stdlib.List.unzip_v0 [ (1L, 10L); (2L, 20L); (3L, 30L) ] = ([ 1L; 2L; 3L ], -// [ 10L; 20L; 30L ]) +Stdlib.List.unzip_v0 [ (1L, 10L); (2L, 20L); (3L, 30L) ] = ([ 1L; 2L; 3L ], + [ 10L; 20L; 30L ]) -// Stdlib.List.unzip_v0 [ (10L, 6L) ] = ([ 10L ], [ 6L ]) +Stdlib.List.unzip_v0 [ (10L, 6L) ] = ([ 10L ], [ 6L ]) -// Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = [ (10L, 1L) -// (20L, 2L) -// (30L, 3L) ] +Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = [ (10L, 1L) + (20L, 2L) + (30L, 3L) ] -// Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ "a"; "bc"; "d" ] = [ (10L, "a") -// (20L, "bc") -// (30L, "d") ] +Stdlib.List.zipShortest_v0 [ 10L; 20L; 30L ] [ "a"; "bc"; "d" ] = [ (10L, "a") + (20L, "bc") + (30L, "d") ] -// Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = [ (10L, 1L); (20L, 2L) ] +Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = [ (10L, 1L); (20L, 2L) ] -// Stdlib.List.zipShortest_v0 [ 1L; 2L; 3L ] [ 10L; 20L ] = [ (1L, 10L); (2L, 20L) ] +Stdlib.List.zipShortest_v0 [ 1L; 2L; 3L ] [ 10L; 20L ] = [ (1L, 10L); (2L, 20L) ] -// Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ "a"; "bc"; "d" ] = [ (10L, "a") -// (20L, "bc") ] +Stdlib.List.zipShortest_v0 [ 10L; 20L ] [ "a"; "bc"; "d" ] = [ (10L, "a") + (20L, "bc") ] -// Stdlib.List.zipShortest_v0 [ "a"; "bc"; "d" ] [ 10L; 20L ] = [ ("a", 10L) -// ("bc", 20L) ] +Stdlib.List.zipShortest_v0 [ "a"; "bc"; "d" ] [ 10L; 20L ] = [ ("a", 10L) + ("bc", 20L) ] -// Stdlib.List.zipShortest_v0 [ "b"; "v"; "z" ] [] = [] -// Stdlib.List.zipShortest_v0 [] [ "b"; "v"; "z" ] = [] +Stdlib.List.zipShortest_v0 [ "b"; "v"; "z" ] [] = [] +Stdlib.List.zipShortest_v0 [] [ "b"; "v"; "z" ] = [] -// Stdlib.List.zip_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some -// [ (10L, 1L); (20L, 2L); (30L, 3L) ] +Stdlib.List.zip_v0 [ 10L; 20L; 30L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some + [ (10L, 1L); (20L, 2L); (30L, 3L) ] -// Stdlib.List.zip_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.None +Stdlib.List.zip_v0 [ 10L; 20L ] [ 1L; 2L; 3L ] = Stdlib.Option.Option.None -// Stdlib.List.zip_v0 [] [] = Stdlib.Option.Option.Some [] +Stdlib.List.zip_v0 [] [] = Stdlib.Option.Option.Some [] // Stdlib.List.zip_v0 [ Builtin.testRuntimeError "msg" ] [ Some "" ] = Builtin.testDerrorMessage // "msg" @@ -483,31 +483,31 @@ Stdlib.List.length_v0 [] = 0L // Stdlib.List.groupByWithKey_v0 [] (fun x -> x) = [] -// Stdlib.List.dropLast [ 1L; 2L; 3L; 4L; 5L ] = [ 1L; 2L; 3L; 4L ] -// Stdlib.List.dropLast [ 1L ] = [] -// Stdlib.List.dropLast [] = [] +Stdlib.List.dropLast [ 1L; 2L; 3L; 4L; 5L ] = [ 1L; 2L; 3L; 4L ] +Stdlib.List.dropLast [ 1L ] = [] +Stdlib.List.dropLast [] = [] -// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L ] 2L = Stdlib.Result.Result.Ok -// [ [ 1L; 2L ]; [ 3L; 4L ]; [ 5L ] ] +Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L ] 2L = Stdlib.Result.Result.Ok + [ [ 1L; 2L ]; [ 3L; 4L ]; [ 5L ] ] -// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L; 6L ] 3L = Stdlib.Result.Result.Ok -// [ [ 1L; 2L; 3L ]; [ 4L; 5L; 6L ] ] +Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L; 5L; 6L ] 3L = Stdlib.Result.Result.Ok + [ [ 1L; 2L; 3L ]; [ 4L; 5L; 6L ] ] -// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L ] 1L = Stdlib.Result.Result.Ok -// [ [ 1L ]; [ 2L ]; [ 3L ] ] +Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L ] 1L = Stdlib.Result.Result.Ok + [ [ 1L ]; [ 2L ]; [ 3L ] ] -// Stdlib.List.chunkBySize_v0 [ 1L; 2L ] 3L = Stdlib.Result.Result.Ok [ [ 1L; 2L ] ] +Stdlib.List.chunkBySize_v0 [ 1L; 2L ] 3L = Stdlib.Result.Result.Ok [ [ 1L; 2L ] ] -// Stdlib.List.chunkBySize_v0 [] 4L = Stdlib.Result.Result.Ok [] +Stdlib.List.chunkBySize_v0 [] 4L = Stdlib.Result.Result.Ok [] -// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Result.Result.Error -// Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero +Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] 0L = Stdlib.Result.Result.Error + Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero -// Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] -1L = Stdlib.Result.Result.Error -// Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero +Stdlib.List.chunkBySize_v0 [ 1L; 2L; 3L; 4L ] -1L = Stdlib.Result.Result.Error + Stdlib.List.ChunkBySizeError.SizeMustBeGreaterThanZero -// Stdlib.List.splitLast [] = Stdlib.Option.Option.None -// Stdlib.List.splitLast [ 1L ] = Stdlib.Option.Option.Some(([], 1L)) -// Stdlib.List.splitLast [ 1L; 2L ] = Stdlib.Option.Option.Some(([ 1L ], 2L)) -// Stdlib.List.splitLast [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some(([ 1L; 2L ], 3L)) \ No newline at end of file +Stdlib.List.splitLast [] = Stdlib.Option.Option.None +Stdlib.List.splitLast [ 1L ] = Stdlib.Option.Option.Some(([], 1L)) +Stdlib.List.splitLast [ 1L; 2L ] = Stdlib.Option.Option.Some(([ 1L ], 2L)) +Stdlib.List.splitLast [ 1L; 2L; 3L ] = Stdlib.Option.Option.Some(([ 1L; 2L ], 3L)) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_option.dark b/backend/testfiles/execution/stdlib/option.dark similarity index 92% rename from backend/testfiles/execution/stdlib/_option.dark rename to backend/testfiles/execution/stdlib/option.dark index 5ec690610a..fce5eac642 100644 --- a/backend/testfiles/execution/stdlib/_option.dark +++ b/backend/testfiles/execution/stdlib/option.dark @@ -14,9 +14,9 @@ Stdlib.Option.andThen_v0 (Stdlib.Option.Option.Some 8L) (fun x -> Stdlib.Option.Option.Some(Stdlib.Int64.divide_v0 x 2L)) = Stdlib.Option.Option.Some 4L -Stdlib.Option.andThen_v0 (Stdlib.Option.Option.Some 8L) (fun x -> - Stdlib.Option.Option.Some(Stdlib.Int64.divide_v0 x 0L)) = Builtin.testDerrorMessage - "Division by zero" +// Stdlib.Option.andThen_v0 (Stdlib.Option.Option.Some 8L) (fun x -> +// Stdlib.Option.Option.Some(Stdlib.Int64.divide_v0 x 0L)) = Builtin.testDerrorMessage +// "Division by zero" Stdlib.Option.andThen2_v0 @@ -313,23 +313,23 @@ Stdlib.Option.join_v0 (Stdlib.Option.Option.Some(Stdlib.Option.Option.None)) = S Stdlib.Option.join_v0 Stdlib.Option.Option.None = Stdlib.Option.Option.None -Stdlib.Option.combine_v0 - [ Stdlib.Option.Option.Some 6L - Stdlib.Option.Option.Some 5L - Stdlib.Option.Option.Some 4L - Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.Some [ 6L; 5L; 4L; 3L ] +// Stdlib.Option.combine_v0 +// [ Stdlib.Option.Option.Some 6L +// Stdlib.Option.Option.Some 5L +// Stdlib.Option.Option.Some 4L +// Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.Some [ 6L; 5L; 4L; 3L ] -Stdlib.Option.combine_v0 - [ Stdlib.Option.Option.Some 6L - Stdlib.Option.Option.None - Stdlib.Option.Option.Some 4L - Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.None +// Stdlib.Option.combine_v0 +// [ Stdlib.Option.Option.Some 6L +// Stdlib.Option.Option.None +// Stdlib.Option.Option.Some 4L +// Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.None -Stdlib.Option.combine_v0 - [ Stdlib.Option.Option.None - Stdlib.Option.Option.None - Stdlib.Option.Option.None - Stdlib.Option.Option.None ] = Stdlib.Option.Option.None +// Stdlib.Option.combine_v0 +// [ Stdlib.Option.Option.None +// Stdlib.Option.Option.None +// Stdlib.Option.Option.None +// Stdlib.Option.Option.None ] = Stdlib.Option.Option.None Stdlib.Option.values diff --git a/backend/testfiles/execution/stdlib/parser.dark b/backend/testfiles/execution/stdlib/parser.dark new file mode 100644 index 0000000000..c465e5bd06 --- /dev/null +++ b/backend/testfiles/execution/stdlib/parser.dark @@ -0,0 +1,158 @@ +// aliases and helper fns +type Point = PACKAGE.Darklang.LanguageTools.Parser.Point +type Range = PACKAGE.Darklang.LanguageTools.Parser.Range +type ParsedNode = PACKAGE.Darklang.LanguageTools.Parser.ParsedNode + +let range (s: Int64 * Int64) (e: Int64 * Int64) : Range = + let (startRow, startColumn) = s + let (endRow, endColumn) = e + + Range + { start = Point { row = startRow; column = startColumn } + end_ = Point { row = endRow; column = endColumn } } + + + +/// These tests are a huge pain to write and maintain +/// Let's focus on roundtripping tests, largely, +/// and just have one of these for some base-line checking. +/// +/// TODO: make that one test much more comprehensive +module ParseToSimplifiedTree = + // super basic test just to make sure we don't throw an exception + (let parsed = + Builtin.parserParseToSimplifiedTree + "let add (a: Int) (b: Int): Int =\n let sum = a + b\n sum" + + parsed.typ) = "source_file" + + +// simplest type alias +// ("type ID = Int64" |> Builtin.parserParseToSimplifiedTree) = ParsedNode +// { typ = "source_file" +// fieldName = Stdlib.Option.Option.None +// text = "type ID = Int64" +// range = range (0L, 0L) (0L, 15L) +// children = +// [ ParsedNode +// { fieldName = Stdlib.Option.Option.None +// typ = "type_decl" +// text = "type ID = Int64" +// range = range (0L, 0L) (0L, 15L) +// children = +// [ ParsedNode +// { fieldName = Stdlib.Option.Option.Some "keyword_type" +// typ = "keyword" +// text = "type" +// range = range (0L, 0L) (0L, 4L) +// children = [] } + +// ParsedNode +// { fieldName = Stdlib.Option.Option.Some "name" +// typ = "type_identifier" +// text = "ID" +// range = range (0L, 5L) (0L, 7L) +// children = [] } + +// ParsedNode +// { fieldName = Stdlib.Option.Option.Some "symbol_equals" +// typ = "symbol" +// text = "=" +// range = range (0L, 8L) (0L, 9L) +// children = [] } + +// ParsedNode +// { fieldName = Stdlib.Option.Option.Some "typ" +// typ = "type_decl_def" +// text = "Int64" +// range = range (0L, 10L) (0L, 15L) +// children = +// [ ParsedNode +// { fieldName = Stdlib.Option.Option.None +// typ = "type_decl_def_alias" +// text = "Int64" +// range = range (0L, 10L) (0L, 15L) +// children = +// [ ParsedNode +// { fieldName = Stdlib.Option.Option.None +// typ = "type_reference" +// text = "Int64" +// range = range (0L, 10L) (0L, 15L) +// children = +// [ ParsedNode +// { fieldName = Stdlib.Option.Option.None +// typ = "builtin_type" +// text = "Int64" +// range = range (0L, 10L) (0L, 15L) +// children = [] } ] } ] } ] } ] } ] } + + +// ("" |> Builtin.parserParseToSimplifiedTree) = ParsedNode +// { typ = "source_file" +// fieldName = Stdlib.Option.Option.None +// text = "" +// range = range (0L, 0L) (0L, 0L) +// children = [] } + +// // These tests are a huge pain to write and maintain +// // Let's focus on roundtripping tests, largely, +// // and just have one of these for some base-line checking. +// /// +// /// TODO: make that one test much more comprehensive +// module ParseNodeToWrittenTypes = +// ("type MyID = Int64" +// |> PACKAGE.Darklang.LanguageTools.Parser.parseToSimplifiedTree +// |> PACKAGE.Darklang.LanguageTools.Parser.parseFromTree +// |> Builtin.unwrap) = PACKAGE +// .Darklang +// .LanguageTools +// .WrittenTypes +// .ParsedFile +// .SourceFile( +// PACKAGE.Darklang.LanguageTools.WrittenTypes.SourceFile.SourceFile +// { range = range (0L, 0L) (0L, 17L) +// declarations = +// [ PACKAGE +// .Darklang +// .LanguageTools +// .WrittenTypes +// .SourceFile +// .SourceFileDeclaration +// .Type( +// (PACKAGE.Darklang.LanguageTools.WrittenTypes.TypeDeclaration.TypeDeclaration +// { range = range (0L, 0L) (0L, 17L) +// name = +// PACKAGE.Darklang.LanguageTools.WrittenTypes.TypeIdentifier +// { range = range (0L, 5L) (0L, 9L) +// name = "MyID" } +// typeParams = [] +// definition = +// PACKAGE +// .Darklang +// .LanguageTools +// .WrittenTypes +// .TypeDeclaration +// .Definition +// .Alias( +// PACKAGE +// .Darklang +// .LanguageTools +// .WrittenTypes +// .TypeReference +// .TypeReference +// .Builtin( +// PACKAGE +// .Darklang +// .LanguageTools +// .WrittenTypes +// .TypeReference +// .Builtin +// .TInt64(range (0L, 12L) (0L, 17L)) +// ) +// ) +// keywordType = range (0L, 0L) (0L, 4L) +// symbolEquals = range (0L, 10L) (0L, 11L) }) +// ) ] +// unparseableStuff = [] +// exprsToEval = [] } +// ) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/uuid.dark b/backend/testfiles/execution/stdlib/uuid.dark new file mode 100644 index 0000000000..387b984397 --- /dev/null +++ b/backend/testfiles/execution/stdlib/uuid.dark @@ -0,0 +1,25 @@ +// Stdlib.Uuid.parse_v0 "👱🏼" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +// Stdlib.Uuid.parse_v0 "1111111🍇-2222-3333-4444-555555555555" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +// Stdlib.Uuid.parse_v0 "psp-soslsls==" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +// Stdlib.Uuid.parse_v0 "123456" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +// Stdlib.Uuid.parse_v0 "d388ff30-667f-11eb-ae93" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +// Stdlib.Uuid.parse_v0 "d388ff30-667f-11eb-ae93-0242ac13000" = Stdlib.Result.Result.Error +// Stdlib.Uuid.ParseError.BadFormat + +(Stdlib.Uuid.parse_v0 "3700adbc-7a46-4ff4-81d3-45afb03f6e2d") +|> Builtin.unwrap +|> Stdlib.Uuid.toString = "3700adbc-7a46-4ff4-81d3-45afb03f6e2d" + +(Stdlib.Uuid.parse_v0 "11111111-2222-3333-4444-555555555555") +|> Builtin.unwrap +|> Stdlib.Uuid.toString = "11111111-2222-3333-4444-555555555555" \ No newline at end of file diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 5c54b00adc..63ddd3f23d 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -568,7 +568,19 @@ module Fns = let tests = testList "Recursion" [ addUpTo ] - let tests = testList "Package" [ MyAdd.tests; Fact.tests; Recusrsion.tests ] + module MyFnThatTakesALambda = + let fullyApplied = + t + "Test.myFnThatTakesALambda 4L (fun x -> x + 11L)" + E.Fns.Package.MyFnThatTakesALambda.fullyApplied2 + (RT.DInt64 15L) + + let tests = testList "MyFnThatTakesALambda" [ fullyApplied ] + + let tests = + testList + "Package" + [ MyAdd.tests; Fact.tests; Recusrsion.tests; MyFnThatTakesALambda.tests ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 559fd3a102..d2ec297035 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -1275,7 +1275,50 @@ module Expr = let tests = testList "MyAdd" [ unapplied; partiallyApplied; fullyApplied ] - let tests = testList "Package" [ MyAdd.tests ] + module MyFnThatTakesALambda = + let myMap = + t + "Test.myMap [1L; 2L] (fun x -> x + 1L)" + E.Fns.Package.MyFnThatTakesALambda.fullyApplied + (6, + [ RT.LoadVal( + 0, + RT.DApplicable( + RT.AppNamedFn + { name = + RT.FQFnName.fqPackage E.Fns.Package.MyFnThatTakesALambda.id + argsSoFar = [] } + ) + ) + RT.LoadVal(2, RT.DInt64 1L) + RT.LoadVal(3, RT.DInt64 2L) + RT.CreateList(1, [ 2; 3 ]) + RT.CreateLambda( + 4, + { exprId = E.Fns.Package.MyFnThatTakesALambda.lambdaID + patterns = { head = RT.LPVariable 0; tail = [] } + registersToCloseOver = [] + instructions = + { registerCount = 4 + instructions = + [ RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal( + 2, + RT.DApplicable( + RT.AppNamedFn + { name = RT.FQFnName.fqBuiltin "int64Add" 0 + argsSoFar = [] } + ) + ) + RT.Apply(3, 2, [], { head = 0; tail = [ 1 ] }) ] + resultIn = 3 } } + ) + RT.Apply(5, 0, [], { head = 1; tail = [ 4 ] }) ], + 5) + + let tests = testList "MyFnThatTakesALambda" [ myMap ] + + let tests = testList "Package" [ MyAdd.tests; MyFnThatTakesALambda.tests ] let tests = testList "Fns" [ Builtin.tests; Package.tests ] diff --git a/backend/tests/Tests/TestValues.fs b/backend/tests/Tests/TestValues.fs index 72335c1c60..3f2efd62cc 100644 --- a/backend/tests/Tests/TestValues.fs +++ b/backend/tests/Tests/TestValues.fs @@ -444,6 +444,31 @@ module Expressions = let applied = eApply unapplied [] [ eInt64 30000 ] + module MyFnThatTakesALambda = + let lambdaID = gid () + let id = System.Guid.Parse "25179761-0259-4d52-a505-d75f0738e45c" + let unapplied = ePackageFn id + + let fullyApplied = + let list = eList [ eInt64 1L; eInt64 2L ] + let lambda = + eLambda + lambdaID + [ lpVar "x" ] + (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 1)) + eApply unapplied [] [ list; lambda ] + + + let fullyApplied2 = + let lambda = + eLambda + lambdaID + [ lpVar "x" ] + (eInfix (PT.Infix.InfixFnCall PT.ArithmeticPlus) (eVar "x") (eInt64 11)) + + eApply unapplied [] [ eInt64 4L; lambda ] + + module PT2RT = LibExecution.ProgramTypesToRuntimeTypes @@ -523,4 +548,19 @@ let pm : PT.PackageManager = [ eVar "n"; eInt64 1L ] ]) ] )) description = "TODO" + deprecated = PT.NotDeprecated } + + { id = Expressions.Fns.Package.MyFnThatTakesALambda.id + name = PT.PackageFn.name "Test" [] "myFnThatTakesALambda" + typeParams = [] + parameters = + NEList.ofList + { name = "x"; typ = PT.TInt64; description = "TODO" } + [ { name = "fn" + typ = + PT.TFn({ head = PT.TVariable "a"; tail = [] }, PT.TVariable "b") + description = "TODO" } ] + returnType = PT.TInt64 + body = eApply (eVar "fn") [] [ eVar "x" ] + description = "TODO" deprecated = PT.NotDeprecated } ] From 12768357d499f3650ddec2020c35024f2d5d3f4e Mon Sep 17 00:00:00 2001 From: Ocean Date: Wed, 2 Oct 2024 14:43:44 +0000 Subject: [PATCH 60/60] 3000 tests passing --- .../ProgramTypesToRuntimeTypes.fs | 6 +- .../execution/language/apply/_einfix.dark | 13 - .../execution/language/apply/einfix.dark | 13 + .../language/{_big.dark => big.dark} | 0 .../{_type-alias.dark => type-alias.dark} | 80 +- .../language/{_elambda.dark => elambda.dark} | 78 +- .../testfiles/execution/stdlib/_base64.dark | 119 --- backend/testfiles/execution/stdlib/_dict.dark | 200 ----- .../execution/stdlib/_httpclient.dark | 591 ------------ .../testfiles/execution/stdlib/base64.dark | 119 +++ backend/testfiles/execution/stdlib/dict.dark | 200 +++++ .../stdlib/{_html.dark => html.dark} | 50 +- .../execution/stdlib/httpclient.dark | 591 ++++++++++++ .../execution/stdlib/ints/_uint16.dark | 259 ------ .../execution/stdlib/ints/_uint64.dark | 273 ------ .../execution/stdlib/ints/_uint8.dark | 262 ------ .../execution/stdlib/ints/int16.dark | 62 +- .../execution/stdlib/ints/int32.dark | 92 +- .../execution/stdlib/ints/int64.dark | 146 +-- .../testfiles/execution/stdlib/ints/int8.dark | 76 +- .../execution/stdlib/ints/uint16.dark | 259 ++++++ .../stdlib/ints/{_uint32.dark => uint32.dark} | 138 +-- .../execution/stdlib/ints/uint64.dark | 273 ++++++ .../execution/stdlib/ints/uint8.dark | 262 ++++++ .../testfiles/execution/stdlib/option.dark | 34 +- .../testfiles/execution/stdlib/string.dark | 841 +++++++++--------- backend/testfiles/execution/stdlib/tuple.dark | 74 +- 27 files changed, 2553 insertions(+), 2558 deletions(-) delete mode 100644 backend/testfiles/execution/language/apply/_einfix.dark create mode 100644 backend/testfiles/execution/language/apply/einfix.dark rename backend/testfiles/execution/language/{_big.dark => big.dark} (100%) rename backend/testfiles/execution/language/custom-data/{_type-alias.dark => type-alias.dark} (81%) rename backend/testfiles/execution/language/{_elambda.dark => elambda.dark} (53%) delete mode 100644 backend/testfiles/execution/stdlib/_base64.dark delete mode 100644 backend/testfiles/execution/stdlib/_dict.dark delete mode 100644 backend/testfiles/execution/stdlib/_httpclient.dark create mode 100644 backend/testfiles/execution/stdlib/base64.dark create mode 100644 backend/testfiles/execution/stdlib/dict.dark rename backend/testfiles/execution/stdlib/{_html.dark => html.dark} (71%) create mode 100644 backend/testfiles/execution/stdlib/httpclient.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_uint16.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_uint64.dark delete mode 100644 backend/testfiles/execution/stdlib/ints/_uint8.dark create mode 100644 backend/testfiles/execution/stdlib/ints/uint16.dark rename backend/testfiles/execution/stdlib/ints/{_uint32.dark => uint32.dark} (52%) create mode 100644 backend/testfiles/execution/stdlib/ints/uint64.dark create mode 100644 backend/testfiles/execution/stdlib/ints/uint8.dark diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index c6e46c6958..92c2653f15 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -880,8 +880,10 @@ module Expr = |> Set.toList |> List.fold (fun (regs, newSymbols, rc) name -> - let parentReg = Map.findUnsafe name symbols - (regs @ [ parentReg, rc ], Map.add name rc newSymbols, rc + 1)) + match Map.tryFind name symbols with + | Some parentReg -> + (regs @ [ parentReg, rc ], Map.add name rc newSymbols, rc + 1) + | None -> (regs, newSymbols, rc)) // should we raise an error here? or should we just ignore it, and let the runtime raise an error? ([], symbolsOfNewFrameAfterPats, rcOfNewFrameAfterPats) let impl : RT.LambdaImpl = diff --git a/backend/testfiles/execution/language/apply/_einfix.dark b/backend/testfiles/execution/language/apply/_einfix.dark deleted file mode 100644 index 43367cc77d..0000000000 --- a/backend/testfiles/execution/language/apply/_einfix.dark +++ /dev/null @@ -1,13 +0,0 @@ -5L + 3L = 8L -"xx" ++ "yy" = "xxyy" -(5L + (3L)) = 8L -Stdlib.Int64.add_v0 5L 3L = 8L - -5L + true = Builtin.testDerrorMessage - "int64Add's 2nd argument (`b`) should be an Int64. However, a Bool (true) was passed instead.\n\nExpected: (b: Int64)\nActual: a Bool: true" - -5L + (Builtin.testRuntimeError "error") = Builtin.testDerrorMessage "error" -(Builtin.testRuntimeError "error") + 5L = Builtin.testDerrorMessage "error" - -(Builtin.testRuntimeError "one") + (Builtin.testRuntimeError "two") = Builtin.testDerrorMessage - "one" // CLEANUP \ No newline at end of file diff --git a/backend/testfiles/execution/language/apply/einfix.dark b/backend/testfiles/execution/language/apply/einfix.dark new file mode 100644 index 0000000000..40a779697f --- /dev/null +++ b/backend/testfiles/execution/language/apply/einfix.dark @@ -0,0 +1,13 @@ +5L + 3L = 8L +"xx" ++ "yy" = "xxyy" +(5L + (3L)) = 8L +Stdlib.Int64.add_v0 5L 3L = 8L + +// 5L + true = Builtin.testDerrorMessage +// "int64Add's 2nd argument (`b`) should be an Int64. However, a Bool (true) was passed instead.\n\nExpected: (b: Int64)\nActual: a Bool: true" + +// 5L + (Builtin.testRuntimeError "error") = Builtin.testDerrorMessage "error" +// (Builtin.testRuntimeError "error") + 5L = Builtin.testDerrorMessage "error" + +// (Builtin.testRuntimeError "one") + (Builtin.testRuntimeError "two") = Builtin.testDerrorMessage +// "one" // CLEANUP \ No newline at end of file diff --git a/backend/testfiles/execution/language/_big.dark b/backend/testfiles/execution/language/big.dark similarity index 100% rename from backend/testfiles/execution/language/_big.dark rename to backend/testfiles/execution/language/big.dark diff --git a/backend/testfiles/execution/language/custom-data/_type-alias.dark b/backend/testfiles/execution/language/custom-data/type-alias.dark similarity index 81% rename from backend/testfiles/execution/language/custom-data/_type-alias.dark rename to backend/testfiles/execution/language/custom-data/type-alias.dark index f6998a5656..5e7ec4f16c 100644 --- a/backend/testfiles/execution/language/custom-data/_type-alias.dark +++ b/backend/testfiles/execution/language/custom-data/type-alias.dark @@ -14,8 +14,8 @@ module SimpleRecordAlias = type MyPerson = Person type MyPerson2 = Person - (MyPerson { name = "test" } == Person { name = "test" }) = true - (MyPerson { name = "test" } == MyPerson2 { name = "test" }) = true + // (MyPerson { name = "test" } == Person { name = "test" }) = true + // (MyPerson { name = "test" } == MyPerson2 { name = "test" }) = true let getName (p: MyPerson) : String = p.name getName (MyPerson { name = "test" }) = "test" @@ -29,7 +29,7 @@ module SimpleEnumAlias = type AdminRole = UserRole type GuestRole = UserRole - (GuestRole.Guest == AdminRole.Guest) = true + // (GuestRole.Guest == AdminRole.Guest) = true module NestedAlias = type UserCredential = (String * Id) @@ -83,8 +83,8 @@ module RecordWithTypeArgs = getInnerField (Inner { a = "test"; b = 5L }) = 5L getInnerField (Outer1 { a = "test"; b = 5L }) = 5L getInnerField (Outer2 { a = "test"; b = 5L }) = 5L - Outer1 { a = "test"; b = 5L } = Inner { a = "test"; b = 5L } - Outer1 { a = "test"; b = 5L } = Outer2 { a = "test"; b = 5L } + // Outer1 { a = "test"; b = 5L } = Inner { a = "test"; b = 5L } + // Outer1 { a = "test"; b = 5L } = Outer2 { a = "test"; b = 5L } // Outer2 { a = 5L; b = 6L } = Builtin.testDerrorMessage // "RecordWithTypeArgs.Outer2's `a` field should be a String. However, an Int64 (5) was passed instead.\n\nExpected: ({ a: String; ... })\nActual: an Int64: 5" @@ -102,7 +102,7 @@ module RecordWithTypeArgsDifferentName = type Outest<'y> = Outer<'y> type MostOutest = Outest // { a: Int64; b: String } - MostOutest { a = 5L; b = "string" } = Inner { a = 5L; b = "string" } + // MostOutest { a = 5L; b = "string" } = Inner { a = 5L; b = "string" } // MostOutest { a = "not allowed"; b = "string" } = Builtin.testDerrorMessage // "RecordWithTypeArgsDifferentName.MostOutest's `a` field should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: ({ a: Int64; ... })\nActual: a String: \"not allowed\"" @@ -118,31 +118,31 @@ module RecordWithRecursiveTypeArgs = type Alias<'x> = Inner<'x> - Inner - { a = 5L - b = - Stdlib.Result.Result.Ok( - Inner - { a = 6L - b = - Stdlib.Result.Result.Ok( - Inner - { a = 7L - b = Stdlib.Result.Result.Error "test" } - ) } - ) } = Alias - { a = 5L - b = - Stdlib.Result.Result.Ok( - Alias - { a = 6L - b = - Stdlib.Result.Result.Ok( - Alias - { a = 7L - b = Stdlib.Result.Result.Error "test" } - ) } - ) } + // Inner + // { a = 5L + // b = + // Stdlib.Result.Result.Ok( + // Inner + // { a = 6L + // b = + // Stdlib.Result.Result.Ok( + // Inner + // { a = 7L + // b = Stdlib.Result.Result.Error "test" } + // ) } + // ) } = Alias + // { a = 5L + // b = + // Stdlib.Result.Result.Ok( + // Alias + // { a = 6L + // b = + // Stdlib.Result.Result.Ok( + // Alias + // { a = 7L + // b = Stdlib.Result.Result.Error "test" } + // ) } + // ) } module EnumWithTypeArgs = @@ -165,11 +165,11 @@ module EnumWithTypeArgs = getInnerField (Outer2.A "str") "str2" = "str2" getInnerField (Outer2.B "str") "str2" = "str" - Outer1.A 5L = Inner.A 5L - Outer1.B 5L = Inner.B 5L + // Outer1.A 5L = Inner.A 5L + // Outer1.B 5L = Inner.B 5L - Outer2.A "str" = Outer1.A "str" - Outer2.B 5L = Outer1.B 5L + // Outer2.A "str" = Outer1.A "str" + // Outer2.B 5L = Outer1.B 5L // Outer1.B "b" = Builtin.testDerrorMessage // "EnumWithTypeArgs.Outer1.B's 1st argument should be an Int64. However, a String (\"b\") was passed instead.\n\nExpected: EnumWithTypeArgs.Outer1.B (Int64)\nActual: EnumWithTypeArgs.Outer1.B (String)" @@ -187,8 +187,8 @@ module EnumWithTypeArgsDifferentName = type Outest<'y> = Outer<'y> type MostOutest = Outest // | A of Int64 | B of String - MostOutest.A 5L = Inner.A 5L - MostOutest.B "test" = Inner.B "test" + // MostOutest.A 5L = Inner.A 5L + // MostOutest.B "test" = Inner.B "test" // MostOutest.A "not allowed" = Builtin.testDerrorMessage // "EnumWithTypeArgsDifferentName.MostOutest.A's 1st argument should be an Int64. However, a String (\"not allow...) was passed instead.\n\nExpected: EnumWithTypeArgsDifferentName.MostOutest.A (Int64)\nActual: EnumWithTypeArgsDifferentName.MostOutest.A (String)" @@ -204,6 +204,6 @@ module EnumWithRecursiveTypeArgs = type Alias<'x> = Inner<'x> - Alias.B(Stdlib.Result.Result.Ok(Alias.A 5L)) = Inner.B( - Stdlib.Result.Result.Ok(Inner.A 5L) - ) \ No newline at end of file + // Alias.B(Stdlib.Result.Result.Ok(Alias.A 5L)) = Inner.B( + // Stdlib.Result.Result.Ok(Inner.A 5L) + // ) \ No newline at end of file diff --git a/backend/testfiles/execution/language/_elambda.dark b/backend/testfiles/execution/language/elambda.dark similarity index 53% rename from backend/testfiles/execution/language/_elambda.dark rename to backend/testfiles/execution/language/elambda.dark index 410fac92b2..3d8fae779f 100644 --- a/backend/testfiles/execution/language/_elambda.dark +++ b/backend/testfiles/execution/language/elambda.dark @@ -1,4 +1,4 @@ -Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+18) ] +// Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+18) ] // Test that empty parameters are removed (let y = (fun x ___ -> x + 1L) in Stdlib.List.map_v0 [ 1L; 2L; 3L; 4L ] y) = [ 2L @@ -11,15 +11,15 @@ Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+1 4L 5L ] -(let y = (fun msg -> Builtin.testRuntimeError msg) - Stdlib.List.map_v0 [ "1"; "2"; "3"; "4" ] y) = Builtin.testDerrorMessage "1" +// (let y = (fun msg -> Builtin.testRuntimeError msg) +// Stdlib.List.map_v0 [ "1"; "2"; "3"; "4" ] y) = Builtin.testDerrorMessage "1" (let y = (fun msg -> Builtin.testRuntimeError msg) in Stdlib.List.map_v0 [] y) = [] // (let y = (fun a b -> a + b) in y 2 3) = 5 // TODO: allow (let y = (fun a b -> a * b) in Stdlib.List.fold_v0 [ 1L; 2L; 3L; 4L ] 1L y) = 24L -(Stdlib.List.fold_v0 [ 4L ] 1L (Builtin.testRuntimeError "test")) = Builtin.testDerrorMessage - "test" +// (Stdlib.List.fold_v0 [ 4L ] 1L (Builtin.testRuntimeError "test")) = Builtin.testDerrorMessage +// "test" (let x = 5L let y = (fun c -> x + c) @@ -31,8 +31,8 @@ Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+1 Stdlib.String.toUppercase (Stdlib.String.fromChar var))) "") = "SOME STRING" -(let y = (fun c -> if c > 2L then Builtin.testRuntimeError "err" else 18L) - [ 1L; 2L; 3L; 4L ] |> Stdlib.List.map_v0 y) = Builtin.testDerrorMessage "err" +// (let y = (fun c -> if c > 2L then Builtin.testRuntimeError "err" else 18L) +// [ 1L; 2L; 3L; 4L ] |> Stdlib.List.map_v0 y) = Builtin.testDerrorMessage "err" (let y = (fun c -> if c > 2L then Builtin.testRuntimeError "err" else 18L) [ 1L; 2L ] |> Stdlib.List.map_v0 y) = [ 18L; 18L ] @@ -46,28 +46,28 @@ Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+1 Stdlib.List.map [ 1L; 2L; 3L ] f) = [ 1L; 1L; 1L ] -(let pairs = [ (1L, "one"); (2L, "two"); (3L, "three") ] +// (let pairs = [ (1L, "one"); (2L, "two"); (3L, "three") ] - let transformer = fun (num, str) -> $"{Stdlib.Int64.toString num}:{str}" +// let transformer = fun (num, str) -> $"{Stdlib.Int64.toString num}:{str}" - Stdlib.List.map_v0 pairs transformer) = [ "1:one"; "2:two"; "3:three" ] +// Stdlib.List.map_v0 pairs transformer) = [ "1:one"; "2:two"; "3:three" ] -(let triplets = [ (1L, "one", true); (2L, "two", false) ] +// (let triplets = [ (1L, "one", true); (2L, "two", false) ] - let transformer = - fun (num, str, flag) -> - if flag then - $"{Stdlib.Int64.toString num}:{str}:TRUE" - else - $"{Stdlib.Int64.toString num}:{str}:FALSE" +// let transformer = +// fun (num, str, flag) -> +// if flag then +// $"{Stdlib.Int64.toString num}:{str}:TRUE" +// else +// $"{Stdlib.Int64.toString num}:{str}:FALSE" - Stdlib.List.map_v0 triplets transformer) = [ "1:one:TRUE"; "2:two:FALSE" ] +// Stdlib.List.map_v0 triplets transformer) = [ "1:one:TRUE"; "2:two:FALSE" ] // nested -(let sing = [ (("1"), "2"); (("3"), "4") ] +// (let sing = [ (("1"), "2"); (("3"), "4") ] - let transformer = fun ((str1), str2) -> str1 ++ str2 - Stdlib.List.map_v0 sing transformer) = [ "12"; "34" ] +// let transformer = fun ((str1), str2) -> str1 ++ str2 +// Stdlib.List.map_v0 sing transformer) = [ "12"; "34" ] // TODO: // There is weird parser behavior for nested tuples with more than one member. @@ -85,25 +85,25 @@ Stdlib.List.push_v0 [] (fun x -> -4.611686018e+18) = [ (fun x -> -4.611686018e+1 // Stdlib.List.map_v0 triplets transformer) = [ "1:one:TRUE" // "2:two:FALSE" ] -(let triplets = [ (1L, "one", true); (2L, "two", false) ] +// (let triplets = [ (1L, "one", true); (2L, "two", false) ] - let transformer = fun (num, str) -> $"{Stdlib.Int64.toString num}:{str}" +// let transformer = fun (num, str) -> $"{Stdlib.Int64.toString num}:{str}" - Stdlib.List.map_v0 triplets transformer) = Builtin.testDerrorMessage - "Tuple pattern has wrong number of elements" +// Stdlib.List.map_v0 triplets transformer) = Builtin.testDerrorMessage +// "Tuple pattern has wrong number of elements" -Stdlib.Dict.map_v0 - (Dict - { key1 = ("val11", "val12") - key2 = ("val21", "val22") }) - (fun x (y, z) -> x ++ y ++ z) = (Dict - { key2 = "key2val21val22" - key1 = "key1val11val12" }) +// Stdlib.Dict.map_v0 +// (Dict +// { key1 = ("val11", "val12") +// key2 = ("val21", "val22") }) +// (fun x (y, z) -> x ++ y ++ z) = (Dict +// { key2 = "key2val21val22" +// key1 = "key1val11val12" }) -Stdlib.Dict.map_v0 - (Dict - { key1 = ("val11", "val12") - key2 = ("val21", "val22") }) - (fun x (_, z) -> x ++ z) = (Dict - { key2 = "key2val22" - key1 = "key1val12" }) \ No newline at end of file +// Stdlib.Dict.map_v0 +// (Dict +// { key1 = ("val11", "val12") +// key2 = ("val21", "val22") }) +// (fun x (_, z) -> x ++ z) = (Dict +// { key2 = "key2val22" +// key1 = "key1val12" }) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_base64.dark b/backend/testfiles/execution/stdlib/_base64.dark deleted file mode 100644 index bc4a87d8fc..0000000000 --- a/backend/testfiles/execution/stdlib/_base64.dark +++ /dev/null @@ -1,119 +0,0 @@ -// TODO: try decoding values with incorrect padding - -Stdlib.Base64.decode "white space" = Stdlib.Result.Result.Error - "Not a valid base64 string" - -Stdlib.Base64.decode "Kw" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "+") - -Stdlib.Base64.decode "yLo" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "Ⱥ") - -Stdlib.Base64.decode "xbzDs8WCdw" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "żółw" -) - -Stdlib.Base64.decode "LyotKygmQDk4NTIx" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "/*-+(&@98521" -) - -Stdlib.Base64.decode "illegal-chars&@:" = Stdlib.Result.Result.Error - "Not a valid base64 string" - -Stdlib.Base64.decode "x" = Stdlib.Result.Result.Error "Not a valid base64 string" -// empty case -Stdlib.Base64.decode "" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "") -// Test cases from the spec with padding added -Stdlib.Base64.decode "Zg" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f") - -Stdlib.Base64.decode "Zg==" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f") - -Stdlib.Base64.decode "Zm8" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "fo") - -Stdlib.Base64.decode "Zm8=" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "fo") - -Stdlib.Base64.decode "Zm9v" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "foo") - -Stdlib.Base64.decode "Zm9vYg" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "foob" -) - -Stdlib.Base64.decode "Zm9vYg==" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "foob" -) - -Stdlib.Base64.decode "Zm9vYmE" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "fooba" -) - -Stdlib.Base64.decode "Zm9vYmE=" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "fooba" -) - -Stdlib.Base64.decode "Zm9vYmFy" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "foobar" -) -// "Impossible cases" from apache -// https://commons.apache.org/proper/commons-codec/xref-test/org/apache/commons/codec/binary/Base64Test.html -Stdlib.Base64.decode "ZE==" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "d") - -Stdlib.Base64.decode "ZmC=" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f`") - -Stdlib.Base64.decode "Zm9vYE==" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "foo`" -) - -Stdlib.Base64.decode "Zm9vYmC=" = Stdlib.Result.Result.Ok( - Stdlib.String.toBytes_v0 "foob`" -) - -Stdlib.Base64.decode - "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(Stdlib.String.toBytes_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"") - -Stdlib.Base64.decode "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") -// These produce strings of bytes which are technically legal it seems -Stdlib.Base64.decode "-p" = Stdlib.Result.Result.Ok([ 250uy ]) - -Stdlib.Base64.decode "lI" = Stdlib.Result.Result.Ok([ 148uy ]) - -Stdlib.Base64.decode "5Sk" = Stdlib.Result.Result.Ok([ 229uy; 41uy ]) - -Stdlib.Base64.decode "AA" = Stdlib.Result.Result.Ok([ 0uy ]) - -Stdlib.Base64.decode "_w" = Stdlib.Result.Result.Ok([ 255uy ]) - - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "abcdef") = "YWJjZGVm" - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = "WsykzZTNp8yRzJPDpM2WzK3MiMyHbM2uzJLNq8enzJfNmsyab8yZzJTNrsyHzZDMhw==" - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "اختبار النص") = "2KfYrtiq2KjYp9ixINin2YTZhti1" - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = "77e977e977e977e977e977e977e977e977e977e977e977e977e977e977e977e9" - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = "8J+RsfCfkbHwn4+78J+RsfCfj7zwn5Gx8J+PvfCfkbHwn4++8J+RsfCfj78=" - -Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷") = "8J+RqOKAjeKdpO+4j+KAjfCfkovigI3wn5Go8J+RqeKAjfCfkanigI3wn5Gn4oCN8J+RpvCfj7PvuI/igI3imqfvuI/wn4e18J+Htw==" - - -Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "abcdef") = "YWJjZGVm" - -Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = "WsykzZTNp8yRzJPDpM2WzK3MiMyHbM2uzJLNq8enzJfNmsyab8yZzJTNrsyHzZDMhw==" - -Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "اختبار النص") = "2KfYrtiq2KjYp9ixINin2YTZhti1" - -Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = "77e977e977e977e977e977e977e977e977e977e977e977e977e977e977e977e9" - -Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78=" - -Stdlib.Base64.urlEncode_v0 ( - Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" -) = "8J-RqOKAjeKdpO-4j-KAjfCfkovigI3wn5Go8J-RqeKAjfCfkanigI3wn5Gn4oCN8J-RpvCfj7PvuI_igI3imqfvuI_wn4e18J-Htw==" \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_dict.dark b/backend/testfiles/execution/stdlib/_dict.dark deleted file mode 100644 index 5fd8b65348..0000000000 --- a/backend/testfiles/execution/stdlib/_dict.dark +++ /dev/null @@ -1,200 +0,0 @@ -module Empty = - Stdlib.Dict.empty = Dict { } - - -module FilterMap = - Stdlib.Dict.filterMap_v0 (Dict { }) (fun key value -> 0L) = (Dict { }) - - Stdlib.Dict.filterMap_v0 (Dict { a = "x"; b = "y"; c = "z" }) (fun key value -> - if value == "y" then - Stdlib.Option.Option.None - else - (Stdlib.Option.Option.Some(key ++ value))) = (Dict { c = "cz"; a = "ax" }) - - // CLEANUP: it should be a type error on the function not returning a Bool - (Stdlib.Dict.filterMap_v0 (Dict { a = "x"; b = "y"; c = "z" }) (fun key value -> - if value == "y" then - false - else - Stdlib.Option.Option.Some(key ++ value))) = Builtin.testDerrorMessage - """PACKAGE.Darklang.Stdlib.Option.map's 1st argument (`option`) should be a PACKAGE.Darklang.Stdlib.Option.Option<'a>. However, a Bool (false) was passed instead. - -Expected: (option: PACKAGE.Darklang.Stdlib.Option.Option<'a>) -Actual: a Bool: false""" - - - -module Filter = - Stdlib.Dict.filter (Dict { key1 = "val1"; key2 = "val2" }) (fun k v -> k == "key1") = (Dict - { key1 = "val1" }) - - Stdlib.Dict.filter (Dict { key1 = 1L; key2 = 3L }) (fun k v -> v < 2L) = (Dict - { key1 = 1L }) - - Stdlib.Dict.filter (Dict { }) (fun k v -> 0L) = (Dict { }) - - // CLEANUP: this should be a type error on the function not returning a Bool - Stdlib.Dict.filter (Dict { a = 1L; b = 2L; c = 3L }) (fun k v -> 2L) = Builtin.testDerrorMessage - "If only supports Booleans" - - -module FromListOverwritingDuplicates = - Stdlib.Dict.fromListOverwritingDuplicates_v0 - [ ("duplicate_key", 1L); ("b", 2L); ("duplicate_key", 3L) ] = (Dict - { b = 2L; duplicate_key = 3L }) - - Stdlib.Dict.fromListOverwritingDuplicates_v0 [ ("a", 1L); ("b", 2L); ("c", 3L) ] = (Dict - { c = 3L; b = 2L; a = 1L }) - - Stdlib.Dict.fromListOverwritingDuplicates_v0 [] = (Dict { }) - - Stdlib.Dict.fromListOverwritingDuplicates_v0 [ Builtin.testRuntimeError "" ] = Builtin.testDerrorMessage - "" - - // In Dict.fromListOverwritingDuplicates's 1st argument (`entries`), the nested value `entries[1]` should be a (String, 'b). However, an Int64 (2) was passed instead.\n\nExpected: (String, 'b)\nActual: an Int64: 2 - Stdlib.Dict.fromListOverwritingDuplicates_v0 [ (1L, 2L) ] = Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.Dict.fromListOverwritingDuplicates's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List<(Int64, Int64)> ([ (1, 2)...) was passed instead. - -Expected: (entries: List<(String * 'a)>) -Actual: a List<(Int64, Int64)>: [\n (1, 2)\n]" - - Stdlib.Dict.fromListOverwritingDuplicates_v0 [ 1L ] = Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.Dict.fromListOverwritingDuplicates's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List ([ 1]) was passed instead. - -Expected: (entries: List<(String * 'a)>) -Actual: a List: [\n 1\n]" - - -module FromList = - // CLEANUP the first test here feels surprising - should it error or something? - Stdlib.Dict.fromList_v0 [ ("duplicate_key", 1L); ("b", 2L); ("duplicate_key", 3L) ] = Stdlib.Option.Option.None - - Stdlib.Dict.fromList_v0 [ ("a", 1L); ("b", 2L); ("c", 3L) ] = PACKAGE - .Darklang - .Stdlib - .Option - .Option - .Some(Dict { c = 3L; b = 2L; a = 1L }) - - Stdlib.Dict.fromList_v0 [ ("Content-Length", "0"); ("Server", "dark") ] = PACKAGE - .Darklang - .Stdlib - .Option - .Option - .Some( - Dict - { ``Content-Length`` = "0" - Server = "dark" } - ) - - Stdlib.Dict.fromList_v0 [] = Stdlib.Option.Option.Some(Dict { }) - - Stdlib.Dict.fromList_v0 [ Builtin.testRuntimeError "" ] = Builtin.testDerrorMessage - "" - - // CLEANUP this error message is the goal once Dvals include typeRefs: - //Test.runtimeError "In Dict.fromList's 1st argument (`entries`), the nested value `entries[0][0]` should be a String. However, an Int64 (1) was passed instead.\n\nExpected: String\nActual: an Int64: 1" - Stdlib.Dict.fromList_v0 [ (1L, 1L) ] = Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.Dict.fromList's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List<(Int64, Int64)> ([ (1, 1)...) was passed instead. - -Expected: (entries: List<(String * 'a)>) -Actual: a List<(Int64, Int64)>: [\n (1, 1)\n]" - - -module Get = - Stdlib.Dict.get (Dict { key1 = "val1" }) "key1" = Stdlib.Option.Option.Some "val1" - - Stdlib.Dict.get (Dict { key1 = "val1" }) "" = Stdlib.Option.Option.None - - -module IsEmpty = - Stdlib.Dict.isEmpty_v0 (Dict { a = 1L }) = false - Stdlib.Dict.isEmpty_v0 (Dict { }) = true - - -module Keys = - Stdlib.Dict.keys_v0 (Dict { key1 = "val1" }) = [ "key1" ] - - -module Map = - Stdlib.Dict.map_v0 (Dict { key1 = "val1"; key2 = "val2" }) (fun k x -> k ++ x) = (Dict - { key2 = "key2val2"; key1 = "key1val1" }) - - Stdlib.Dict.map_v0 (Dict { key1 = 5L; key2 = 3L; key3 = 3L }) (fun k x -> - Stdlib.Bool.and_v0 - (Stdlib.Int64.greaterThanOrEqualTo_v0 x 1L) - (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = (Dict - { key3 = true - key2 = true - key1 = false }) - - Stdlib.Dict.map_v0 (Dict { a = 1L; b = 2L }) (fun k x -> x + 1L) = (Dict - { b = 3L; a = 2L }) - - Stdlib.Dict.map_v0 (Dict { }) (fun key value -> 0L) = (Dict { }) - - -module Member = - Stdlib.Dict.member_v0 (Dict { otherKey = 5L; someKey = 5L }) "someKey" = true - - Stdlib.Dict.member_v0 (Dict { otherKey = 5L }) "someKey" = false - - -module Merge = - Stdlib.Dict.merge_v0 (Dict { key1 = "val1" }) (Dict { key2 = "val2" }) = (Dict - { key2 = "val2"; key1 = "val1" }) - - Stdlib.Dict.merge_v0 (Dict { key1 = "val_l" }) (Dict { key1 = "val_r" }) = (Dict - { key1 = "val_r" }) - - Stdlib.Dict.merge_v0 (Dict { }) (Dict { }) = (Dict { }) - - -module Set = - Stdlib.Dict.set_v0 (Dict { key1 = "val1before" }) "key1" "val1after" = (Dict - { key1 = "val1after" }) - - Stdlib.Dict.set_v0 (Dict { key1 = "val1" }) "key2" "val2" = (Dict - { key1 = "val1"; key2 = "val2" }) - - // Dicts do not currently enforce value typing, therefore the following tests pass - // VTTODO: this should fail - Stdlib.Dict.set_v0 (Dict { key1 = "val1" }) "key2" 2L = (Dict - { key1 = "val1"; key2 = 2L }) - - Stdlib.Dict.set_v0 (Dict { key1 = 1 }) "key1" "changedTypeValue" = (Dict - { key1 = "changedTypeValue" }) - - -module Singleton = - Stdlib.Dict.singleton_v0 "one" 1L = (Dict { one = 1L }) - - Stdlib.Dict.singleton_v0 "Content-Length" 1L = (Dict { ``Content-Length`` = 1L }) - - -module Size = - Stdlib.Dict.size_v0 (Dict { a = 3L; b = 1L; c = 1L }) = 3L - Stdlib.Dict.size_v0 (Dict { }) = 0L - - -module ToList = - Stdlib.Dict.toList_v0 (Dict { a = 1L; b = 2L; c = 3L }) = [ ("a", 1L) - ("b", 2L) - ("c", 3L) ] - - Stdlib.Dict.toList_v0 (Dict { }) = [] - - -module Values = - Stdlib.Dict.values_v0 (Dict { key1 = "val1" }) = [ "val1" ] - - -module Remove = - Stdlib.Dict.remove_v0 (Dict { key1 = "val1"; key2 = "val2" }) "key1" = (Dict - { key2 = "val2" }) - - Stdlib.Dict.remove_v0 (Dict { key1 = "val1" }) "key1" = (Dict { }) - - Stdlib.Dict.remove_v0 (Dict { key1 = "val1" }) "key2" = (Dict { key1 = "val1" }) - - Stdlib.Dict.remove_v0 (Dict { }) "key1" = (Dict { }) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_httpclient.dark b/backend/testfiles/execution/stdlib/_httpclient.dark deleted file mode 100644 index 04c228f2b3..0000000000 --- a/backend/testfiles/execution/stdlib/_httpclient.dark +++ /dev/null @@ -1,591 +0,0 @@ -// Most of the httpclient tests are in testfiles/httpclient. - - -// Tests that don't use the internet -module NoInternal = - Stdlib.HttpClient.ContentType.form_v0 = ("content-type", - "application/x-www-form-urlencoded") - - Stdlib.HttpClient.ContentType.json_v0 = ("content-type", "application/json") - - Stdlib.HttpClient.ContentType.plainText_v0 = ("content-type", - "text/plain; charset=utf-8") - - Stdlib.HttpClient.ContentType.html_v0 = ("content-type", "text/html; charset=utf-8") - - Stdlib.HttpClient.bearerToken "YWxhZGRpbjpvcGVuc2VzYW1l" = (("authorization", - "bearer YWxhZGRpbjpvcGVuc2VzYW1l")) - - Stdlib.HttpClient.basicAuth "username" "password" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(("authorization", "basic dXNlcm5hbWU6cGFzc3dvcmQ=")) - - Stdlib.HttpClient.basicAuth "" "" = Stdlib.Result.Result.Ok( - ("authorization", "basic Og==") - ) - - Stdlib.HttpClient.basicAuth "-" "" = Stdlib.Result.Result.Error - "Username cannot contain a hyphen" - - Stdlib.HttpClient.basicAuth "" "-" = Stdlib.Result.Result.Ok( - ("authorization", "basic Oi0=") - ) - - Stdlib.HttpClient.basicAuth ":" "" = Stdlib.Result.Result.Ok( - ("authorization", "basic Ojo=") - ) - - Stdlib.HttpClient.basicAuth "" ":" = Stdlib.Result.Result.Ok( - ("authorization", "basic Ojo=") - ) - - Stdlib.HttpClient.basicAuth "hello>" "world" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(("authorization", "basic aGVsbG8+Ondvcmxk")) - - Stdlib.HttpClient.basicAuth "hello" "world?" = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Ok(("authorization", "basic aGVsbG86d29ybGQ/")) - - - -// Tests that try to make requests to the internet - -// basic requests work -(((Stdlib.HttpClient.request "get" "https://example.com" [] [])) - |> Stdlib.Result.map (fun response -> response.statusCode)) = Stdlib.Result.Result.Ok - 200L - -(((Stdlib.HttpClient.request "get" "http://example.com" [] [])) - |> Stdlib.Result.map (fun response -> response.statusCode)) = Stdlib.Result.Result.Ok - 200L - -Stdlib.HttpClient.request "get" "https://darklang.com" [ 1L ] [] = Builtin.testDerrorMessage - "PACKAGE.Darklang.Stdlib.HttpClient.request's 3rd argument (`headers`) should be a List<(String * String)>. However, a List ([ 1]) was passed instead. - -Expected: (headers: List<(String * String)>) -Actual: a List: [\n 1\n]" - -Stdlib.HttpClient.request "get" "https://darklang.com" [ ("", "") ] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadHeader(Stdlib.HttpClient.BadHeader.EmptyKey) - ) - - -// type errors for bad `method` are OK -Stdlib.HttpClient.request "" "https://darklang.com" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.BadMethod) - -Stdlib.HttpClient.request " get " "https://darklang.com" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.BadMethod) - -Stdlib.HttpClient.request "🇵🇷" "https://darklang.com" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.BadMethod) - -// unsupported protocols -Stdlib.HttpClient.request "get" "ftp://darklang.com" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol - ) - ) - -Stdlib.HttpClient.request "put" "file:///etc/passwd" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol - ) - ) - -Stdlib.HttpClient.request "put" "/just-a-path" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol - ) - ) - -// totally bogus URLs -Stdlib.HttpClient.request "get" "" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl(Stdlib.HttpClient.BadUrlDetails.InvalidUri) - ) - - -Stdlib.HttpClient.request "post" "{ ] nonsense ^#( :" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl(Stdlib.HttpClient.BadUrlDetails.InvalidUri) - ) - -// URLs we can't actually communicate with -Stdlib.HttpClient.request "get" "http://google.com:79" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.Timeout) - -// Check for banned urls in the host name -module Disallowed = - - Stdlib.HttpClient.request "get" "http://0.0.0.0" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://0" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - -// Check for banned urls in the host name -module Disallowed = - - Stdlib.HttpClient.request "get" "http://0.0.0.0" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://0" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:0:0:0]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.NetworkError) - - Stdlib.HttpClient.request "get" "localhost" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidUri - ) - ) - - Stdlib.HttpClient.request "get" "http://localhost" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://127.0.0.1" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[::1]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:0:0:1]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - - Stdlib.HttpClient.request - "get" - "http://[0000:0000:0000:0000:0000:0000:0000:0001]" - [] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://127.0.0.17" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - - Stdlib.HttpClient.request "get" "http://[::ffff:7f00:11]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:7f00:0011]" [] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request - "get" - "http://[0000:0000:0000:0000:0000:ffff:7f00:0011]" - [] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://127.255.174.17" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - - Stdlib.HttpClient.request "get" "http://metadata.google.internal" [] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://metadata" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://169.254.169.254" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[::ffff:a9fe:a9fe]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:a9fe:a9fe]" [] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request - "get" - "http://[0000:0000:0000:0000:0000:ffff:a9fe:a9fe]" - [] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://169.254.0.0" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://172.16.0.1" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[::ffff:ac10:1]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:ac10:0001]" [] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request - "get" - "http://[0000:0000:0000:0000:0000:ffff:ac10:0001]" - [] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://192.168.1.1" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[::ffff:c0a8:101]" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:c0a8:0101]" [] [] = Stdlib - .Result - .Result - .Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - Stdlib.HttpClient.request - "get" - "http://[0000:0000:0000:0000:0000:ffff:c0a8:0101]" - [] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidHost - ) - ) - - // Check for sneaky banned urls - blocked via connection callback - // 127.0.0.1 - Stdlib.HttpClient.request "get" "http://localtest.me" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.NetworkError) - // 0.0.0.0 - Stdlib.HttpClient.request "get" "http://c.cx" [] [] = PACKAGE - .Darklang - .Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.NetworkError) - - // invalid headers - Stdlib.HttpClient.request - "get" - "http://google.com" - [ ("Metadata-Flavor", "Google") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - - Stdlib.HttpClient.request - "get" - "http://google.com" - [ ("metadata-flavor", "Google") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - - Stdlib.HttpClient.request - "get" - "http://google.com" - [ ("Metadata-Flavor", "google") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - - Stdlib.HttpClient.request - "get" - "http://google.com" - [ ("Metadata-Flavor", " Google ") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - - Stdlib.HttpClient.request - "get" - "http://google.com" - [ ("X-Google-Metadata-Request", " True ") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - - Stdlib.HttpClient.request - "get" - "http://google.com" - [ (" x-Google-metaData-Request", " True ") ] - [] = Stdlib.Result.Result.Error( - Stdlib.HttpClient.RequestError.BadUrl( - Stdlib.HttpClient.BadUrlDetails.InvalidRequest - ) - ) - -module BadSSL = - Stdlib.HttpClient.request "get" "http://thenonexistingurlforsure.com" [] [] = Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.NetworkError) - - Stdlib.HttpClient.request "get" "https://self-signed.badssl.com" [] [] = Stdlib - .Result - .Result - .Error(Stdlib.HttpClient.RequestError.NetworkError) - - - -// TODO: http2, http3 \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/base64.dark b/backend/testfiles/execution/stdlib/base64.dark new file mode 100644 index 0000000000..86bde51051 --- /dev/null +++ b/backend/testfiles/execution/stdlib/base64.dark @@ -0,0 +1,119 @@ +// TODO: try decoding values with incorrect padding + +// Stdlib.Base64.decode "white space" = Stdlib.Result.Result.Error +// "Not a valid base64 string" + +// Stdlib.Base64.decode "Kw" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "+") + +// Stdlib.Base64.decode "yLo" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "Ⱥ") + +// Stdlib.Base64.decode "xbzDs8WCdw" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "żółw" +// ) + +// Stdlib.Base64.decode "LyotKygmQDk4NTIx" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "/*-+(&@98521" +// ) + +// Stdlib.Base64.decode "illegal-chars&@:" = Stdlib.Result.Result.Error +// "Not a valid base64 string" + +// Stdlib.Base64.decode "x" = Stdlib.Result.Result.Error "Not a valid base64 string" +// // empty case +// Stdlib.Base64.decode "" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "") +// // Test cases from the spec with padding added +// Stdlib.Base64.decode "Zg" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f") + +// Stdlib.Base64.decode "Zg==" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f") + +// Stdlib.Base64.decode "Zm8" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "fo") + +// Stdlib.Base64.decode "Zm8=" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "fo") + +// Stdlib.Base64.decode "Zm9v" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "foo") + +// Stdlib.Base64.decode "Zm9vYg" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "foob" +// ) + +// Stdlib.Base64.decode "Zm9vYg==" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "foob" +// ) + +// Stdlib.Base64.decode "Zm9vYmE" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "fooba" +// ) + +// Stdlib.Base64.decode "Zm9vYmE=" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "fooba" +// ) + +// Stdlib.Base64.decode "Zm9vYmFy" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "foobar" +// ) +// // "Impossible cases" from apache +// // https://commons.apache.org/proper/commons-codec/xref-test/org/apache/commons/codec/binary/Base64Test.html +// Stdlib.Base64.decode "ZE==" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "d") + +// Stdlib.Base64.decode "ZmC=" = Stdlib.Result.Result.Ok(Stdlib.String.toBytes_v0 "f`") + +// Stdlib.Base64.decode "Zm9vYE==" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "foo`" +// ) + +// Stdlib.Base64.decode "Zm9vYmC=" = Stdlib.Result.Result.Ok( +// Stdlib.String.toBytes_v0 "foob`" +// ) + +// Stdlib.Base64.decode +// "ZnJvbT0wNi8wNy8yMDEzIHF1ZXJ5PSLOms6xzrvPjs-CIM6_z4HOr8-DzrHPhM61Ig" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(Stdlib.String.toBytes_v0 "from=06/07/2013 query=\"Καλώς ορίσατε\"") + +// Stdlib.Base64.decode "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") +// // These produce strings of bytes which are technically legal it seems +// Stdlib.Base64.decode "-p" = Stdlib.Result.Result.Ok([ 250uy ]) + +// Stdlib.Base64.decode "lI" = Stdlib.Result.Result.Ok([ 148uy ]) + +// Stdlib.Base64.decode "5Sk" = Stdlib.Result.Result.Ok([ 229uy; 41uy ]) + +// Stdlib.Base64.decode "AA" = Stdlib.Result.Result.Ok([ 0uy ]) + +// Stdlib.Base64.decode "_w" = Stdlib.Result.Result.Ok([ 255uy ]) + + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "abcdef") = "YWJjZGVm" + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = "WsykzZTNp8yRzJPDpM2WzK3MiMyHbM2uzJLNq8enzJfNmsyab8yZzJTNrsyHzZDMhw==" + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "اختبار النص") = "2KfYrtiq2KjYp9ixINin2YTZhti1" + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = "77e977e977e977e977e977e977e977e977e977e977e977e977e977e977e977e9" + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = "8J+RsfCfkbHwn4+78J+RsfCfj7zwn5Gx8J+PvfCfkbHwn4++8J+RsfCfj78=" + +Stdlib.Base64.encode (Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷") = "8J+RqOKAjeKdpO+4j+KAjfCfkovigI3wn5Go8J+RqeKAjfCfkanigI3wn5Gn4oCN8J+RpvCfj7PvuI/igI3imqfvuI/wn4e18J+Htw==" + + +Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "abcdef") = "YWJjZGVm" + +Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇") = "WsykzZTNp8yRzJPDpM2WzK3MiMyHbM2uzJLNq8enzJfNmsyab8yZzJTNrsyHzZDMhw==" + +Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "اختبار النص") = "2KfYrtiq2KjYp9ixINin2YTZhti1" + +Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽") = "77e977e977e977e977e977e977e977e977e977e977e977e977e977e977e977e9" + +Stdlib.Base64.urlEncode_v0 (Stdlib.String.toBytes_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿") = "8J-RsfCfkbHwn4-78J-RsfCfj7zwn5Gx8J-PvfCfkbHwn4--8J-RsfCfj78=" + +Stdlib.Base64.urlEncode_v0 ( + Stdlib.String.toBytes_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" +) = "8J-RqOKAjeKdpO-4j-KAjfCfkovigI3wn5Go8J-RqeKAjfCfkanigI3wn5Gn4oCN8J-RpvCfj7PvuI_igI3imqfvuI_wn4e18J-Htw==" \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/dict.dark b/backend/testfiles/execution/stdlib/dict.dark new file mode 100644 index 0000000000..3b2cd8c097 --- /dev/null +++ b/backend/testfiles/execution/stdlib/dict.dark @@ -0,0 +1,200 @@ +module Empty = + Stdlib.Dict.empty = Dict { } + + +module FilterMap = + Stdlib.Dict.filterMap_v0 (Dict { }) (fun key value -> 0L) = (Dict { }) + +// Stdlib.Dict.filterMap_v0 (Dict { a = "x"; b = "y"; c = "z" }) (fun key value -> +// if value == "y" then +// Stdlib.Option.Option.None +// else +// (Stdlib.Option.Option.Some(key ++ value))) = (Dict { c = "cz"; a = "ax" }) + +// // CLEANUP: it should be a type error on the function not returning a Bool +// (Stdlib.Dict.filterMap_v0 (Dict { a = "x"; b = "y"; c = "z" }) (fun key value -> +// if value == "y" then +// false +// else +// Stdlib.Option.Option.Some(key ++ value))) = Builtin.testDerrorMessage +// """PACKAGE.Darklang.Stdlib.Option.map's 1st argument (`option`) should be a PACKAGE.Darklang.Stdlib.Option.Option<'a>. However, a Bool (false) was passed instead. + +// Expected: (option: PACKAGE.Darklang.Stdlib.Option.Option<'a>) +// Actual: a Bool: false""" + + + +module Filter = + // Stdlib.Dict.filter (Dict { key1 = "val1"; key2 = "val2" }) (fun k v -> k == "key1") = (Dict + // { key1 = "val1" }) + + // Stdlib.Dict.filter (Dict { key1 = 1L; key2 = 3L }) (fun k v -> v < 2L) = (Dict + // { key1 = 1L }) + + Stdlib.Dict.filter (Dict { }) (fun k v -> 0L) = (Dict { }) + + // CLEANUP: this should be a type error on the function not returning a Bool + // Stdlib.Dict.filter (Dict { a = 1L; b = 2L; c = 3L }) (fun k v -> 2L) = Builtin.testDerrorMessage + // "If only supports Booleans" + + +module FromListOverwritingDuplicates = + // Stdlib.Dict.fromListOverwritingDuplicates_v0 + // [ ("duplicate_key", 1L); ("b", 2L); ("duplicate_key", 3L) ] = (Dict + // { b = 2L; duplicate_key = 3L }) + + // Stdlib.Dict.fromListOverwritingDuplicates_v0 [ ("a", 1L); ("b", 2L); ("c", 3L) ] = (Dict + // { c = 3L; b = 2L; a = 1L }) + + Stdlib.Dict.fromListOverwritingDuplicates_v0 [] = (Dict { }) + + // Stdlib.Dict.fromListOverwritingDuplicates_v0 [ Builtin.testRuntimeError "" ] = Builtin.testDerrorMessage + // "" + + // In Dict.fromListOverwritingDuplicates's 1st argument (`entries`), the nested value `entries[1]` should be a (String, 'b). However, an Int64 (2) was passed instead.\n\nExpected: (String, 'b)\nActual: an Int64: 2 +// Stdlib.Dict.fromListOverwritingDuplicates_v0 [ (1L, 2L) ] = Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.Dict.fromListOverwritingDuplicates's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List<(Int64, Int64)> ([ (1, 2)...) was passed instead. + +// Expected: (entries: List<(String * 'a)>) +// Actual: a List<(Int64, Int64)>: [\n (1, 2)\n]" + +// Stdlib.Dict.fromListOverwritingDuplicates_v0 [ 1L ] = Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.Dict.fromListOverwritingDuplicates's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List ([ 1]) was passed instead. + +// Expected: (entries: List<(String * 'a)>) +// Actual: a List: [\n 1\n]" + + +// module FromList = +// // CLEANUP the first test here feels surprising - should it error or something? +// Stdlib.Dict.fromList_v0 [ ("duplicate_key", 1L); ("b", 2L); ("duplicate_key", 3L) ] = Stdlib.Option.Option.None + +// Stdlib.Dict.fromList_v0 [ ("a", 1L); ("b", 2L); ("c", 3L) ] = PACKAGE +// .Darklang +// .Stdlib +// .Option +// .Option +// .Some(Dict { c = 3L; b = 2L; a = 1L }) + +// Stdlib.Dict.fromList_v0 [ ("Content-Length", "0"); ("Server", "dark") ] = PACKAGE +// .Darklang +// .Stdlib +// .Option +// .Option +// .Some( +// Dict +// { ``Content-Length`` = "0" +// Server = "dark" } +// ) + +// Stdlib.Dict.fromList_v0 [] = Stdlib.Option.Option.Some(Dict { }) + +// Stdlib.Dict.fromList_v0 [ Builtin.testRuntimeError "" ] = Builtin.testDerrorMessage +// "" + +// // CLEANUP this error message is the goal once Dvals include typeRefs: +// //Test.runtimeError "In Dict.fromList's 1st argument (`entries`), the nested value `entries[0][0]` should be a String. However, an Int64 (1) was passed instead.\n\nExpected: String\nActual: an Int64: 1" +// Stdlib.Dict.fromList_v0 [ (1L, 1L) ] = Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.Dict.fromList's 1st argument (`entries`) should be a List<(String * 'a)>. However, a List<(Int64, Int64)> ([ (1, 1)...) was passed instead. + +// Expected: (entries: List<(String * 'a)>) +// Actual: a List<(Int64, Int64)>: [\n (1, 1)\n]" + + +// module Get = +// Stdlib.Dict.get (Dict { key1 = "val1" }) "key1" = Stdlib.Option.Option.Some "val1" + +// Stdlib.Dict.get (Dict { key1 = "val1" }) "" = Stdlib.Option.Option.None + + +module IsEmpty = + Stdlib.Dict.isEmpty_v0 (Dict { a = 1L }) = false + Stdlib.Dict.isEmpty_v0 (Dict { }) = true + + +module Keys = + Stdlib.Dict.keys_v0 (Dict { key1 = "val1" }) = [ "key1" ] + + +module Map = + // Stdlib.Dict.map_v0 (Dict { key1 = "val1"; key2 = "val2" }) (fun k x -> k ++ x) = (Dict + // { key2 = "key2val2"; key1 = "key1val1" }) + + // Stdlib.Dict.map_v0 (Dict { key1 = 5L; key2 = 3L; key3 = 3L }) (fun k x -> + // Stdlib.Bool.and_v0 + // (Stdlib.Int64.greaterThanOrEqualTo_v0 x 1L) + // (Stdlib.Int64.lessThanOrEqualTo_v0 x 4L)) = (Dict + // { key3 = true + // key2 = true + // key1 = false }) + + // Stdlib.Dict.map_v0 (Dict { a = 1L; b = 2L }) (fun k x -> x + 1L) = (Dict + // { b = 3L; a = 2L }) + + Stdlib.Dict.map_v0 (Dict { }) (fun key value -> 0L) = (Dict { }) + + +module Member = + Stdlib.Dict.member_v0 (Dict { otherKey = 5L; someKey = 5L }) "someKey" = true + + Stdlib.Dict.member_v0 (Dict { otherKey = 5L }) "someKey" = false + + +module Merge = + Stdlib.Dict.merge_v0 (Dict { key1 = "val1" }) (Dict { key2 = "val2" }) = (Dict + { key2 = "val2"; key1 = "val1" }) + + Stdlib.Dict.merge_v0 (Dict { key1 = "val_l" }) (Dict { key1 = "val_r" }) = (Dict + { key1 = "val_r" }) + + Stdlib.Dict.merge_v0 (Dict { }) (Dict { }) = (Dict { }) + + +module Set = + Stdlib.Dict.set_v0 (Dict { key1 = "val1before" }) "key1" "val1after" = (Dict + { key1 = "val1after" }) + + Stdlib.Dict.set_v0 (Dict { key1 = "val1" }) "key2" "val2" = (Dict + { key1 = "val1"; key2 = "val2" }) + + // Dicts do not currently enforce value typing, therefore the following tests pass + // VTTODO: this should fail + // Stdlib.Dict.set_v0 (Dict { key1 = "val1" }) "key2" 2L = (Dict + // { key1 = "val1"; key2 = 2L }) + + // Stdlib.Dict.set_v0 (Dict { key1 = 1 }) "key1" "changedTypeValue" = (Dict + // { key1 = "changedTypeValue" }) + + +module Singleton = + Stdlib.Dict.singleton_v0 "one" 1L = (Dict { one = 1L }) + + Stdlib.Dict.singleton_v0 "Content-Length" 1L = (Dict { ``Content-Length`` = 1L }) + + +module Size = + Stdlib.Dict.size_v0 (Dict { a = 3L; b = 1L; c = 1L }) = 3L + Stdlib.Dict.size_v0 (Dict { }) = 0L + + +module ToList = + Stdlib.Dict.toList_v0 (Dict { a = 1L; b = 2L; c = 3L }) = [ ("a", 1L) + ("b", 2L) + ("c", 3L) ] + + Stdlib.Dict.toList_v0 (Dict { }) = [] + + +module Values = + Stdlib.Dict.values_v0 (Dict { key1 = "val1" }) = [ "val1" ] + + +module Remove = + Stdlib.Dict.remove_v0 (Dict { key1 = "val1"; key2 = "val2" }) "key1" = (Dict + { key2 = "val2" }) + + Stdlib.Dict.remove_v0 (Dict { key1 = "val1" }) "key1" = (Dict { }) + + Stdlib.Dict.remove_v0 (Dict { key1 = "val1" }) "key2" = (Dict { key1 = "val1" }) + + Stdlib.Dict.remove_v0 (Dict { }) "key1" = (Dict { }) \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/_html.dark b/backend/testfiles/execution/stdlib/html.dark similarity index 71% rename from backend/testfiles/execution/stdlib/_html.dark rename to backend/testfiles/execution/stdlib/html.dark index 98ca161317..73ba530cf0 100644 --- a/backend/testfiles/execution/stdlib/_html.dark +++ b/backend/testfiles/execution/stdlib/html.dark @@ -28,8 +28,8 @@ let tidyHtml (html: String) : String = (htmlTag "div" [] [ stringNode "yolo" ]) |> nodeToString = "
yolo
" -(htmlTag "div" [ ("id", (Stdlib.Option.Option.Some "my-div")) ] [ stringNode "yolo" ]) -|> nodeToString = "
yolo
" +// (htmlTag "div" [ ("id", (Stdlib.Option.Option.Some "my-div")) ] [ stringNode "yolo" ]) +// |> nodeToString = "
yolo
" (htmlTag "div" [] [ htmlTag "button" [] [ stringNode "click me" ] ]) |> nodeToString = "
" @@ -69,40 +69,40 @@ let tidyHtml (html: String) : String = (Stdlib.Html.img []) |> nodeToString = "" -(Stdlib.Html.img [ ("src", Stdlib.Option.Option.Some "foo.png") ]) -|> nodeToString = "" +// (Stdlib.Html.img [ ("src", Stdlib.Option.Option.Some "foo.png") ]) +// |> nodeToString = "" (Stdlib.Html.svg [] []) |> nodeToString = "" (Stdlib.Html.path []) |> nodeToString = "" (Stdlib.Html.i [] []) |> nodeToString = "" -(Stdlib.Html.meta [ ("charset", Stdlib.Option.Option.Some "UTF-8") ]) -|> nodeToString = "" +// (Stdlib.Html.meta [ ("charset", Stdlib.Option.Option.Some "UTF-8") ]) +// |> nodeToString = "" -(Stdlib.Html.link - [ ("rel", Stdlib.Option.Option.Some "stylesheet") - ("href", Stdlib.Option.Option.Some "./style.css") ]) -|> nodeToString = "" +// (Stdlib.Html.link +// [ ("rel", Stdlib.Option.Option.Some "stylesheet") +// ("href", Stdlib.Option.Option.Some "./style.css") ]) +// |> nodeToString = "" -(Stdlib.Html.script - [ ("src", Stdlib.Option.Option.Some "https://cdn.tailwindcss.com") ] - []) -|> nodeToString = "" +// (Stdlib.Html.script +// [ ("src", Stdlib.Option.Option.Some "https://cdn.tailwindcss.com") ] +// []) +// |> nodeToString = "" -(Stdlib.Html.form [ ("id", Stdlib.Option.Option.Some "my-form") ] []) -|> nodeToString = "
" +// (Stdlib.Html.form [ ("id", Stdlib.Option.Option.Some "my-form") ] []) +// |> nodeToString = "
" -(Stdlib.Html.input - [ ("type", Stdlib.Option.Option.Some "text") - ("name", Stdlib.Option.Option.Some "name") - ("id", Stdlib.Option.Option.Some "name") ]) -|> nodeToString = "" +// (Stdlib.Html.input +// [ ("type", Stdlib.Option.Option.Some "text") +// ("name", Stdlib.Option.Option.Some "name") +// ("id", Stdlib.Option.Option.Some "name") ]) +// |> nodeToString = "" -(Stdlib.Html.label - [ ("for", Stdlib.Option.Option.Some "name") ] - [ stringNode "Name" ]) -|> nodeToString = "" +// (Stdlib.Html.label +// [ ("for", Stdlib.Option.Option.Some "name") ] +// [ stringNode "Name" ]) +// |> nodeToString = "" (Stdlib.Html.section [] []) |> nodeToString = "
" diff --git a/backend/testfiles/execution/stdlib/httpclient.dark b/backend/testfiles/execution/stdlib/httpclient.dark new file mode 100644 index 0000000000..7681246bf9 --- /dev/null +++ b/backend/testfiles/execution/stdlib/httpclient.dark @@ -0,0 +1,591 @@ +// Most of the httpclient tests are in testfiles/httpclient. + + +// Tests that don't use the internet +module NoInternal = + Stdlib.HttpClient.ContentType.form_v0 = ("content-type", + "application/x-www-form-urlencoded") + + Stdlib.HttpClient.ContentType.json_v0 = ("content-type", "application/json") + + Stdlib.HttpClient.ContentType.plainText_v0 = ("content-type", + "text/plain; charset=utf-8") + + Stdlib.HttpClient.ContentType.html_v0 = ("content-type", "text/html; charset=utf-8") + + Stdlib.HttpClient.bearerToken "YWxhZGRpbjpvcGVuc2VzYW1l" = (("authorization", + "bearer YWxhZGRpbjpvcGVuc2VzYW1l")) + +// Stdlib.HttpClient.basicAuth "username" "password" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(("authorization", "basic dXNlcm5hbWU6cGFzc3dvcmQ=")) + +// Stdlib.HttpClient.basicAuth "" "" = Stdlib.Result.Result.Ok( +// ("authorization", "basic Og==") +// ) + +// Stdlib.HttpClient.basicAuth "-" "" = Stdlib.Result.Result.Error +// "Username cannot contain a hyphen" + +// Stdlib.HttpClient.basicAuth "" "-" = Stdlib.Result.Result.Ok( +// ("authorization", "basic Oi0=") +// ) + +// Stdlib.HttpClient.basicAuth ":" "" = Stdlib.Result.Result.Ok( +// ("authorization", "basic Ojo=") +// ) + +// Stdlib.HttpClient.basicAuth "" ":" = Stdlib.Result.Result.Ok( +// ("authorization", "basic Ojo=") +// ) + +// Stdlib.HttpClient.basicAuth "hello>" "world" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(("authorization", "basic aGVsbG8+Ondvcmxk")) + +// Stdlib.HttpClient.basicAuth "hello" "world?" = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Ok(("authorization", "basic aGVsbG86d29ybGQ/")) + + + +// // Tests that try to make requests to the internet + +// // basic requests work +// (((Stdlib.HttpClient.request "get" "https://example.com" [] [])) +// |> Stdlib.Result.map (fun response -> response.statusCode)) = Stdlib.Result.Result.Ok +// 200L + +// (((Stdlib.HttpClient.request "get" "http://example.com" [] [])) +// |> Stdlib.Result.map (fun response -> response.statusCode)) = Stdlib.Result.Result.Ok +// 200L + +// Stdlib.HttpClient.request "get" "https://darklang.com" [ 1L ] [] = Builtin.testDerrorMessage +// "PACKAGE.Darklang.Stdlib.HttpClient.request's 3rd argument (`headers`) should be a List<(String * String)>. However, a List ([ 1]) was passed instead. + +// Expected: (headers: List<(String * String)>) +// Actual: a List: [\n 1\n]" + +// Stdlib.HttpClient.request "get" "https://darklang.com" [ ("", "") ] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadHeader(Stdlib.HttpClient.BadHeader.EmptyKey) +// ) + + +// // type errors for bad `method` are OK +// Stdlib.HttpClient.request "" "https://darklang.com" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.BadMethod) + +// Stdlib.HttpClient.request " get " "https://darklang.com" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.BadMethod) + +// Stdlib.HttpClient.request "🇵🇷" "https://darklang.com" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.BadMethod) + +// // unsupported protocols +// Stdlib.HttpClient.request "get" "ftp://darklang.com" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol +// ) +// ) + +// Stdlib.HttpClient.request "put" "file:///etc/passwd" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol +// ) +// ) + +// Stdlib.HttpClient.request "put" "/just-a-path" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.UnsupportedProtocol +// ) +// ) + +// // totally bogus URLs +// Stdlib.HttpClient.request "get" "" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl(Stdlib.HttpClient.BadUrlDetails.InvalidUri) +// ) + + +// Stdlib.HttpClient.request "post" "{ ] nonsense ^#( :" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl(Stdlib.HttpClient.BadUrlDetails.InvalidUri) +// ) + +// // URLs we can't actually communicate with +// Stdlib.HttpClient.request "get" "http://google.com:79" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.Timeout) + +// // Check for banned urls in the host name +// module Disallowed = + +// Stdlib.HttpClient.request "get" "http://0.0.0.0" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://0" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// // Check for banned urls in the host name +// module Disallowed = + +// Stdlib.HttpClient.request "get" "http://0.0.0.0" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://0" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:0:0:0]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.NetworkError) + +// Stdlib.HttpClient.request "get" "localhost" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidUri +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://localhost" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://127.0.0.1" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[::1]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:0:0:1]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + + +// Stdlib.HttpClient.request +// "get" +// "http://[0000:0000:0000:0000:0000:0000:0000:0001]" +// [] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://127.0.0.17" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + + +// Stdlib.HttpClient.request "get" "http://[::ffff:7f00:11]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:7f00:0011]" [] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://[0000:0000:0000:0000:0000:ffff:7f00:0011]" +// [] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://127.255.174.17" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + + +// Stdlib.HttpClient.request "get" "http://metadata.google.internal" [] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://metadata" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://169.254.169.254" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[::ffff:a9fe:a9fe]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:a9fe:a9fe]" [] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://[0000:0000:0000:0000:0000:ffff:a9fe:a9fe]" +// [] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://169.254.0.0" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://172.16.0.1" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[::ffff:ac10:1]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:ac10:0001]" [] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://[0000:0000:0000:0000:0000:ffff:ac10:0001]" +// [] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://192.168.1.1" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[::ffff:c0a8:101]" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request "get" "http://[0:0:0:0:0:ffff:c0a8:0101]" [] [] = Stdlib +// .Result +// .Result +// .Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://[0000:0000:0000:0000:0000:ffff:c0a8:0101]" +// [] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidHost +// ) +// ) + +// // Check for sneaky banned urls - blocked via connection callback +// // 127.0.0.1 +// Stdlib.HttpClient.request "get" "http://localtest.me" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.NetworkError) +// // 0.0.0.0 +// Stdlib.HttpClient.request "get" "http://c.cx" [] [] = PACKAGE +// .Darklang +// .Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.NetworkError) + +// // invalid headers +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ ("Metadata-Flavor", "Google") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ ("metadata-flavor", "Google") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ ("Metadata-Flavor", "google") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ ("Metadata-Flavor", " Google ") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ ("X-Google-Metadata-Request", " True ") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// Stdlib.HttpClient.request +// "get" +// "http://google.com" +// [ (" x-Google-metaData-Request", " True ") ] +// [] = Stdlib.Result.Result.Error( +// Stdlib.HttpClient.RequestError.BadUrl( +// Stdlib.HttpClient.BadUrlDetails.InvalidRequest +// ) +// ) + +// module BadSSL = +// Stdlib.HttpClient.request "get" "http://thenonexistingurlforsure.com" [] [] = Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.NetworkError) + +// Stdlib.HttpClient.request "get" "https://self-signed.badssl.com" [] [] = Stdlib +// .Result +// .Result +// .Error(Stdlib.HttpClient.RequestError.NetworkError) + + + +// // TODO: http2, http3 \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_uint16.dark b/backend/testfiles/execution/stdlib/ints/_uint16.dark deleted file mode 100644 index 412ff90d98..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_uint16.dark +++ /dev/null @@ -1,259 +0,0 @@ -Stdlib.UInt16.max_v0 5us 6us = 6us -Stdlib.UInt16.max_v0 10us 1us = 10us -Stdlib.UInt16.max_v0 0us 6us = 6us -Stdlib.UInt16.max_v0 65535us 0us = 65535us - -Stdlib.UInt16.min_v0 5us 6us = 5us -Stdlib.UInt16.min_v0 10us 10us = 10us -Stdlib.UInt16.min_v0 65535us 0us = 0us - -Stdlib.UInt16.clamp_v0 1us 2us 1us = 1us -Stdlib.UInt16.clamp_v0 3us 0us 2us = 2us -Stdlib.UInt16.clamp_v0 100us 0us 0us = 0us -Stdlib.UInt16.clamp_v0 100us 0us 1us = 1us -Stdlib.UInt16.clamp_v0 100us 1us 0us = 1us - - -Stdlib.UInt16.add_v0 10us 9us = 19us -Stdlib.UInt16.add_v0 88us 9us = 97us -Stdlib.UInt16.add_v0 1us 0us = 1us -Stdlib.UInt16.add_v0 65534us 1us = 65535us - -Stdlib.UInt16.add_v0 65535us 1us = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.subtract_v0 10us 9us = 1us -Stdlib.UInt16.subtract_v0 88us 9us = 79us - -Stdlib.UInt16.subtract_v0 0us 1us = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.subtract_v0 1us 0us = 1us -Stdlib.UInt16.subtract_v0 65535us 1us = 65534us - -Stdlib.UInt16.multiply_v0 8us 8us = 64us -Stdlib.UInt16.multiply_v0 8us 0us = 0us -Stdlib.UInt16.multiply_v0 32767us 2us = 65534us - -Stdlib.UInt16.multiply_v0 32768us 2us = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.multiply_v0 65535us 2us = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.power_v0 2us 3us = 8us -Stdlib.UInt16.power_v0 0us 1us = 0us -Stdlib.UInt16.power_v0 1us 0us = 1us -Stdlib.UInt16.power_v0 0us 0us = 1us -Stdlib.UInt16.power_v0 1us 255us = 1us - -Stdlib.UInt16.power_v0 256us 2us = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.divide_v0 10us 5us = 2us -Stdlib.UInt16.divide_v0 17us 3us = 5us -Stdlib.UInt16.divide_v0 8us 5us = 1us -Stdlib.UInt16.divide_v0 0us 1us = 0us -Stdlib.UInt16.divide_v0 65535us 2us = 32767us - -Stdlib.UInt16.divide_v0 1us 0us = Builtin.testDerrorMessage "Division by zero" - -Stdlib.UInt16.greaterThan_v0 20us 1us = true - -Stdlib.UInt16.greaterThanOrEqualTo_v0 0us 1us = false -Stdlib.UInt16.greaterThanOrEqualTo_v0 1us 0us = true -Stdlib.UInt16.greaterThanOrEqualTo_v0 6us 1us = true -Stdlib.UInt16.greaterThanOrEqualTo_v0 6us 8us = false -Stdlib.UInt16.greaterThanOrEqualTo_v0 65535us 0us = true -Stdlib.UInt16.greaterThanOrEqualTo_v0 0us 65535us = false - -Stdlib.UInt16.lessThanOrEqualTo_v0 6us 8us = true -Stdlib.UInt16.lessThanOrEqualTo_v0 10us 1us = false -Stdlib.UInt16.lessThanOrEqualTo_v0 0us 1us = true -Stdlib.UInt16.lessThanOrEqualTo_v0 1us 0us = false -Stdlib.UInt16.lessThanOrEqualTo_v0 65535us 0us = false -Stdlib.UInt16.lessThanOrEqualTo_v0 0us 65535us = true -Stdlib.UInt16.lessThanOrEqualTo_v0 65535us 65535us = true - -Stdlib.UInt16.lessThan_v0 6us 8us = true -Stdlib.UInt16.lessThan_v0 10us 1us = false -Stdlib.UInt16.lessThan_v0 0us 1us = true -Stdlib.UInt16.lessThan_v0 1us 0us = false -Stdlib.UInt16.lessThan_v0 0us 65535us = true -Stdlib.UInt16.lessThan_v0 65535us 65535us = false - -Stdlib.UInt16.toString 120us = "120" -Stdlib.UInt16.toString 1us = "1" -Stdlib.UInt16.toString 0us = "0" // UInt16 lower limit -Stdlib.UInt16.toString 65535us = "65535" // UInt16 upper limit - -Stdlib.UInt16.toFloat_v0 2us = 2.0 -Stdlib.UInt16.toFloat_v0 0us = 0.0 - -Stdlib.UInt16.sqrt_v0 4us = 2.0 -Stdlib.UInt16.sqrt_v0 100us = 10.0 -Stdlib.UInt16.sqrt_v0 86us = 9.273618495495704 - -Stdlib.UInt16.mod_v0 15us 5us = 0us -Stdlib.UInt16.mod_v0 15us 6us = 3us -Stdlib.UInt16.mod_v0 0us 15us = 0us -Stdlib.UInt16.mod_v0 1us 2us = 1us -Stdlib.UInt16.mod_v0 32768us 53us = 14us -Stdlib.UInt16.mod_v0 65535us 3us = 0us - -Stdlib.UInt16.mod_v0 5us 0us = Builtin.testDerrorMessage "Zero modulus" - - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 1us 2us) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt16.greaterThanOrEqualTo x 1us) - && (Stdlib.UInt16.lessThanOrEqualTo x 2us)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 10us 20us) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt16.greaterThanOrEqualTo x 10us) - && (Stdlib.UInt16.lessThanOrEqualTo x 20us)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 2us 1us) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt16.greaterThanOrEqualTo x 1us) - && (Stdlib.UInt16.lessThanOrEqualTo x 2us)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 20us 10us) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt16.greaterThanOrEqualTo x 10us) - && (Stdlib.UInt16.lessThanOrEqualTo x 20us)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 0us 1us) - |> Stdlib.List.unique_v0) = [ 0us; 1us ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 0us 2us) - |> Stdlib.List.unique_v0) = [ 0us; 1us; 2us ] - -Stdlib.UInt16.sum_v0 [ 1us; 2us ] = 3us - -Stdlib.UInt16.sum_v0 [ 1us; 65535us ] = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt16.parse_v0 "-129" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.OutOfRange - -Stdlib.UInt16.parse_v0 "65536" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.OutOfRange - -Stdlib.UInt16.parse_v0 "65536us" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.UInt16.ParseError.BadFormat - -Stdlib.UInt16.fromInt8_v0 0y = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromInt8_v0 1y = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromInt8_v0 127y = Stdlib.Option.Option.Some 127us - -Stdlib.UInt16.fromInt8_v0 (-1y) = Stdlib.Option.Option.None -Stdlib.UInt16.fromInt8_v0 (-128y) = Stdlib.Option.Option.None - -Stdlib.UInt16.fromUInt8_v0 0uy = 0us - -Stdlib.UInt16.fromUInt8_v0 1uy = 1us - -Stdlib.UInt16.fromUInt8_v0 255uy = 255us - -Stdlib.UInt16.fromInt16_v0 0s = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromInt16_v0 1s = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767us - -Stdlib.UInt16.fromInt16_v0 (-1s) = Stdlib.Option.Option.None -Stdlib.UInt16.fromInt16_v0 (-32768s) = Stdlib.Option.Option.None - -Stdlib.UInt16.fromInt32_v0 0l = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromInt32_v0 1l = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromInt32_v0 65535l = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromInt32_v0 65536l = Stdlib.Option.Option.None -Stdlib.UInt16.fromInt32_v0 (-1l) = Stdlib.Option.Option.None - -Stdlib.UInt16.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromUInt32_v0 65535ul = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromUInt32_v0 65536ul = Stdlib.Option.Option.None - -Stdlib.UInt16.fromInt64_v0 0L = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromInt64_v0 1L = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromInt64_v0 65535L = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromInt64_v0 65536L = Stdlib.Option.Option.None -Stdlib.UInt16.fromInt64_v0 (-1L) = Stdlib.Option.Option.None - -Stdlib.UInt16.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromUInt64_v0 65535UL = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromUInt64_v0 65536UL = Stdlib.Option.Option.None - -Stdlib.UInt16.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromInt128_v0 65535Q = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromInt128_v0 65536Q = Stdlib.Option.Option.None -Stdlib.UInt16.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None - -Stdlib.UInt16.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0us - -Stdlib.UInt16.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1us - -Stdlib.UInt16.fromUInt128_v0 65535Z = Stdlib.Option.Option.Some 65535us - -Stdlib.UInt16.fromUInt128_v0 65536Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_uint64.dark b/backend/testfiles/execution/stdlib/ints/_uint64.dark deleted file mode 100644 index 8ce993fad4..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_uint64.dark +++ /dev/null @@ -1,273 +0,0 @@ -Stdlib.UInt64.max_v0 5UL 6UL = 6UL -Stdlib.UInt64.max_v0 10UL 1UL = 10UL - - -Stdlib.UInt64.min_v0 5UL 6UL = 5UL -Stdlib.UInt64.min_v0 10UL 10UL = 10UL -Stdlib.UInt64.min_v0 18446744073709551615UL 0UL = 0UL - - -Stdlib.UInt64.clamp_v0 1UL 2UL 1UL = 1UL -Stdlib.UInt64.clamp_v0 3UL 0UL 2UL = 2UL -Stdlib.UInt64.clamp_v0 100UL 0UL 0UL = 0UL -Stdlib.UInt64.clamp_v0 100UL 1UL 0UL = 1UL - - -Stdlib.UInt64.mod_v0 15UL 5UL = 0UL -Stdlib.UInt64.mod_v0 15UL 6UL = 3UL -Stdlib.UInt64.mod_v0 0UL 15UL = 0UL -Stdlib.UInt64.mod_v0 9999999999998UL 3UL = 2UL - -Stdlib.UInt64.mod_v0 5UL 0UL = Builtin.testDerrorMessage "Zero modulus" - - -Stdlib.UInt64.power_v0 8UL 5UL = 32768UL -Stdlib.UInt64.power_v0 0UL 1UL = 0UL -Stdlib.UInt64.power_v0 0UL 0UL = 1UL -Stdlib.UInt64.power_v0 1UL 0UL = 1UL -Stdlib.UInt64.power_v0 1000UL 0UL = 1UL - -Stdlib.UInt64.power_v0 200UL 20UL = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt64.power_v0 200UL 7UL = 12800000000000000UL - -Stdlib.UInt64.power_v0 1UL 2147483649UL = 1UL - -Stdlib.UInt64.greaterThan_v0 20UL 1UL = true - - -Stdlib.UInt64.greaterThanOrEqualTo_v0 0UL 1UL = false -Stdlib.UInt64.greaterThanOrEqualTo_v0 1UL 0UL = true -Stdlib.UInt64.greaterThanOrEqualTo_v0 6UL 1UL = true -Stdlib.UInt64.greaterThanOrEqualTo_v0 6UL 8UL = false - -Stdlib.UInt64.lessThanOrEqualTo_v0 6UL 8UL = true -Stdlib.UInt64.lessThanOrEqualTo_v0 10UL 1UL = false -Stdlib.UInt64.lessThanOrEqualTo_v0 0UL 1UL = true -Stdlib.UInt64.lessThanOrEqualTo_v0 1UL 0UL = false - - -Stdlib.UInt64.lessThan_v0 6UL 8UL = true -Stdlib.UInt64.lessThan_v0 10UL 1UL = false -Stdlib.UInt64.lessThan_v0 0UL 1UL = true -Stdlib.UInt64.lessThan_v0 1UL 0UL = false - - -Stdlib.UInt64.sqrt_v0 4UL = 2.0 -Stdlib.UInt64.sqrt_v0 100UL = 10.0 -Stdlib.UInt64.sqrt_v0 86UL = 9.273618495495704 - -Stdlib.UInt64.toFloat_v0 2UL = 2.0 -Stdlib.UInt64.toFloat_v0 955656UL = 955656.0 - -Stdlib.UInt64.add_v0 10UL 9UL = 19UL -Stdlib.UInt64.add_v0 88UL 9UL = 97UL -Stdlib.UInt64.add_v0 1UL 0UL = 1UL -Stdlib.UInt64.add_v0 18446744073709551614UL 1UL = 18446744073709551615UL - -// Overflow tests -Stdlib.UInt64.add_v0 18446744073709551615UL 1UL = Builtin.testDerrorMessage - "Out of range" - -Stdlib.UInt64.add_v0 55UL 18446744073709551615UL = Builtin.testDerrorMessage - "Out of range" - - -Stdlib.UInt64.subtract_v0 10UL 9UL = 1UL -Stdlib.UInt64.subtract_v0 88UL 9UL = 79UL -Stdlib.UInt64.subtract_v0 1UL 0UL = 1UL - -Stdlib.UInt64.multiply_v0 8UL 8UL = 64UL -Stdlib.UInt64.multiply_v0 5145UL 5145UL = 26471025UL - -Stdlib.UInt64.multiply_v0 9223372036854775808UL 2UL = Builtin.testDerrorMessage - "Out of range" - -Stdlib.UInt64.divide_v0 10UL 5UL = 2UL -Stdlib.UInt64.divide_v0 17UL 3UL = 5UL -Stdlib.UInt64.divide_v0 0UL 1UL = 0UL - -Stdlib.UInt64.divide_v0 1UL 0UL = Builtin.testDerrorMessage "Division by zero" - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 1UL 2UL) -|> Stdlib.List.map_v0 (fun x -> - (Builtin.uint64GreaterThanOrEqualTo x 1UL) - && (Builtin.uint64LessThanOrEqualTo x 2UL)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 10UL 20UL) -|> Stdlib.List.map_v0 (fun x -> - (Builtin.uint64GreaterThanOrEqualTo x 10UL) - && (Builtin.uint64LessThanOrEqualTo x 20UL)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 2UL 1UL) -|> Stdlib.List.map_v0 (fun x -> - (Builtin.uint64GreaterThanOrEqualTo x 1UL) - && (Builtin.uint64LessThanOrEqualTo x 2UL)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 20UL 10UL) -|> Stdlib.List.map_v0 (fun x -> - (Builtin.uint64GreaterThanOrEqualTo x 10UL) - && (Builtin.uint64LessThanOrEqualTo x 20UL)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 0UL 1UL) - |> Stdlib.List.unique_v0) = [ 0UL; 1UL ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 0UL 2UL) - |> Stdlib.List.unique_v0) = [ 0UL; 1UL; 2UL ] - -Stdlib.UInt64.sum_v0 [ 1UL; 2UL ] = 3UL - -Stdlib.UInt64.parse_v0 "0" = Stdlib.Result.Result.Ok 0UL - -Stdlib.UInt64.parse_v0 "1" = Stdlib.Result.Result.Ok 1UL - -Stdlib.UInt64.parse_v0 " 1" = Stdlib.Result.Result.Ok 1UL - -Stdlib.UInt64.parse_v0 "1 " = Stdlib.Result.Result.Ok 1UL - -Stdlib.UInt64.parse_v0 "+1" = Stdlib.Result.Result.Ok 1UL - -Stdlib.UInt64.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1UL - -Stdlib.UInt64.parse_v0 "-1" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.OutOfRange - -Stdlib.UInt64.parse_v0 "078" = Stdlib.Result.Result.Ok 78UL // "octal" format ignored - -Stdlib.UInt64.parse_v0 "-00001" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.OutOfRange - -Stdlib.UInt64.parse_v0 "-10001" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.OutOfRange - -Stdlib.UInt64.parse_v0 "18446744073709551615" = Stdlib.Result.Result.Ok - 18446744073709551615UL - -Stdlib.UInt64.parse_v0 "18446744073709551616" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.OutOfRange - -Stdlib.UInt64.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "18446744073709551616" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.OutOfRange - -Stdlib.UInt64.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - -Stdlib.UInt64.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.UInt64.ParseError.BadFormat - - -Stdlib.UInt64.toString 0UL = "0" -Stdlib.UInt64.toString 1UL = "1" -Stdlib.UInt64.toString 18446744073709551615UL = "18446744073709551615" - - -Stdlib.UInt64.fromInt8_v0 0y = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromInt8_v0 1y = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromInt8_v0 127y = Stdlib.Option.Option.Some 127UL - -Stdlib.UInt64.fromInt8_v0 -128y = Stdlib.Option.Option.None - -Stdlib.UInt64.fromUInt8_v0 0uy = 0UL - -Stdlib.UInt64.fromUInt8_v0 1uy = 1UL - -Stdlib.UInt64.fromUInt8_v0 255uy = 255UL - -Stdlib.UInt64.fromInt16_v0 0s = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromInt16_v0 1s = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767UL - -Stdlib.UInt64.fromInt16_v0 -32768s = Stdlib.Option.Option.None - -Stdlib.UInt64.fromUInt16_v0 0us = 0UL - -Stdlib.UInt64.fromUInt16_v0 1us = 1UL - -Stdlib.UInt64.fromUInt16_v0 65535us = 65535UL - -Stdlib.UInt64.fromInt32_v0 0l = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromInt32_v0 1l = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromInt32_v0 2147483647l = Stdlib.Option.Option.Some 2147483647UL - -Stdlib.UInt64.fromInt32_v0 -1l = Stdlib.Option.Option.None - -Stdlib.UInt64.fromUInt32_v0 0ul = 0UL - -Stdlib.UInt64.fromUInt32_v0 1ul = 1UL - -Stdlib.UInt64.fromUInt32_v0 4294967295ul = 4294967295UL - -Stdlib.UInt64.fromInt64_v0 0L = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromInt64_v0 1L = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromInt64_v0 9223372036854775807L = Stdlib.Option.Option.Some - 9223372036854775807UL - -Stdlib.UInt64.fromInt64_v0 -1L = Stdlib.Option.Option.None - -Stdlib.UInt64.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromInt128_v0 -1Q = Stdlib.Option.Option.None - -Stdlib.UInt64.fromInt128_v0 18446744073709551616Q = Stdlib.Option.Option.None - -Stdlib.UInt64.fromInt128_v0 170141183460469231731687303715884105727Q = Stdlib.Option.Option.None - -Stdlib.UInt64.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0UL - -Stdlib.UInt64.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1UL - -Stdlib.UInt64.fromUInt128_v0 18446744073709551615Z = Stdlib.Option.Option.Some - 18446744073709551615UL - -Stdlib.UInt64.fromUInt128_v0 18446744073709551616Z = Stdlib.Option.Option.None - -Stdlib.UInt64.fromUInt128_v0 340282366920938463463374607431768211455Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_uint8.dark b/backend/testfiles/execution/stdlib/ints/_uint8.dark deleted file mode 100644 index bdf662f6e2..0000000000 --- a/backend/testfiles/execution/stdlib/ints/_uint8.dark +++ /dev/null @@ -1,262 +0,0 @@ -Stdlib.UInt8.max_v0 5uy 6uy = 6uy -Stdlib.UInt8.max_v0 10uy 1uy = 10uy -Stdlib.UInt8.max_v0 0uy 6uy = 6uy -Stdlib.UInt8.max_v0 255uy 0uy = 255uy - -Stdlib.UInt8.min_v0 5uy 6uy = 5uy -Stdlib.UInt8.min_v0 10uy 10uy = 10uy -Stdlib.UInt8.min_v0 255uy 0uy = 0uy - -Stdlib.UInt8.clamp_v0 1uy 2uy 1uy = 1uy -Stdlib.UInt8.clamp_v0 3uy 0uy 2uy = 2uy -Stdlib.UInt8.clamp_v0 100uy 0uy 0uy = 0uy -Stdlib.UInt8.clamp_v0 100uy 0uy 1uy = 1uy -Stdlib.UInt8.clamp_v0 100uy 1uy 0uy = 1uy - - -Stdlib.UInt8.add_v0 10uy 9uy = 19uy -Stdlib.UInt8.add_v0 88uy 9uy = 97uy -Stdlib.UInt8.add_v0 1uy 0uy = 1uy -Stdlib.UInt8.add_v0 254uy 1uy = 255uy - -Stdlib.UInt8.add_v0 255uy 1uy = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt8.subtract_v0 10uy 9uy = 1uy -Stdlib.UInt8.subtract_v0 88uy 9uy = 79uy - -Stdlib.UInt8.subtract_v0 0uy 1uy = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt8.subtract_v0 1uy 0uy = 1uy -Stdlib.UInt8.subtract_v0 255uy 1uy = 254uy - -Stdlib.UInt8.multiply_v0 8uy 8uy = 64uy -Stdlib.UInt8.multiply_v0 8uy 0uy = 0uy -Stdlib.UInt8.multiply_v0 127uy 2uy = 254uy - -Stdlib.UInt8.multiply_v0 128uy 2uy = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt8.multiply_v0 255uy 2uy = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt8.power_v0 2uy 3uy = 8uy -Stdlib.UInt8.power_v0 0uy 1uy = 0uy -Stdlib.UInt8.power_v0 1uy 0uy = 1uy -Stdlib.UInt8.power_v0 0uy 0uy = 1uy -Stdlib.UInt8.power_v0 1uy 255uy = 1uy - -Stdlib.UInt8.power_v0 16uy 2uy = Builtin.testDerrorMessage "Out of range" - - -Stdlib.UInt8.divide_v0 10uy 5uy = 2uy -Stdlib.UInt8.divide_v0 17uy 3uy = 5uy -Stdlib.UInt8.divide_v0 8uy 5uy = 1uy -Stdlib.UInt8.divide_v0 0uy 1uy = 0uy -Stdlib.UInt8.divide_v0 255uy 2uy = 127uy - -Stdlib.UInt8.divide_v0 1uy 0uy = Builtin.testDerrorMessage "Division by zero" - -Stdlib.UInt8.greaterThan_v0 20uy 1uy = true - -Stdlib.UInt8.greaterThanOrEqualTo_v0 0uy 1uy = false -Stdlib.UInt8.greaterThanOrEqualTo_v0 1uy 0uy = true -Stdlib.UInt8.greaterThanOrEqualTo_v0 6uy 1uy = true -Stdlib.UInt8.greaterThanOrEqualTo_v0 6uy 8uy = false -Stdlib.UInt8.greaterThanOrEqualTo_v0 255uy 0uy = true -Stdlib.UInt8.greaterThanOrEqualTo_v0 0uy 255uy = false - -Stdlib.UInt8.lessThanOrEqualTo_v0 6uy 8uy = true -Stdlib.UInt8.lessThanOrEqualTo_v0 10uy 1uy = false -Stdlib.UInt8.lessThanOrEqualTo_v0 0uy 1uy = true -Stdlib.UInt8.lessThanOrEqualTo_v0 1uy 0uy = false -Stdlib.UInt8.lessThanOrEqualTo_v0 255uy 0uy = false -Stdlib.UInt8.lessThanOrEqualTo_v0 0uy 255uy = true -Stdlib.UInt8.lessThanOrEqualTo_v0 255uy 255uy = true - -Stdlib.UInt8.lessThan_v0 6uy 8uy = true -Stdlib.UInt8.lessThan_v0 10uy 1uy = false -Stdlib.UInt8.lessThan_v0 0uy 1uy = true -Stdlib.UInt8.lessThan_v0 1uy 0uy = false -Stdlib.UInt8.lessThan_v0 0uy 255uy = true -Stdlib.UInt8.lessThan_v0 255uy 255uy = false - -Stdlib.UInt8.toString 120uy = "120" -Stdlib.UInt8.toString 1uy = "1" -Stdlib.UInt8.toString 0uy = "0" // UInt8 lower limit -Stdlib.UInt8.toString 255uy = "255" // UInt8 upper limit - -Stdlib.UInt8.toFloat_v0 2uy = 2.0 -Stdlib.UInt8.toFloat_v0 0uy = 0.0 - -Stdlib.UInt8.sqrt_v0 4uy = 2.0 -Stdlib.UInt8.sqrt_v0 100uy = 10.0 -Stdlib.UInt8.sqrt_v0 86uy = 9.273618495495704 - -Stdlib.UInt8.mod_v0 15uy 5uy = 0uy -Stdlib.UInt8.mod_v0 15uy 6uy = 3uy -Stdlib.UInt8.mod_v0 0uy 15uy = 0uy -Stdlib.UInt8.mod_v0 1uy 2uy = 1uy -Stdlib.UInt8.mod_v0 128uy 53uy = 22uy -Stdlib.UInt8.mod_v0 255uy 3uy = 0uy - -Stdlib.UInt8.mod_v0 5uy 0uy = Builtin.testDerrorMessage "Zero modulus" - - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 1uy 2uy) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt8.greaterThanOrEqualTo x 1uy) - && (Stdlib.UInt8.lessThanOrEqualTo x 2uy)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 10uy 20uy) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt8.greaterThanOrEqualTo x 10uy) - && (Stdlib.UInt8.lessThanOrEqualTo x 20uy)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 2uy 1uy) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt8.greaterThanOrEqualTo x 1uy) - && (Stdlib.UInt8.lessThanOrEqualTo x 2uy)) = [ true; true; true; true; true ] - -(Stdlib.List.range_v0 1L 5L) -|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 20uy 10uy) -|> Stdlib.List.map_v0 (fun x -> - (Stdlib.UInt8.greaterThanOrEqualTo x 10uy) - && (Stdlib.UInt8.lessThanOrEqualTo x 20uy)) = [ true; true; true; true; true ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 0uy 1uy) - |> Stdlib.List.unique_v0) = [ 0uy; 1uy ] - -((Stdlib.List.range_v0 1L 100L) - |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 0uy 2uy) - |> Stdlib.List.unique_v0) = [ 0uy; 1uy; 2uy ] - -Stdlib.UInt8.sum_v0 [ 1uy; 2uy ] = 3uy - -Stdlib.UInt8.sum_v0 [ 1uy; 255uy ] = Builtin.testDerrorMessage "Out of range" - -Stdlib.UInt8.parse_v0 "-129" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.OutOfRange - -Stdlib.UInt8.parse_v0 "256" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.OutOfRange - -Stdlib.UInt8.parse_v0 "256uy" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - -Stdlib.UInt8.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.UInt8.ParseError.BadFormat - - -Stdlib.UInt8.fromInt8_v0 0y = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromInt8_v0 1y = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromInt8_v0 127y = Stdlib.Option.Option.Some 127uy - -Stdlib.UInt8.fromInt8_v0 (-128y) = Stdlib.Option.Option.None - -Stdlib.UInt8.fromInt16_v0 0s = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromInt16_v0 1s = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromInt16_v0 255s = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromInt16_v0 256s = Stdlib.Option.Option.None -Stdlib.UInt8.fromInt16_v0 (-1s) = Stdlib.Option.Option.None - -Stdlib.UInt8.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromUInt16_v0 255us = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromUInt16_v0 256us = Stdlib.Option.Option.None - -Stdlib.UInt8.fromInt32_v0 0l = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromInt32_v0 1l = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromInt32_v0 255l = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromInt32_v0 256l = Stdlib.Option.Option.None -Stdlib.UInt8.fromInt32_v0 (-1l) = Stdlib.Option.Option.None - -Stdlib.UInt8.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromUInt32_v0 255ul = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromUInt32_v0 256ul = Stdlib.Option.Option.None - -Stdlib.UInt8.fromInt64_v0 0L = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromInt64_v0 1L = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromInt64_v0 255L = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromInt64_v0 256L = Stdlib.Option.Option.None -Stdlib.UInt8.fromInt64_v0 (-1L) = Stdlib.Option.Option.None - -Stdlib.UInt8.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromUInt64_v0 255UL = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromUInt64_v0 256UL = Stdlib.Option.Option.None - -Stdlib.UInt8.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromInt128_v0 255Q = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromInt128_v0 256Q = Stdlib.Option.Option.None -Stdlib.UInt8.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None - -Stdlib.UInt8.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0uy - -Stdlib.UInt8.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1uy - -Stdlib.UInt8.fromUInt128_v0 255Z = Stdlib.Option.Option.Some 255uy - -Stdlib.UInt8.fromUInt128_v0 256Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/int16.dark b/backend/testfiles/execution/stdlib/ints/int16.dark index c974e42ba5..97ccba3d66 100644 --- a/backend/testfiles/execution/stdlib/ints/int16.dark +++ b/backend/testfiles/execution/stdlib/ints/int16.dark @@ -113,37 +113,37 @@ Stdlib.Int16.toString 32767s = "32767" // Int16 upper limit Stdlib.Int16.toFloat_v0 2s = 2.0 Stdlib.Int16.toFloat_v0 -10s = -10.0 -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 1s 2s) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int16.greaterThanOrEqualTo x 1s) -// && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 10s 20s) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int16.greaterThanOrEqualTo x 10s) -// && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 2s 1s) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int16.greaterThanOrEqualTo x 1s) -// && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 20s 10s) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int16.greaterThanOrEqualTo x 10s) -// && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 1s) -// |> Stdlib.List.unique_v0) = [ 0s; 1s ] - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 2s) -// |> Stdlib.List.unique_v0) = [ 0s; 1s; 2s ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 1s 2s) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int16.greaterThanOrEqualTo x 1s) + && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 10s 20s) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int16.greaterThanOrEqualTo x 10s) + && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 2s 1s) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int16.greaterThanOrEqualTo x 1s) + && (Stdlib.Int16.lessThanOrEqualTo x 2s)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 20s 10s) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int16.greaterThanOrEqualTo x 10s) + && (Stdlib.Int16.lessThanOrEqualTo x 20s)) = [ true; true; true; true; true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 1s) + |> Stdlib.List.unique_v0) = [ 0s; 1s ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int16.random 0s 2s) + |> Stdlib.List.unique_v0) = [ 0s; 1s; 2s ] // Stdlib.Int16.parse_v0 "0" = Stdlib.Result.Result.Ok 0s diff --git a/backend/testfiles/execution/stdlib/ints/int32.dark b/backend/testfiles/execution/stdlib/ints/int32.dark index 1b2b69c9f4..ead9c75b88 100644 --- a/backend/testfiles/execution/stdlib/ints/int32.dark +++ b/backend/testfiles/execution/stdlib/ints/int32.dark @@ -127,41 +127,41 @@ Stdlib.Int32.divide_v0 0l 1l = 0l // Stdlib.Int32.divide_v0 1l 0l = Builtin.testDerrorMessage "Division by zero" -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 1l 2l) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int32.greaterThanOrEqualTo x 1l) -// && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 1l 2l) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int32.greaterThanOrEqualTo x 1l) + && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 10l 20l) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int32.greaterThanOrEqualTo x 10l) -// && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 10l 20l) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int32.greaterThanOrEqualTo x 10l) + && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 2l 1l) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int32.greaterThanOrEqualTo x 1l) -// && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 2l 1l) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int32.greaterThanOrEqualTo x 1l) + && (Stdlib.Int32.lessThanOrEqualTo x 2l)) = [ true; true; true; true; true ] -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 20l 10l) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int32.greaterThanOrEqualTo x 10l) -// && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 20l 10l) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int32.greaterThanOrEqualTo x 10l) + && (Stdlib.Int32.lessThanOrEqualTo x 20l)) = [ true; true; true; true; true ] -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 1l) -// |> Stdlib.List.unique_v0) = [ 0l; 1l ] +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 1l) + |> Stdlib.List.unique_v0) = [ 0l; 1l ] -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 2l) -// |> Stdlib.List.unique_v0) = [ 0l; 1l; 2l ] +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int32.random 0l 2l) + |> Stdlib.List.unique_v0) = [ 0l; 1l; 2l ] -//Stdlib.Int32.sum_v0 [ 1l; 2l ] = 3l +Stdlib.Int32.sum_v0 [ 1l; 2l ] = 3l // Stdlib.Int32.parse_v0 "0" = Stdlib.Result.Result.Ok 0l // Stdlib.Int32.parse_v0 "1" = Stdlib.Result.Result.Ok 1l @@ -207,29 +207,29 @@ Stdlib.Int32.divide_v0 0l 1l = 0l // Stdlib.Int32.ParseError.BadFormat -// Stdlib.Int32.toString 0l = "0" -// Stdlib.Int32.toString 1l = "1" -// Stdlib.Int32.toString -1l = "-1" -// Stdlib.Int32.toString -2147483648l = "-2147483648" // Int32 lower limit -// Stdlib.Int32.toString 2147483647l = "2147483647" // Int32 upper limit +Stdlib.Int32.toString 0l = "0" +Stdlib.Int32.toString 1l = "1" +Stdlib.Int32.toString -1l = "-1" +Stdlib.Int32.toString -2147483648l = "-2147483648" // Int32 lower limit +Stdlib.Int32.toString 2147483647l = "2147483647" // Int32 upper limit -// Stdlib.Int32.fromInt8_v0 0y = 0l -// Stdlib.Int32.fromInt8_v0 1y = 1l -// Stdlib.Int32.fromInt8_v0 127y = 127l -// Stdlib.Int32.fromInt8_v0 (-128y) = -128l +Stdlib.Int32.fromInt8_v0 0y = 0l +Stdlib.Int32.fromInt8_v0 1y = 1l +Stdlib.Int32.fromInt8_v0 127y = 127l +Stdlib.Int32.fromInt8_v0 (-128y) = -128l -// Stdlib.Int32.fromUInt8_v0 0uy = 0l -// Stdlib.Int32.fromUInt8_v0 1uy = 1l -// Stdlib.Int32.fromUInt8_v0 255uy = 255l +Stdlib.Int32.fromUInt8_v0 0uy = 0l +Stdlib.Int32.fromUInt8_v0 1uy = 1l +Stdlib.Int32.fromUInt8_v0 255uy = 255l -// Stdlib.Int32.fromInt16_v0 0s = 0l -// Stdlib.Int32.fromInt16_v0 1s = 1l -// Stdlib.Int32.fromInt16_v0 32767s = 32767l -// Stdlib.Int32.fromInt16_v0 (-32768s) = -32768l +Stdlib.Int32.fromInt16_v0 0s = 0l +Stdlib.Int32.fromInt16_v0 1s = 1l +Stdlib.Int32.fromInt16_v0 32767s = 32767l +Stdlib.Int32.fromInt16_v0 (-32768s) = -32768l -// Stdlib.Int32.fromUInt16_v0 0us = 0l -// Stdlib.Int32.fromUInt16_v0 1us = 1l -// Stdlib.Int32.fromUInt16_v0 65535us = 65535l +Stdlib.Int32.fromUInt16_v0 0us = 0l +Stdlib.Int32.fromUInt16_v0 1us = 1l +Stdlib.Int32.fromUInt16_v0 65535us = 65535l // Stdlib.Int32.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0l // Stdlib.Int32.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1l diff --git a/backend/testfiles/execution/stdlib/ints/int64.dark b/backend/testfiles/execution/stdlib/ints/int64.dark index d3906e66cf..a889a84e90 100644 --- a/backend/testfiles/execution/stdlib/ints/int64.dark +++ b/backend/testfiles/execution/stdlib/ints/int64.dark @@ -85,17 +85,17 @@ Stdlib.Int64.mod_v0 9999999999998L 3L = 2L // 5L % 0L = Builtin.testDerrorMessage "Zero modulus" // 5L % -5L = Builtin.testDerrorMessage "Negative modulus" -// Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> v % 4L) = [ 3L -// 0L -// 1L -// 2L -// 3L -// 0L -// 1L -// 2L -// 3L -// 0L -// 1L ] +Stdlib.List.map_v0 (Stdlib.List.range_v0 -5L 5L) (fun v -> v % 4L) = [ 3L + 0L + 1L + 2L + 3L + 0L + 1L + 2L + 3L + 0L + 1L ] Stdlib.Int64.power_v0 8L 5L = 32768L Stdlib.Int64.power_v0 0L 1L = 0L @@ -212,47 +212,47 @@ Stdlib.Int64.divide_v0 0L 1L = 0L // Stdlib.Int64.divide_v0 1L 0L = Builtin.testDerrorMessage "Division by zero" -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 1L 2L) -// |> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true -// true -// true -// true -// true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 10L 20L) -// |> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true -// true -// true -// true -// true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 2L 1L) -// |> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true -// true -// true -// true -// true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 20L 10L) -// |> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true -// true -// true -// true -// true ] - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 1L) -// |> Stdlib.List.unique_v0) = [ 0L; 1L ] - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 2L) -// |> Stdlib.List.unique_v0) = [ 0L; 1L; 2L ] - -//Stdlib.Int64.sum_v0 [ 1L; 2L ] = 3L +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 1L 2L) +|> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true + true + true + true + true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 10L 20L) +|> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true + true + true + true + true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 2L 1L) +|> Stdlib.List.map_v0 (fun x -> (x >= 1L) && (x <= 2L)) = [ true + true + true + true + true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 20L 10L) +|> Stdlib.List.map_v0 (fun x -> (x >= 10L) && (x <= 20L)) = [ true + true + true + true + true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 1L) + |> Stdlib.List.unique_v0) = [ 0L; 1L ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int64.random 0L 2L) + |> Stdlib.List.unique_v0) = [ 0L; 1L; 2L ] + +Stdlib.Int64.sum_v0 [ 1L; 2L ] = 3L // Stdlib.Int64.parse_v0 "0" = Stdlib.Result.Result.Ok 0L // Stdlib.Int64.parse_v0 "1" = Stdlib.Result.Result.Ok 1L @@ -320,32 +320,32 @@ Stdlib.Int64.toString 4611686018427387903L = "4611686018427387903" // int63 uppe Stdlib.Int64.toString 4611686018427387904L = "4611686018427387904" // past the int63 upper limit Stdlib.Int64.toString 9223372036854775807L = "9223372036854775807" // .NET upper limit -// Stdlib.Int64.fromInt8_v0 0y = 0L -// Stdlib.Int64.fromInt8_v0 1y = 1L -// Stdlib.Int64.fromInt8_v0 127y = 127L -// Stdlib.Int64.fromInt8_v0 -128y = -128L +Stdlib.Int64.fromInt8_v0 0y = 0L +Stdlib.Int64.fromInt8_v0 1y = 1L +Stdlib.Int64.fromInt8_v0 127y = 127L +Stdlib.Int64.fromInt8_v0 -128y = -128L -// Stdlib.Int64.fromUInt8_v0 0uy = 0L -// Stdlib.Int64.fromUInt8_v0 1uy = 1L -// Stdlib.Int64.fromUInt8_v0 255uy = 255L +Stdlib.Int64.fromUInt8_v0 0uy = 0L +Stdlib.Int64.fromUInt8_v0 1uy = 1L +Stdlib.Int64.fromUInt8_v0 255uy = 255L -// Stdlib.Int64.fromInt16_v0 0s = 0L -// Stdlib.Int64.fromInt16_v0 1s = 1L -// Stdlib.Int64.fromInt16_v0 32767s = 32767L -// Stdlib.Int64.fromInt16_v0 -32768s = -32768L +Stdlib.Int64.fromInt16_v0 0s = 0L +Stdlib.Int64.fromInt16_v0 1s = 1L +Stdlib.Int64.fromInt16_v0 32767s = 32767L +Stdlib.Int64.fromInt16_v0 -32768s = -32768L -// Stdlib.Int64.fromUInt16_v0 0us = 0L -// Stdlib.Int64.fromUInt16_v0 1us = 1L -// Stdlib.Int64.fromUInt16_v0 65535us = 65535L +Stdlib.Int64.fromUInt16_v0 0us = 0L +Stdlib.Int64.fromUInt16_v0 1us = 1L +Stdlib.Int64.fromUInt16_v0 65535us = 65535L -// Stdlib.Int64.fromInt32_v0 0l = 0L -// Stdlib.Int64.fromInt32_v0 1l = 1L -// Stdlib.Int64.fromInt32_v0 2147483647l = 2147483647L -// Stdlib.Int64.fromInt32_v0 -2147483648l = -2147483648L +Stdlib.Int64.fromInt32_v0 0l = 0L +Stdlib.Int64.fromInt32_v0 1l = 1L +Stdlib.Int64.fromInt32_v0 2147483647l = 2147483647L +Stdlib.Int64.fromInt32_v0 -2147483648l = -2147483648L -// Stdlib.Int64.fromUInt32_v0 0ul = 0L -// Stdlib.Int64.fromUInt32_v0 1ul = 1L -// Stdlib.Int64.fromUInt32_v0 4294967295ul = 4294967295L +Stdlib.Int64.fromUInt32_v0 0ul = 0L +Stdlib.Int64.fromUInt32_v0 1ul = 1L +Stdlib.Int64.fromUInt32_v0 4294967295ul = 4294967295L // Stdlib.Int64.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0L // Stdlib.Int64.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1L diff --git a/backend/testfiles/execution/stdlib/ints/int8.dark b/backend/testfiles/execution/stdlib/ints/int8.dark index 077e18f03c..b2a3880be5 100644 --- a/backend/testfiles/execution/stdlib/ints/int8.dark +++ b/backend/testfiles/execution/stdlib/ints/int8.dark @@ -134,44 +134,44 @@ Stdlib.Int8.mod_v0 127y 3y = 1y // Stdlib.Int8.mod_v0 5y 0y = Builtin.testDerrorMessage "Zero modulus" // Stdlib.Int8.mod_v0 5y -5y = Builtin.testDerrorMessage "Negative modulus" -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 1y 2y) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true -// true -// true -// true -// true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 10y 20y) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int8.greaterThanOrEqualTo x 10y) -// && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 2y 1y) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true -// true -// true -// true -// true ] - -// (Stdlib.List.range_v0 1L 5L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 20y 10y) -// |> Stdlib.List.map_v0 (fun x -> -// (Stdlib.Int8.greaterThanOrEqualTo x 10y) -// && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 1y) -// |> Stdlib.List.unique_v0) = [ 0y; 1y ] - - -// ((Stdlib.List.range_v0 1L 100L) -// |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 2y) -// |> Stdlib.List.unique_v0) = [ 0y; 1y; 2y ] +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 1y 2y) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true + true + true + true + true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 10y 20y) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int8.greaterThanOrEqualTo x 10y) + && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 2y 1y) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int8.greaterThanOrEqualTo x 1y) && (Stdlib.Int8.lessThanOrEqualTo x 2y)) = [ true + true + true + true + true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 20y 10y) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.Int8.greaterThanOrEqualTo x 10y) + && (Stdlib.Int8.lessThanOrEqualTo x 20y)) = [ true; true; true; true; true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 1y) + |> Stdlib.List.unique_v0) = [ 0y; 1y ] + + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.Int8.random 0y 2y) + |> Stdlib.List.unique_v0) = [ 0y; 1y; 2y ] // Stdlib.Int8.parse_v0 "0" = Stdlib.Result.Result.Ok(0y) diff --git a/backend/testfiles/execution/stdlib/ints/uint16.dark b/backend/testfiles/execution/stdlib/ints/uint16.dark new file mode 100644 index 0000000000..0a1330af74 --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/uint16.dark @@ -0,0 +1,259 @@ +Stdlib.UInt16.max_v0 5us 6us = 6us +Stdlib.UInt16.max_v0 10us 1us = 10us +Stdlib.UInt16.max_v0 0us 6us = 6us +Stdlib.UInt16.max_v0 65535us 0us = 65535us + +Stdlib.UInt16.min_v0 5us 6us = 5us +Stdlib.UInt16.min_v0 10us 10us = 10us +Stdlib.UInt16.min_v0 65535us 0us = 0us + +Stdlib.UInt16.clamp_v0 1us 2us 1us = 1us +Stdlib.UInt16.clamp_v0 3us 0us 2us = 2us +Stdlib.UInt16.clamp_v0 100us 0us 0us = 0us +Stdlib.UInt16.clamp_v0 100us 0us 1us = 1us +Stdlib.UInt16.clamp_v0 100us 1us 0us = 1us + + +Stdlib.UInt16.add_v0 10us 9us = 19us +Stdlib.UInt16.add_v0 88us 9us = 97us +Stdlib.UInt16.add_v0 1us 0us = 1us +Stdlib.UInt16.add_v0 65534us 1us = 65535us + +// Stdlib.UInt16.add_v0 65535us 1us = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt16.subtract_v0 10us 9us = 1us +Stdlib.UInt16.subtract_v0 88us 9us = 79us + +// Stdlib.UInt16.subtract_v0 0us 1us = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt16.subtract_v0 1us 0us = 1us +Stdlib.UInt16.subtract_v0 65535us 1us = 65534us + +Stdlib.UInt16.multiply_v0 8us 8us = 64us +Stdlib.UInt16.multiply_v0 8us 0us = 0us +Stdlib.UInt16.multiply_v0 32767us 2us = 65534us + +// Stdlib.UInt16.multiply_v0 32768us 2us = Builtin.testDerrorMessage "Out of range" + +// Stdlib.UInt16.multiply_v0 65535us 2us = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt16.power_v0 2us 3us = 8us +Stdlib.UInt16.power_v0 0us 1us = 0us +Stdlib.UInt16.power_v0 1us 0us = 1us +Stdlib.UInt16.power_v0 0us 0us = 1us +Stdlib.UInt16.power_v0 1us 255us = 1us + +// Stdlib.UInt16.power_v0 256us 2us = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt16.divide_v0 10us 5us = 2us +Stdlib.UInt16.divide_v0 17us 3us = 5us +Stdlib.UInt16.divide_v0 8us 5us = 1us +Stdlib.UInt16.divide_v0 0us 1us = 0us +Stdlib.UInt16.divide_v0 65535us 2us = 32767us + +// Stdlib.UInt16.divide_v0 1us 0us = Builtin.testDerrorMessage "Division by zero" + +Stdlib.UInt16.greaterThan_v0 20us 1us = true + +Stdlib.UInt16.greaterThanOrEqualTo_v0 0us 1us = false +Stdlib.UInt16.greaterThanOrEqualTo_v0 1us 0us = true +Stdlib.UInt16.greaterThanOrEqualTo_v0 6us 1us = true +Stdlib.UInt16.greaterThanOrEqualTo_v0 6us 8us = false +Stdlib.UInt16.greaterThanOrEqualTo_v0 65535us 0us = true +Stdlib.UInt16.greaterThanOrEqualTo_v0 0us 65535us = false + +Stdlib.UInt16.lessThanOrEqualTo_v0 6us 8us = true +Stdlib.UInt16.lessThanOrEqualTo_v0 10us 1us = false +Stdlib.UInt16.lessThanOrEqualTo_v0 0us 1us = true +Stdlib.UInt16.lessThanOrEqualTo_v0 1us 0us = false +Stdlib.UInt16.lessThanOrEqualTo_v0 65535us 0us = false +Stdlib.UInt16.lessThanOrEqualTo_v0 0us 65535us = true +Stdlib.UInt16.lessThanOrEqualTo_v0 65535us 65535us = true + +Stdlib.UInt16.lessThan_v0 6us 8us = true +Stdlib.UInt16.lessThan_v0 10us 1us = false +Stdlib.UInt16.lessThan_v0 0us 1us = true +Stdlib.UInt16.lessThan_v0 1us 0us = false +Stdlib.UInt16.lessThan_v0 0us 65535us = true +Stdlib.UInt16.lessThan_v0 65535us 65535us = false + +Stdlib.UInt16.toString 120us = "120" +Stdlib.UInt16.toString 1us = "1" +Stdlib.UInt16.toString 0us = "0" // UInt16 lower limit +Stdlib.UInt16.toString 65535us = "65535" // UInt16 upper limit + +Stdlib.UInt16.toFloat_v0 2us = 2.0 +Stdlib.UInt16.toFloat_v0 0us = 0.0 + +Stdlib.UInt16.sqrt_v0 4us = 2.0 +Stdlib.UInt16.sqrt_v0 100us = 10.0 +Stdlib.UInt16.sqrt_v0 86us = 9.273618495495704 + +Stdlib.UInt16.mod_v0 15us 5us = 0us +Stdlib.UInt16.mod_v0 15us 6us = 3us +Stdlib.UInt16.mod_v0 0us 15us = 0us +Stdlib.UInt16.mod_v0 1us 2us = 1us +Stdlib.UInt16.mod_v0 32768us 53us = 14us +Stdlib.UInt16.mod_v0 65535us 3us = 0us + +// Stdlib.UInt16.mod_v0 5us 0us = Builtin.testDerrorMessage "Zero modulus" + + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 1us 2us) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt16.greaterThanOrEqualTo x 1us) + && (Stdlib.UInt16.lessThanOrEqualTo x 2us)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 10us 20us) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt16.greaterThanOrEqualTo x 10us) + && (Stdlib.UInt16.lessThanOrEqualTo x 20us)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 2us 1us) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt16.greaterThanOrEqualTo x 1us) + && (Stdlib.UInt16.lessThanOrEqualTo x 2us)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 20us 10us) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt16.greaterThanOrEqualTo x 10us) + && (Stdlib.UInt16.lessThanOrEqualTo x 20us)) = [ true; true; true; true; true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 0us 1us) + |> Stdlib.List.unique_v0) = [ 0us; 1us ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt16.random 0us 2us) + |> Stdlib.List.unique_v0) = [ 0us; 1us; 2us ] + +Stdlib.UInt16.sum_v0 [ 1us; 2us ] = 3us + +// Stdlib.UInt16.sum_v0 [ 1us; 65535us ] = Builtin.testDerrorMessage "Out of range" + +// Stdlib.UInt16.parse_v0 "-129" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.OutOfRange + +// Stdlib.UInt16.parse_v0 "65536" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.OutOfRange + +// Stdlib.UInt16.parse_v0 "65536us" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.UInt16.ParseError.BadFormat + +// Stdlib.UInt16.fromInt8_v0 0y = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromInt8_v0 1y = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromInt8_v0 127y = Stdlib.Option.Option.Some 127us + +// Stdlib.UInt16.fromInt8_v0 (-1y) = Stdlib.Option.Option.None +// Stdlib.UInt16.fromInt8_v0 (-128y) = Stdlib.Option.Option.None + +Stdlib.UInt16.fromUInt8_v0 0uy = 0us + +Stdlib.UInt16.fromUInt8_v0 1uy = 1us + +Stdlib.UInt16.fromUInt8_v0 255uy = 255us + +// Stdlib.UInt16.fromInt16_v0 0s = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromInt16_v0 1s = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767us + +// Stdlib.UInt16.fromInt16_v0 (-1s) = Stdlib.Option.Option.None +// Stdlib.UInt16.fromInt16_v0 (-32768s) = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromInt32_v0 0l = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromInt32_v0 1l = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromInt32_v0 65535l = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromInt32_v0 65536l = Stdlib.Option.Option.None +// Stdlib.UInt16.fromInt32_v0 (-1l) = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromUInt32_v0 65535ul = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromUInt32_v0 65536ul = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromInt64_v0 0L = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromInt64_v0 1L = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromInt64_v0 65535L = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromInt64_v0 65536L = Stdlib.Option.Option.None +// Stdlib.UInt16.fromInt64_v0 (-1L) = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromUInt64_v0 65535UL = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromUInt64_v0 65536UL = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromInt128_v0 65535Q = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromInt128_v0 65536Q = Stdlib.Option.Option.None +// Stdlib.UInt16.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None + +// Stdlib.UInt16.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0us + +// Stdlib.UInt16.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1us + +// Stdlib.UInt16.fromUInt128_v0 65535Z = Stdlib.Option.Option.Some 65535us + +// Stdlib.UInt16.fromUInt128_v0 65536Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/_uint32.dark b/backend/testfiles/execution/stdlib/ints/uint32.dark similarity index 52% rename from backend/testfiles/execution/stdlib/ints/_uint32.dark rename to backend/testfiles/execution/stdlib/ints/uint32.dark index bb7bf575ec..7a42965dfd 100644 --- a/backend/testfiles/execution/stdlib/ints/_uint32.dark +++ b/backend/testfiles/execution/stdlib/ints/uint32.dark @@ -19,12 +19,12 @@ Stdlib.UInt32.add_v0 88ul 9ul = 97ul Stdlib.UInt32.add_v0 1ul 0ul = 1ul Stdlib.UInt32.add_v0 4294967294ul 1ul = 4294967295ul -Stdlib.UInt32.add_v0 4294967295ul 1ul = Builtin.testDerrorMessage "Out of range" +// Stdlib.UInt32.add_v0 4294967295ul 1ul = Builtin.testDerrorMessage "Out of range" Stdlib.UInt32.subtract_v0 10ul 9ul = 1ul Stdlib.UInt32.subtract_v0 88ul 9ul = 79ul -Stdlib.UInt32.subtract_v0 0ul 1ul = Builtin.testDerrorMessage "Out of range" +// Stdlib.UInt32.subtract_v0 0ul 1ul = Builtin.testDerrorMessage "Out of range" Stdlib.UInt32.subtract_v0 1ul 0ul = 1ul Stdlib.UInt32.subtract_v0 4294967295ul 1ul = 4294967294ul @@ -33,7 +33,7 @@ Stdlib.UInt32.multiply_v0 8ul 8ul = 64ul Stdlib.UInt32.multiply_v0 8ul 0ul = 0ul Stdlib.UInt32.multiply_v0 2147483647ul 2ul = 4294967294ul -Stdlib.UInt32.multiply_v0 2147483648ul 2ul = Builtin.testDerrorMessage "Out of range" +// Stdlib.UInt32.multiply_v0 2147483648ul 2ul = Builtin.testDerrorMessage "Out of range" Stdlib.UInt32.power_v0 2ul 3ul = 8ul Stdlib.UInt32.power_v0 0ul 1ul = 0ul @@ -41,7 +41,7 @@ Stdlib.UInt32.power_v0 1ul 0ul = 1ul Stdlib.UInt32.power_v0 0ul 0ul = 1ul Stdlib.UInt32.power_v0 1ul 255ul = 1ul -Stdlib.UInt32.power_v0 65536ul 2ul = Builtin.testDerrorMessage "Out of range" +// Stdlib.UInt32.power_v0 65536ul 2ul = Builtin.testDerrorMessage "Out of range" Stdlib.UInt32.divide_v0 10ul 5ul = 2ul @@ -50,7 +50,7 @@ Stdlib.UInt32.divide_v0 8ul 5ul = 1ul Stdlib.UInt32.divide_v0 0ul 1ul = 0ul Stdlib.UInt32.divide_v0 4294967295ul 2ul = 2147483647ul -Stdlib.UInt32.divide_v0 1ul 0ul = Builtin.testDerrorMessage "Division by zero" +// Stdlib.UInt32.divide_v0 1ul 0ul = Builtin.testDerrorMessage "Division by zero" Stdlib.UInt32.greaterThan_v0 20ul 1ul = true @@ -95,7 +95,7 @@ Stdlib.UInt32.mod_v0 1ul 2ul = 1ul Stdlib.UInt32.mod_v0 32768ul 53ul = 14ul Stdlib.UInt32.mod_v0 4294967295ul 3ul = 0ul -Stdlib.UInt32.mod_v0 5ul 0ul = Builtin.testDerrorMessage "Zero modulus" +// Stdlib.UInt32.mod_v0 5ul 0ul = Builtin.testDerrorMessage "Zero modulus" (Stdlib.List.range_v0 1L 5L) @@ -132,64 +132,64 @@ Stdlib.UInt32.mod_v0 5ul 0ul = Builtin.testDerrorMessage "Zero modulus" Stdlib.UInt32.sum_v0 [ 1ul; 2ul ] = 3ul -Stdlib.UInt32.sum_v0 [ 1ul; 4294967295ul ] = Builtin.testDerrorMessage "Out of range" +// Stdlib.UInt32.sum_v0 [ 1ul; 4294967295ul ] = Builtin.testDerrorMessage "Out of range" -Stdlib.UInt32.parse_v0 "-129" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.OutOfRange +// Stdlib.UInt32.parse_v0 "-129" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.OutOfRange -Stdlib.UInt32.parse_v0 "4294967296" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.OutOfRange +// Stdlib.UInt32.parse_v0 "4294967296" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.OutOfRange -Stdlib.UInt32.parse_v0 "4294967296ul" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "4294967296ul" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "1 2 3" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "+ 1" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "- 1" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "0xA" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "0x123" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "0b0100" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "pi" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "1I" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "one" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.parse_v0 "XIV" = Stdlib.Result.Result.Error - Stdlib.UInt32.ParseError.BadFormat +// Stdlib.UInt32.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.UInt32.ParseError.BadFormat -Stdlib.UInt32.fromInt8_v0 0y = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromInt8_v0 0y = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromInt8_v0 1y = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromInt8_v0 1y = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromInt8_v0 127y = Stdlib.Option.Option.Some 127ul +// Stdlib.UInt32.fromInt8_v0 127y = Stdlib.Option.Option.Some 127ul -Stdlib.UInt32.fromInt8_v0 (-128y) = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt8_v0 (-128y) = Stdlib.Option.Option.None Stdlib.UInt32.fromUInt8_v0 0uy = 0ul @@ -197,13 +197,13 @@ Stdlib.UInt32.fromUInt8_v0 1uy = 1ul Stdlib.UInt32.fromUInt8_v0 255uy = 255ul -Stdlib.UInt32.fromInt16_v0 0s = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromInt16_v0 0s = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromInt16_v0 1s = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromInt16_v0 1s = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767ul +// Stdlib.UInt32.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767ul -Stdlib.UInt32.fromInt16_v0 (-32768s) = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt16_v0 (-32768s) = Stdlib.Option.Option.None Stdlib.UInt32.fromUInt16_v0 0us = 0ul @@ -211,44 +211,44 @@ Stdlib.UInt32.fromUInt16_v0 1us = 1ul Stdlib.UInt32.fromUInt16_v0 65535us = 65535ul -Stdlib.UInt32.fromInt32_v0 0l = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromInt32_v0 0l = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromInt32_v0 1l = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromInt32_v0 1l = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromInt32_v0 2147483647l = Stdlib.Option.Option.Some 2147483647ul +// Stdlib.UInt32.fromInt32_v0 2147483647l = Stdlib.Option.Option.Some 2147483647ul -Stdlib.UInt32.fromInt32_v0 (-2147483648l) = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt32_v0 (-2147483648l) = Stdlib.Option.Option.None -Stdlib.UInt32.fromInt64_v0 0L = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromInt64_v0 0L = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromInt64_v0 1L = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromInt64_v0 1L = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromInt64_v0 4294967295L = Stdlib.Option.Option.Some 4294967295ul +// Stdlib.UInt32.fromInt64_v0 4294967295L = Stdlib.Option.Option.Some 4294967295ul -Stdlib.UInt32.fromInt64_v0 4294967296L = Stdlib.Option.Option.None -Stdlib.UInt32.fromInt64_v0 (-1L) = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt64_v0 4294967296L = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt64_v0 (-1L) = Stdlib.Option.Option.None -Stdlib.UInt32.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromUInt64_v0 4294967295UL = Stdlib.Option.Option.Some 4294967295ul +// Stdlib.UInt32.fromUInt64_v0 4294967295UL = Stdlib.Option.Option.Some 4294967295ul -Stdlib.UInt32.fromUInt64_v0 4294967296UL = Stdlib.Option.Option.None +// Stdlib.UInt32.fromUInt64_v0 4294967296UL = Stdlib.Option.Option.None -Stdlib.UInt32.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromInt128_v0 4294967295Q = Stdlib.Option.Option.Some 4294967295ul +// Stdlib.UInt32.fromInt128_v0 4294967295Q = Stdlib.Option.Option.Some 4294967295ul -Stdlib.UInt32.fromInt128_v0 4294967296Q = Stdlib.Option.Option.None -Stdlib.UInt32.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt128_v0 4294967296Q = Stdlib.Option.Option.None +// Stdlib.UInt32.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None -Stdlib.UInt32.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0ul +// Stdlib.UInt32.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0ul -Stdlib.UInt32.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1ul +// Stdlib.UInt32.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1ul -Stdlib.UInt32.fromUInt128_v0 4294967295Z = Stdlib.Option.Option.Some 4294967295ul +// Stdlib.UInt32.fromUInt128_v0 4294967295Z = Stdlib.Option.Option.Some 4294967295ul -Stdlib.UInt32.fromUInt128_v0 4294967296Z = Stdlib.Option.Option.None \ No newline at end of file +// Stdlib.UInt32.fromUInt128_v0 4294967296Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/uint64.dark b/backend/testfiles/execution/stdlib/ints/uint64.dark new file mode 100644 index 0000000000..524d123233 --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/uint64.dark @@ -0,0 +1,273 @@ +Stdlib.UInt64.max_v0 5UL 6UL = 6UL +Stdlib.UInt64.max_v0 10UL 1UL = 10UL + + +Stdlib.UInt64.min_v0 5UL 6UL = 5UL +Stdlib.UInt64.min_v0 10UL 10UL = 10UL +Stdlib.UInt64.min_v0 18446744073709551615UL 0UL = 0UL + + +Stdlib.UInt64.clamp_v0 1UL 2UL 1UL = 1UL +Stdlib.UInt64.clamp_v0 3UL 0UL 2UL = 2UL +Stdlib.UInt64.clamp_v0 100UL 0UL 0UL = 0UL +Stdlib.UInt64.clamp_v0 100UL 1UL 0UL = 1UL + + +Stdlib.UInt64.mod_v0 15UL 5UL = 0UL +Stdlib.UInt64.mod_v0 15UL 6UL = 3UL +Stdlib.UInt64.mod_v0 0UL 15UL = 0UL +Stdlib.UInt64.mod_v0 9999999999998UL 3UL = 2UL + +// Stdlib.UInt64.mod_v0 5UL 0UL = Builtin.testDerrorMessage "Zero modulus" + + +Stdlib.UInt64.power_v0 8UL 5UL = 32768UL +Stdlib.UInt64.power_v0 0UL 1UL = 0UL +Stdlib.UInt64.power_v0 0UL 0UL = 1UL +Stdlib.UInt64.power_v0 1UL 0UL = 1UL +Stdlib.UInt64.power_v0 1000UL 0UL = 1UL + +// Stdlib.UInt64.power_v0 200UL 20UL = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt64.power_v0 200UL 7UL = 12800000000000000UL + +Stdlib.UInt64.power_v0 1UL 2147483649UL = 1UL + +Stdlib.UInt64.greaterThan_v0 20UL 1UL = true + + +Stdlib.UInt64.greaterThanOrEqualTo_v0 0UL 1UL = false +Stdlib.UInt64.greaterThanOrEqualTo_v0 1UL 0UL = true +Stdlib.UInt64.greaterThanOrEqualTo_v0 6UL 1UL = true +Stdlib.UInt64.greaterThanOrEqualTo_v0 6UL 8UL = false + +Stdlib.UInt64.lessThanOrEqualTo_v0 6UL 8UL = true +Stdlib.UInt64.lessThanOrEqualTo_v0 10UL 1UL = false +Stdlib.UInt64.lessThanOrEqualTo_v0 0UL 1UL = true +Stdlib.UInt64.lessThanOrEqualTo_v0 1UL 0UL = false + + +Stdlib.UInt64.lessThan_v0 6UL 8UL = true +Stdlib.UInt64.lessThan_v0 10UL 1UL = false +Stdlib.UInt64.lessThan_v0 0UL 1UL = true +Stdlib.UInt64.lessThan_v0 1UL 0UL = false + + +Stdlib.UInt64.sqrt_v0 4UL = 2.0 +Stdlib.UInt64.sqrt_v0 100UL = 10.0 +Stdlib.UInt64.sqrt_v0 86UL = 9.273618495495704 + +Stdlib.UInt64.toFloat_v0 2UL = 2.0 +Stdlib.UInt64.toFloat_v0 955656UL = 955656.0 + +Stdlib.UInt64.add_v0 10UL 9UL = 19UL +Stdlib.UInt64.add_v0 88UL 9UL = 97UL +Stdlib.UInt64.add_v0 1UL 0UL = 1UL +Stdlib.UInt64.add_v0 18446744073709551614UL 1UL = 18446744073709551615UL + +// Overflow tests +// Stdlib.UInt64.add_v0 18446744073709551615UL 1UL = Builtin.testDerrorMessage +// "Out of range" + +// Stdlib.UInt64.add_v0 55UL 18446744073709551615UL = Builtin.testDerrorMessage +// "Out of range" + + +Stdlib.UInt64.subtract_v0 10UL 9UL = 1UL +Stdlib.UInt64.subtract_v0 88UL 9UL = 79UL +Stdlib.UInt64.subtract_v0 1UL 0UL = 1UL + +Stdlib.UInt64.multiply_v0 8UL 8UL = 64UL +Stdlib.UInt64.multiply_v0 5145UL 5145UL = 26471025UL + +// Stdlib.UInt64.multiply_v0 9223372036854775808UL 2UL = Builtin.testDerrorMessage +// "Out of range" + +Stdlib.UInt64.divide_v0 10UL 5UL = 2UL +Stdlib.UInt64.divide_v0 17UL 3UL = 5UL +Stdlib.UInt64.divide_v0 0UL 1UL = 0UL + +// Stdlib.UInt64.divide_v0 1UL 0UL = Builtin.testDerrorMessage "Division by zero" + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 1UL 2UL) +|> Stdlib.List.map_v0 (fun x -> + (Builtin.uint64GreaterThanOrEqualTo x 1UL) + && (Builtin.uint64LessThanOrEqualTo x 2UL)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 10UL 20UL) +|> Stdlib.List.map_v0 (fun x -> + (Builtin.uint64GreaterThanOrEqualTo x 10UL) + && (Builtin.uint64LessThanOrEqualTo x 20UL)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 2UL 1UL) +|> Stdlib.List.map_v0 (fun x -> + (Builtin.uint64GreaterThanOrEqualTo x 1UL) + && (Builtin.uint64LessThanOrEqualTo x 2UL)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 20UL 10UL) +|> Stdlib.List.map_v0 (fun x -> + (Builtin.uint64GreaterThanOrEqualTo x 10UL) + && (Builtin.uint64LessThanOrEqualTo x 20UL)) = [ true; true; true; true; true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 0UL 1UL) + |> Stdlib.List.unique_v0) = [ 0UL; 1UL ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt64.random 0UL 2UL) + |> Stdlib.List.unique_v0) = [ 0UL; 1UL; 2UL ] + +Stdlib.UInt64.sum_v0 [ 1UL; 2UL ] = 3UL + +// Stdlib.UInt64.parse_v0 "0" = Stdlib.Result.Result.Ok 0UL + +// Stdlib.UInt64.parse_v0 "1" = Stdlib.Result.Result.Ok 1UL + +// Stdlib.UInt64.parse_v0 " 1" = Stdlib.Result.Result.Ok 1UL + +// Stdlib.UInt64.parse_v0 "1 " = Stdlib.Result.Result.Ok 1UL + +// Stdlib.UInt64.parse_v0 "+1" = Stdlib.Result.Result.Ok 1UL + +// Stdlib.UInt64.parse_v0 " +1 " = Stdlib.Result.Result.Ok 1UL + +// Stdlib.UInt64.parse_v0 "-1" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.OutOfRange + +// Stdlib.UInt64.parse_v0 "078" = Stdlib.Result.Result.Ok 78UL // "octal" format ignored + +// Stdlib.UInt64.parse_v0 "-00001" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.OutOfRange + +// Stdlib.UInt64.parse_v0 "-10001" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.OutOfRange + +// Stdlib.UInt64.parse_v0 "18446744073709551615" = Stdlib.Result.Result.Ok +// 18446744073709551615UL + +// Stdlib.UInt64.parse_v0 "18446744073709551616" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.OutOfRange + +// Stdlib.UInt64.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "18446744073709551616" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.OutOfRange + +// Stdlib.UInt64.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + +// Stdlib.UInt64.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.UInt64.ParseError.BadFormat + + +Stdlib.UInt64.toString 0UL = "0" +Stdlib.UInt64.toString 1UL = "1" +Stdlib.UInt64.toString 18446744073709551615UL = "18446744073709551615" + + +// Stdlib.UInt64.fromInt8_v0 0y = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromInt8_v0 1y = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromInt8_v0 127y = Stdlib.Option.Option.Some 127UL + +// Stdlib.UInt64.fromInt8_v0 -128y = Stdlib.Option.Option.None + +Stdlib.UInt64.fromUInt8_v0 0uy = 0UL + +Stdlib.UInt64.fromUInt8_v0 1uy = 1UL + +Stdlib.UInt64.fromUInt8_v0 255uy = 255UL + +// Stdlib.UInt64.fromInt16_v0 0s = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromInt16_v0 1s = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromInt16_v0 32767s = Stdlib.Option.Option.Some 32767UL + +// Stdlib.UInt64.fromInt16_v0 -32768s = Stdlib.Option.Option.None + +Stdlib.UInt64.fromUInt16_v0 0us = 0UL + +Stdlib.UInt64.fromUInt16_v0 1us = 1UL + +Stdlib.UInt64.fromUInt16_v0 65535us = 65535UL + +// Stdlib.UInt64.fromInt32_v0 0l = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromInt32_v0 1l = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromInt32_v0 2147483647l = Stdlib.Option.Option.Some 2147483647UL + +// Stdlib.UInt64.fromInt32_v0 -1l = Stdlib.Option.Option.None + +Stdlib.UInt64.fromUInt32_v0 0ul = 0UL + +Stdlib.UInt64.fromUInt32_v0 1ul = 1UL + +Stdlib.UInt64.fromUInt32_v0 4294967295ul = 4294967295UL + +// Stdlib.UInt64.fromInt64_v0 0L = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromInt64_v0 1L = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromInt64_v0 9223372036854775807L = Stdlib.Option.Option.Some +// 9223372036854775807UL + +// Stdlib.UInt64.fromInt64_v0 -1L = Stdlib.Option.Option.None + +// Stdlib.UInt64.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromInt128_v0 -1Q = Stdlib.Option.Option.None + +// Stdlib.UInt64.fromInt128_v0 18446744073709551616Q = Stdlib.Option.Option.None + +// Stdlib.UInt64.fromInt128_v0 170141183460469231731687303715884105727Q = Stdlib.Option.Option.None + +// Stdlib.UInt64.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0UL + +// Stdlib.UInt64.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1UL + +// Stdlib.UInt64.fromUInt128_v0 18446744073709551615Z = Stdlib.Option.Option.Some +// 18446744073709551615UL + +// Stdlib.UInt64.fromUInt128_v0 18446744073709551616Z = Stdlib.Option.Option.None + +// Stdlib.UInt64.fromUInt128_v0 340282366920938463463374607431768211455Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/ints/uint8.dark b/backend/testfiles/execution/stdlib/ints/uint8.dark new file mode 100644 index 0000000000..801ef0859b --- /dev/null +++ b/backend/testfiles/execution/stdlib/ints/uint8.dark @@ -0,0 +1,262 @@ +Stdlib.UInt8.max_v0 5uy 6uy = 6uy +Stdlib.UInt8.max_v0 10uy 1uy = 10uy +Stdlib.UInt8.max_v0 0uy 6uy = 6uy +Stdlib.UInt8.max_v0 255uy 0uy = 255uy + +Stdlib.UInt8.min_v0 5uy 6uy = 5uy +Stdlib.UInt8.min_v0 10uy 10uy = 10uy +Stdlib.UInt8.min_v0 255uy 0uy = 0uy + +Stdlib.UInt8.clamp_v0 1uy 2uy 1uy = 1uy +Stdlib.UInt8.clamp_v0 3uy 0uy 2uy = 2uy +Stdlib.UInt8.clamp_v0 100uy 0uy 0uy = 0uy +Stdlib.UInt8.clamp_v0 100uy 0uy 1uy = 1uy +Stdlib.UInt8.clamp_v0 100uy 1uy 0uy = 1uy + + +Stdlib.UInt8.add_v0 10uy 9uy = 19uy +Stdlib.UInt8.add_v0 88uy 9uy = 97uy +Stdlib.UInt8.add_v0 1uy 0uy = 1uy +Stdlib.UInt8.add_v0 254uy 1uy = 255uy + +// Stdlib.UInt8.add_v0 255uy 1uy = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt8.subtract_v0 10uy 9uy = 1uy +Stdlib.UInt8.subtract_v0 88uy 9uy = 79uy + +// Stdlib.UInt8.subtract_v0 0uy 1uy = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt8.subtract_v0 1uy 0uy = 1uy +Stdlib.UInt8.subtract_v0 255uy 1uy = 254uy + +Stdlib.UInt8.multiply_v0 8uy 8uy = 64uy +Stdlib.UInt8.multiply_v0 8uy 0uy = 0uy +Stdlib.UInt8.multiply_v0 127uy 2uy = 254uy + +// Stdlib.UInt8.multiply_v0 128uy 2uy = Builtin.testDerrorMessage "Out of range" + +// Stdlib.UInt8.multiply_v0 255uy 2uy = Builtin.testDerrorMessage "Out of range" + +Stdlib.UInt8.power_v0 2uy 3uy = 8uy +Stdlib.UInt8.power_v0 0uy 1uy = 0uy +Stdlib.UInt8.power_v0 1uy 0uy = 1uy +Stdlib.UInt8.power_v0 0uy 0uy = 1uy +Stdlib.UInt8.power_v0 1uy 255uy = 1uy + +// Stdlib.UInt8.power_v0 16uy 2uy = Builtin.testDerrorMessage "Out of range" + + +Stdlib.UInt8.divide_v0 10uy 5uy = 2uy +Stdlib.UInt8.divide_v0 17uy 3uy = 5uy +Stdlib.UInt8.divide_v0 8uy 5uy = 1uy +Stdlib.UInt8.divide_v0 0uy 1uy = 0uy +Stdlib.UInt8.divide_v0 255uy 2uy = 127uy + +// Stdlib.UInt8.divide_v0 1uy 0uy = Builtin.testDerrorMessage "Division by zero" + +Stdlib.UInt8.greaterThan_v0 20uy 1uy = true + +Stdlib.UInt8.greaterThanOrEqualTo_v0 0uy 1uy = false +Stdlib.UInt8.greaterThanOrEqualTo_v0 1uy 0uy = true +Stdlib.UInt8.greaterThanOrEqualTo_v0 6uy 1uy = true +Stdlib.UInt8.greaterThanOrEqualTo_v0 6uy 8uy = false +Stdlib.UInt8.greaterThanOrEqualTo_v0 255uy 0uy = true +Stdlib.UInt8.greaterThanOrEqualTo_v0 0uy 255uy = false + +Stdlib.UInt8.lessThanOrEqualTo_v0 6uy 8uy = true +Stdlib.UInt8.lessThanOrEqualTo_v0 10uy 1uy = false +Stdlib.UInt8.lessThanOrEqualTo_v0 0uy 1uy = true +Stdlib.UInt8.lessThanOrEqualTo_v0 1uy 0uy = false +Stdlib.UInt8.lessThanOrEqualTo_v0 255uy 0uy = false +Stdlib.UInt8.lessThanOrEqualTo_v0 0uy 255uy = true +Stdlib.UInt8.lessThanOrEqualTo_v0 255uy 255uy = true + +Stdlib.UInt8.lessThan_v0 6uy 8uy = true +Stdlib.UInt8.lessThan_v0 10uy 1uy = false +Stdlib.UInt8.lessThan_v0 0uy 1uy = true +Stdlib.UInt8.lessThan_v0 1uy 0uy = false +Stdlib.UInt8.lessThan_v0 0uy 255uy = true +Stdlib.UInt8.lessThan_v0 255uy 255uy = false + +Stdlib.UInt8.toString 120uy = "120" +Stdlib.UInt8.toString 1uy = "1" +Stdlib.UInt8.toString 0uy = "0" // UInt8 lower limit +Stdlib.UInt8.toString 255uy = "255" // UInt8 upper limit + +Stdlib.UInt8.toFloat_v0 2uy = 2.0 +Stdlib.UInt8.toFloat_v0 0uy = 0.0 + +Stdlib.UInt8.sqrt_v0 4uy = 2.0 +Stdlib.UInt8.sqrt_v0 100uy = 10.0 +Stdlib.UInt8.sqrt_v0 86uy = 9.273618495495704 + +Stdlib.UInt8.mod_v0 15uy 5uy = 0uy +Stdlib.UInt8.mod_v0 15uy 6uy = 3uy +Stdlib.UInt8.mod_v0 0uy 15uy = 0uy +Stdlib.UInt8.mod_v0 1uy 2uy = 1uy +Stdlib.UInt8.mod_v0 128uy 53uy = 22uy +Stdlib.UInt8.mod_v0 255uy 3uy = 0uy + +// Stdlib.UInt8.mod_v0 5uy 0uy = Builtin.testDerrorMessage "Zero modulus" + + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 1uy 2uy) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt8.greaterThanOrEqualTo x 1uy) + && (Stdlib.UInt8.lessThanOrEqualTo x 2uy)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 10uy 20uy) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt8.greaterThanOrEqualTo x 10uy) + && (Stdlib.UInt8.lessThanOrEqualTo x 20uy)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 2uy 1uy) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt8.greaterThanOrEqualTo x 1uy) + && (Stdlib.UInt8.lessThanOrEqualTo x 2uy)) = [ true; true; true; true; true ] + +(Stdlib.List.range_v0 1L 5L) +|> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 20uy 10uy) +|> Stdlib.List.map_v0 (fun x -> + (Stdlib.UInt8.greaterThanOrEqualTo x 10uy) + && (Stdlib.UInt8.lessThanOrEqualTo x 20uy)) = [ true; true; true; true; true ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 0uy 1uy) + |> Stdlib.List.unique_v0) = [ 0uy; 1uy ] + +((Stdlib.List.range_v0 1L 100L) + |> Stdlib.List.map_v0 (fun x -> Stdlib.UInt8.random 0uy 2uy) + |> Stdlib.List.unique_v0) = [ 0uy; 1uy; 2uy ] + +Stdlib.UInt8.sum_v0 [ 1uy; 2uy ] = 3uy + +// Stdlib.UInt8.sum_v0 [ 1uy; 255uy ] = Builtin.testDerrorMessage "Out of range" + +// Stdlib.UInt8.parse_v0 "-129" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.OutOfRange + +// Stdlib.UInt8.parse_v0 "256" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.OutOfRange + +// Stdlib.UInt8.parse_v0 "256uy" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "1 2 3" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "+ 1" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "- 1" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "0xA" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "0x123" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "0b0100" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "pi" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "PACKAGE.Darklang.Stdlib.Math.pi" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "1.23E+04" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "1I" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "one" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + +// Stdlib.UInt8.parse_v0 "XIV" = Stdlib.Result.Result.Error +// Stdlib.UInt8.ParseError.BadFormat + + +// Stdlib.UInt8.fromInt8_v0 0y = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromInt8_v0 1y = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromInt8_v0 127y = Stdlib.Option.Option.Some 127uy + +// Stdlib.UInt8.fromInt8_v0 (-128y) = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromInt16_v0 0s = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromInt16_v0 1s = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromInt16_v0 255s = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromInt16_v0 256s = Stdlib.Option.Option.None +// Stdlib.UInt8.fromInt16_v0 (-1s) = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromUInt16_v0 0us = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromUInt16_v0 1us = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromUInt16_v0 255us = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromUInt16_v0 256us = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromInt32_v0 0l = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromInt32_v0 1l = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromInt32_v0 255l = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromInt32_v0 256l = Stdlib.Option.Option.None +// Stdlib.UInt8.fromInt32_v0 (-1l) = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromUInt32_v0 0ul = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromUInt32_v0 1ul = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromUInt32_v0 255ul = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromUInt32_v0 256ul = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromInt64_v0 0L = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromInt64_v0 1L = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromInt64_v0 255L = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromInt64_v0 256L = Stdlib.Option.Option.None +// Stdlib.UInt8.fromInt64_v0 (-1L) = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromUInt64_v0 0UL = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromUInt64_v0 1UL = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromUInt64_v0 255UL = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromUInt64_v0 256UL = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromInt128_v0 0Q = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromInt128_v0 1Q = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromInt128_v0 255Q = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromInt128_v0 256Q = Stdlib.Option.Option.None +// Stdlib.UInt8.fromInt128_v0 (-1Q) = Stdlib.Option.Option.None + +// Stdlib.UInt8.fromUInt128_v0 0Z = Stdlib.Option.Option.Some 0uy + +// Stdlib.UInt8.fromUInt128_v0 1Z = Stdlib.Option.Option.Some 1uy + +// Stdlib.UInt8.fromUInt128_v0 255Z = Stdlib.Option.Option.Some 255uy + +// Stdlib.UInt8.fromUInt128_v0 256Z = Stdlib.Option.Option.None \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/option.dark b/backend/testfiles/execution/stdlib/option.dark index fce5eac642..5e64ae54a3 100644 --- a/backend/testfiles/execution/stdlib/option.dark +++ b/backend/testfiles/execution/stdlib/option.dark @@ -313,23 +313,23 @@ Stdlib.Option.join_v0 (Stdlib.Option.Option.Some(Stdlib.Option.Option.None)) = S Stdlib.Option.join_v0 Stdlib.Option.Option.None = Stdlib.Option.Option.None -// Stdlib.Option.combine_v0 -// [ Stdlib.Option.Option.Some 6L -// Stdlib.Option.Option.Some 5L -// Stdlib.Option.Option.Some 4L -// Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.Some [ 6L; 5L; 4L; 3L ] - -// Stdlib.Option.combine_v0 -// [ Stdlib.Option.Option.Some 6L -// Stdlib.Option.Option.None -// Stdlib.Option.Option.Some 4L -// Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.None - -// Stdlib.Option.combine_v0 -// [ Stdlib.Option.Option.None -// Stdlib.Option.Option.None -// Stdlib.Option.Option.None -// Stdlib.Option.Option.None ] = Stdlib.Option.Option.None +Stdlib.Option.combine_v0 + [ Stdlib.Option.Option.Some 6L + Stdlib.Option.Option.Some 5L + Stdlib.Option.Option.Some 4L + Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.Some [ 6L; 5L; 4L; 3L ] + +Stdlib.Option.combine_v0 + [ Stdlib.Option.Option.Some 6L + Stdlib.Option.Option.None + Stdlib.Option.Option.Some 4L + Stdlib.Option.Option.Some 3L ] = Stdlib.Option.Option.None + +Stdlib.Option.combine_v0 + [ Stdlib.Option.Option.None + Stdlib.Option.Option.None + Stdlib.Option.Option.None + Stdlib.Option.Option.None ] = Stdlib.Option.Option.None Stdlib.Option.values diff --git a/backend/testfiles/execution/stdlib/string.dark b/backend/testfiles/execution/stdlib/string.dark index fa6392b283..b76ac2e5bc 100644 --- a/backend/testfiles/execution/stdlib/string.dark +++ b/backend/testfiles/execution/stdlib/string.dark @@ -141,16 +141,16 @@ module EndsWith = Stdlib.String.endsWith_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🏳️‍⚧️‍️🇵🇷" = true -// module Map = -// Stdlib.String.map "a string" (fun x -> x) = "a string" -// Stdlib.String.map "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" (fun x -> x) = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.map "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" (fun x -> x) = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.map "👱👱🏻👱🏼👱🏽👱🏾👱🏿" (fun x -> x) = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.map "🧟‍♀️🧟‍♂️" (fun x -> x) = "🧟‍♀️🧟‍♂️" +module Map = + Stdlib.String.map "a string" (fun x -> x) = "a string" + Stdlib.String.map "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" (fun x -> x) = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.map "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" (fun x -> x) = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.map "👱👱🏻👱🏼👱🏽👱🏾👱🏿" (fun x -> x) = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.map "🧟‍♀️🧟‍♂️" (fun x -> x) = "🧟‍♀️🧟‍♂️" -// Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> x) = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> x) = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" -// Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 'c') = "cccc" + Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 'c') = "cccc" // // CLEANUP: it should be a type error on the function not returning a Char // Stdlib.String.map "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" (fun x -> 5L) = Builtin.testDerrorMessage @@ -162,12 +162,12 @@ module EndsWith = // ]""" -// // Check that map executes the right number of times -// (let v = -// Stdlib.String.map "a string" (fun x -> -// let _ = Builtin.testIncrementSideEffectCounter_v0 false in 'c') + // Check that map executes the right number of times + (let v = + Stdlib.String.map "a string" (fun x -> + let _ = Builtin.testIncrementSideEffectCounter_v0 false in 'c') -// (v, Builtin.testSideEffectCount_v0 ())) = ("cccccccc", 8L) + (v, Builtin.testSideEffectCount_v0 ())) = ("cccccccc", 8L) module FromChar = @@ -301,36 +301,36 @@ module Digest = Stdlib.String.digest_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "3QFqrhTPpxeje6XUNObFt2eJZZ1t0pAcX42AFdFVv42hco0bTOopQK3py4KMBT0m" -// module Random = -// (Stdlib.String.random 5L) == (Stdlib.String.random 5L) = false +module Random = + (Stdlib.String.random 5L) == (Stdlib.String.random 5L) = false -// Stdlib.String.random -1L = Stdlib.Result.Result.Error -// "Expected `length` to be positive, but it was `-1`" + Stdlib.String.random -1L = Stdlib.Result.Result.Error + "Expected `length` to be positive, but it was `-1`" -// Stdlib.String.length ((Stdlib.String.random 10L) |> Builtin.unwrap) = 10L + Stdlib.String.length ((Stdlib.String.random 10L) |> Builtin.unwrap) = 10L -// Stdlib.String.length ((Stdlib.String.random 5L) |> Builtin.unwrap) = 5L + Stdlib.String.length ((Stdlib.String.random 5L) |> Builtin.unwrap) = 5L -// Stdlib.String.length ((Stdlib.String.random 0L) |> Builtin.unwrap) = 0L + Stdlib.String.length ((Stdlib.String.random 0L) |> Builtin.unwrap) = 0L -// module HtmlEscape = -// Stdlib.String.htmlEscape_v0 "test<>&\"" = "test<>&"" // HTML escaping works reasonably +module HtmlEscape = + Stdlib.String.htmlEscape_v0 "test<>&\"" = "test<>&"" // HTML escaping works reasonably -// Stdlib.String.htmlEscape_v0 -// "

This is f#

" = "<html><head></head><body><h1>This is f#</h1></body></html>" // HTML escaping works reasonably + Stdlib.String.htmlEscape_v0 + "

This is f#

" = "<html><head></head><body><h1>This is f#</h1></body></html>" // HTML escaping works reasonably -// Stdlib.String.htmlEscape_v0 -// "" = "<html><head><!-- head definitions go here --></head><body><!-- the content goes here --></body></html>" + Stdlib.String.htmlEscape_v0 + "" = "<html><head><!-- head definitions go here --></head><body><!-- the content goes here --></body></html>" -// Stdlib.String.htmlEscape_v0 "" = "" -// Stdlib.String.htmlEscape_v0 "😄" = "😄" -// Stdlib.String.htmlEscape_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.htmlEscape_v0 "" = "" + Stdlib.String.htmlEscape_v0 "😄" = "😄" + Stdlib.String.htmlEscape_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.htmlEscape_v0 "

﷽﷽﷽﷽﷽

" = "<html><head></head><body><h1>﷽﷽﷽﷽﷽</h1></body></html>" + Stdlib.String.htmlEscape_v0 "

﷽﷽﷽﷽﷽

" = "<html><head></head><body><h1>﷽﷽﷽﷽﷽</h1></body></html>" -// Stdlib.String.htmlEscape_v0 "🧟‍♀️🧟‍♂️" = "<head>🧟‍♀️🧟‍♂️</head>" -// Stdlib.String.htmlEscape_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.htmlEscape_v0 "🧟‍♀️🧟‍♂️" = "<head>🧟‍♀️🧟‍♂️</head>" + Stdlib.String.htmlEscape_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" module IsEmpty = @@ -426,11 +426,11 @@ module Slugify = Builtin.stringSlugify "{|}~\x7F" = "" -// module FromList = -// Stdlib.String.fromList [] = "" -// Stdlib.String.fromList [ c "a" ] = "a" +module FromList = + Stdlib.String.fromList [] = "" + Stdlib.String.fromList [ c "a" ] = "a" -// Stdlib.String.fromList [ c "👩‍👩‍👧‍👦"; c "🏳️‍⚧️‍️"; c "👱🏾"; c "Z̤͔ͧ̑̓" ] = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" + Stdlib.String.fromList [ c "👩‍👩‍👧‍👦"; c "🏳️‍⚧️‍️"; c "👱🏾"; c "Z̤͔ͧ̑̓" ] = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" // Stdlib.String.fromList [ "a" ] = Builtin.testDerrorMessage // "PACKAGE.Darklang.Stdlib.String.fromList's 1st argument (`lst`) should be a List. However, a List ([ \"a\"]) was passed instead. @@ -447,22 +447,22 @@ module ToList = Stdlib.String.toList "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ (c "Z̤͔ͧ̑̓"); (c "ä͖̭̈̇"); (c "lͮ̒ͫ"); (c "ǧ̗͚̚"); (c "o̙̔ͮ̇͐̇") ] -// Stdlib.String.toList "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = [ (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") -// (c "﷽") ] + // Stdlib.String.toList "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = [ (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") + // (c "﷽") ] Stdlib.String.toList "🧟‍♀️🧟‍♂️" = [ c "🧟‍♀️"; c "🧟‍♂️" ] @@ -470,23 +470,23 @@ module ToList = [ (c "👱"); (c "👱🏻"); (c "👱🏼"); (c "👱🏽"); (c "👱🏾"); (c "👱🏿") ] -// Stdlib.String.toList "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = [ (c "ż") -// (c "ó") -// (c "ł") -// (c "w") -// (c "🧑🏽‍🦰") -// (c "🧑🏻‍🍼") -// (c "✋") -// (c "✋🏻") -// (c "✋🏿") ] + // Stdlib.String.toList "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = [ (c "ż") + // (c "ó") + // (c "ł") + // (c "w") + // (c "🧑🏽‍🦰") + // (c "🧑🏻‍🍼") + // (c "✋") + // (c "✋🏻") + // (c "✋🏿") ] -// ("ab1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "ab1" + ("ab1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "ab1" -// ("@Ǣá1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "@Ǣá1" + ("@Ǣá1" |> Stdlib.String.toList |> Stdlib.String.fromList) = "@Ǣá1" -// ("👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" -// |> Stdlib.String.toList -// |> Stdlib.String.fromList) = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" + ("👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" + |> Stdlib.String.toList + |> Stdlib.String.fromList) = "👩‍👩‍👧‍👦🏳️‍⚧️‍️👱🏾Z̤͔ͧ̑̓" module Split = @@ -500,11 +500,9 @@ module Split = Stdlib.String.split "" "34564" = [ "" ] Stdlib.String.split "34564" "" = [ "3"; "4"; "5"; "6"; "4" ] - Stdlib.String.split "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" = [ "🧑🏽‍🦰🧑🏼‍💻" - "✋✋🏻✋🏿" ] + Stdlib.String.split "🧑🏽‍🦰🧑🏼‍💻🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏻‍🍼" = [ "🧑🏽‍🦰🧑🏼‍💻"; "✋✋🏻✋🏿" ] - // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ "" - // "" ] + Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = [ ""; "" ] Stdlib.String.split "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "﷽﷽﷽﷽" = [ ""; ""; ""; ""; "" ] @@ -512,14 +510,11 @@ module Split = Stdlib.String.split "🧟‍♀️🧟‍♂️" "👱🏽" = [ "🧟‍♀️🧟‍♂️" ] - // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = [ "👨‍❤️‍💋‍👨" - // "🏳️‍⚧️‍️🇵🇷" ] + Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = [ "👨‍❤️‍💋‍👨"; "🏳️‍⚧️‍️🇵🇷" ] - // Stdlib.String.split "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = [ "żółw" - // "🧑🏻‍🍼✋✋🏻✋🏿" ] + Stdlib.String.split "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = [ "żółw"; "🧑🏻‍🍼✋✋🏻✋🏿" ] - // Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" = [ "" - // "ǧ̗͚̚o̙̔ͮ̇͐̇" ] + Stdlib.String.split "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" = [ ""; "ǧ̗͚̚o̙̔ͮ̇͐̇" ] Stdlib.String.split "666666" "6" = [ ""; ""; ""; ""; ""; ""; "" ] Stdlib.String.split "55555" "5" = [ ""; ""; ""; ""; ""; "" ] @@ -566,403 +561,403 @@ module Split = "" ] // Stdlib.String.split "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "" = [ "👨‍❤️‍💋‍👨" - // "👩‍👩‍👧‍👦" - // "🏳️‍⚧️‍️" - // "🇵🇷" ] + // "👩‍👩‍👧‍👦" + // "🏳️‍⚧️‍️" + // "🇵🇷" ] Stdlib.String.split "👨‍👩‍👧‍👦" "👩" = [ "👨‍👩‍👧‍👦" ] -// module ToLowercase = -// Stdlib.String.toLowercase "HELLO😄WORLD" = "hello😄world" -// Stdlib.String.toLowercase "" = "" -// Stdlib.String.toLowercase "ABCDEF" = "abcdef" // Stdlib.String.toLowercase_v0 works for ASCII range -// Stdlib.String.toLowercase "AB323CDEF" = "ab323cdef" -// Stdlib.String.toLowercase "SÁNCHEZ" = "sánchez" // not lowercase a -// Stdlib.String.toLowercase "sánchez" = "sánchez" -// Stdlib.String.toLowercase "ŻÓŁW" = "żółw" // Stdlib.String.toLowercase works on non-ascii strings -// Stdlib.String.toLowercase "😄ORANGE" = "😄orange" -// Stdlib.String.toLowercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.toLowercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.toLowercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.toLowercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" -// Stdlib.String.toLowercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" -// Stdlib.String.toLowercase "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.toLowercase "Ჾ" = "ჾ" -// Stdlib.String.toLowercase "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" = "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" - -// Stdlib.String.toLowercase -// "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "h̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈w̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠b̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅt͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝w͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" - - - -// module ToUppercase = -// Stdlib.String.toUppercase "" = "" -// Stdlib.String.toUppercase "hello😄world" = "HELLO😄WORLD" -// Stdlib.String.toUppercase "abcdef" = "ABCDEF" -// Stdlib.String.toUppercase "ab323cdef" = "AB323CDEF" -// Stdlib.String.toUppercase "sánchez" = "SÁNCHEZ" // not lowercase a -// Stdlib.String.toUppercase "SÁNChEZ" = "SÁNCHEZ" -// Stdlib.String.toUppercase "żółw" = "ŻÓŁW" -// Stdlib.String.toUppercase "😄orange" = "😄ORANGE" -// Stdlib.String.toUppercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.toUppercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.toUppercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.toUppercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" -// Stdlib.String.toUppercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" -// Stdlib.String.toUppercase "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.toUppercase "ჾ" = "Ჾ" - -// // TODO: There are two types of unicode case "mapping" (conversion), "simple" -// // and "full". .NET supports simple mapping, which maps a single character to a -// // single character. It does not support "full" mapping, which maps a single -// // character to multiple characters. - -// // Discussed at https://github.com/dotnet/runtime/issues/30960, specifially -// // https://github.com/dotnet/runtime/issues/30960#issuecomment-535274401 - -// // A possible solution is to write our own case mapper, or reuse an existing -// // one. A potential candidate is -// // https://github.com/dotnet/corefxlab/tree/archive/src/System.Text.CaseFolding -// // (packaged at -// // https://dnceng.visualstudio.com/public/_packaging?_a=package&feed=dotnet-experimental&view=overview&package=System.Text.CaseFolding&version=0.1.2-alpha.21059.1&protocolType=NuGet) - -// Stdlib.String.toUppercase "fifl" = "fifl" // should be "FIFL" -// Stdlib.String.toUppercase "և" = "և" // should be "ԵՒ" - -// Stdlib.String.toUppercase "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" - -// Stdlib.String.toUppercase -// "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "H̬̤̗̤͝E͜ ̜̥̝̻͍̟́W̕H̖̯͓O̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭A̺̪͍Į͈͕̭͙̯̜T̶̼̮S̘͙͖̕ ̠̫̠B̻͍͙͉̳ΙE̵H̵̬͇̫͙I̹͓̳̳̮͎̫̕N͟D̴̪̜̖ ̰͉̩͇͙̲͞ΙT͖̼͓̪͢H͏͓̮̻E̬̝̟Ι ̤̹̝W͙̞̝͔͇͝ΙA͏͓͔̹̼̣L̴͔̰̤̟͔Ḽ̫.͕" - - - -// module TrimEnd = -// Stdlib.String.trimEnd_v0 " " = "" -// Stdlib.String.trimEnd_v0 "" = "" -// Stdlib.String.trimEnd_v0 " foo " = " foo" -// Stdlib.String.trimEnd_v0 " foo bar " = " foo bar" -// Stdlib.String.trimEnd_v0 " foo" = " foo" -// Stdlib.String.trimEnd_v0 " 😄foobar😄 " = " 😄foobar😄" -// Stdlib.String.trimEnd_v0 "  foo bar  " = "  foo bar" -// Stdlib.String.trimEnd_v0 "foo " = "foo" -// Stdlib.String.trimEnd_v0 "foo" = "foo" - -// Stdlib.String.trimEnd_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" - -// Stdlib.String.trimEnd_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" - -// Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.trimEnd_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.trimEnd_v0 " ﷽﷽ " = " ﷽﷽" -// Stdlib.String.trimEnd_v0 " 🧟‍♀️🧟‍♂️ " = " 🧟‍♀️🧟‍♂️" - -// Stdlib.String.trimEnd_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" - -// Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.trimEnd_v0 "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" = "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" - - -// module TrimStart = -// Stdlib.String.trimStart_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " - -// Stdlib.String.trimStart_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " - -// Stdlib.String.trimStart_v0 " " = "" -// Stdlib.String.trimStart_v0 "" = "" -// Stdlib.String.trimStart_v0 " foo " = "foo " -// Stdlib.String.trimStart_v0 " foo bar " = "foo bar " -// Stdlib.String.trimStart_v0 " foo" = "foo" -// Stdlib.String.trimStart_v0 " 😄foobar😄 " = "😄foobar😄 " -// Stdlib.String.trimStart_v0 "  foo bar  " = "foo bar  " -// Stdlib.String.trimStart_v0 "foo " = "foo " -// Stdlib.String.trimStart_v0 "foo" = "foo" -// Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " -// Stdlib.String.trimStart_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " -// Stdlib.String.trimStart_v0 " ﷽﷽ " = "﷽﷽ " -// Stdlib.String.trimStart_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️ " - -// Stdlib.String.trimStart_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " - -// Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " - - -// module Trim = -// Stdlib.String.trim_v0 " " = "" -// Stdlib.String.trim_v0 "" = "" -// Stdlib.String.trim_v0 " foo " = "foo" // String trims both leading + trailing spaces -// Stdlib.String.trim_v0 " foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched -// Stdlib.String.trim_v0 " foo" = "foo" // String trims leading spaces -// Stdlib.String.trim_v0 " 😄foobar😄 " = "😄foobar😄" // String trims both leading + trailing spaces, preserving emoji -// Stdlib.String.trim_v0 "  foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched w/ unicode spaces -// Stdlib.String.trim_v0 "foo " = "foo" // String trims trailing spaces -// Stdlib.String.trim_v0 "foo" = "foo" // String trim noops -// Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.trim_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.trim_v0 " ﷽﷽" = "﷽﷽" -// Stdlib.String.trim_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️" -// Stdlib.String.trim_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" -// Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" - -// Stdlib.String.trim_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" - -// Stdlib.String.trim_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" -// Stdlib.String.trim_v0 "쉆ꥨ逴皪巌䖑ⱝዓ淋" = "쉆ꥨ逴皪巌䖑ⱝዓ淋" - - -// module Reverse = -// Stdlib.String.reverse_v0 "abcde" = "edcba" -// Stdlib.String.reverse_v0 "0abcde" = "edcba0" -// Stdlib.String.reverse_v0 "a" = "a" -// Stdlib.String.reverse_v0 "" = "" -// Stdlib.String.reverse_v0 "ábc" = "cbá" -// Stdlib.String.reverse_v0 "🎁🧸DŽʠ123" = "321ʠDŽ🧸🎁" -// Stdlib.String.reverse_v0 "😄foobar👽" = "👽raboof😄" -// Stdlib.String.reverse_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "✋🏿✋🏻✋🧑🏻‍🍼🧑🏽‍🦰włóż" -// Stdlib.String.reverse_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.reverse_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱🏿👱🏾👱🏽👱🏼👱🏻👱" -// Stdlib.String.reverse_v0 "🧟‍♀️🧟‍♂️" = "🧟‍♂️🧟‍♀️" -// Stdlib.String.reverse_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "🇵🇷🏳️‍⚧️‍️👩‍👩‍👧‍👦👨‍❤️‍💋‍👨" -// Stdlib.String.reverse_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "o̙̔ͮ̇͐̇ǧ̗͚̚lͮ̒ͫä͖̭̈̇Z̤͔ͧ̑̓" - - -// module DropFirst = -// Stdlib.String.dropFirst_v0 "abcd" -3L = "abcd" -// Stdlib.String.dropFirst_v0 "abcd" 0L = "abcd" -// Stdlib.String.dropFirst_v0 "abcd" 3L = "d" -// Stdlib.String.dropFirst_v0 "" 3L = "" -// Stdlib.String.dropFirst_v0 "abcd" 3L = "d" -// Stdlib.String.dropFirst_v0 "🍏🍒🍒" 1L = "🍒🍒" -// Stdlib.String.dropFirst_v0 "🍏🍒🍍" 2L = "🍍" -// Stdlib.String.dropFirst_v0 "🍏a🍒b🍍c" 2L = "🍒b🍍c" -// Stdlib.String.dropFirst_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 5L = "🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L = "ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "ǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.dropFirst_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.dropFirst_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 1L = "👱🏻👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.dropFirst_v0 "🧟‍♀️🧟‍♂️" 20L = "" -// Stdlib.String.dropFirst_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "🇵🇷" - - -// module DropLast = -// Stdlib.String.dropLast_v0 "abcd" -3L = "abcd" -// Stdlib.String.dropLast_v0 "abcd" 0L = "abcd" -// Stdlib.String.dropLast_v0 "abcd" 3L = "a" -// Stdlib.String.dropLast_v0 "" 3L = "" -// Stdlib.String.dropLast_v0 "🍏🍒🍒" 1L = "🍏🍒" -// Stdlib.String.dropLast_v0 "🍏🍒🍍" 2L = "🍏" -// Stdlib.String.dropLast_v0 "🍏a🍒b🍍c" 2L = "🍏a🍒b" -// Stdlib.String.dropLast_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" -// Stdlib.String.dropLast_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 10L = "﷽﷽﷽﷽﷽﷽" -// Stdlib.String.dropLast_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱👱🏻👱🏼" -// Stdlib.String.dropLast_v0 "🧟‍♀️🧟‍♂️" 20L = "" -// Stdlib.String.dropLast_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" -// Stdlib.String.dropLast_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "żółw🧑🏽‍🦰" - - -// module Last = -// Stdlib.String.last_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.last_v0 "abcd" -3L = "" -// Stdlib.String.last_v0 "abcd" 0L = "" -// Stdlib.String.last_v0 "" 7L = "" -// Stdlib.String.last_v0 "abcd" 1L = "d" -// Stdlib.String.last_v0 "abcd" 2L = "cd" -// Stdlib.String.last_v0 "abcd" 3L = "bcd" -// Stdlib.String.last_v0 "🍍🍍🍏" 1L = "🍏" -// Stdlib.String.last_v0 "🍊🍍🍏" 2L = "🍍🍏" -// Stdlib.String.last_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿🧑🏻‍🍼" 1L = "🧑🏻‍🍼" -// Stdlib.String.last_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "ǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.last_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L = "﷽﷽" -// Stdlib.String.last_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱🏽👱🏾👱🏿" -// Stdlib.String.last_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♂️" -// Stdlib.String.last_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 1L = "🇵🇷" - - -// module Contains = -// Stdlib.String.contains_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "2223" = false -// Stdlib.String.contains_v0 "👱👱🏻👱🏼👱🏽👱🏾" "👱🏿" = false -// Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = true -// Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️🧟‍♂️" = false - -// Stdlib.String.contains_v0 -// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" -// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" = true - -// Stdlib.String.contains_v0 "اختبار" "اختبار" = true -// Stdlib.String.contains_v0 "" "" = true -// Stdlib.String.contains_v0 "a" "" = true -// Stdlib.String.contains_v0 "" "a" = false - - -// module Slice = -// Stdlib.String.slice_v0 "abcd" -2L 4L = "cd" -// Stdlib.String.slice_v0 "abcd" -5L -6L = "" -// Stdlib.String.slice_v0 "abcd" -5L 1L = "a" -// Stdlib.String.slice_v0 "abcd" 0L -1L = "abc" -// Stdlib.String.slice_v0 "abcd" 2L 3L = "c" -// Stdlib.String.slice_v0 "abcd" 2L 6L = "cd" -// Stdlib.String.slice_v0 "abcd" 3L 2L = "" -// Stdlib.String.slice_v0 "abcd" 5L 6L = "" -// Stdlib.String.slice_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 2L 10L = "✋✋🏻✋🏿" -// Stdlib.String.slice_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L 3L = "ä͖̭̈̇lͮ̒ͫ" -// Stdlib.String.slice_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L 6L = "﷽﷽﷽﷽" -// Stdlib.String.slice_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L 6L = "👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.slice_v0 "🧟‍♀️🧟‍♂️" 2L 4L = "" -// Stdlib.String.slice_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L 10L = "🏳️‍⚧️‍️🇵🇷" -// Stdlib.String.slice_v0 "abc" 0L 4503599627370498L = "abc" - - -// module First = -// Stdlib.String.first_v0 "abcd" -3L = "" -// Stdlib.String.first_v0 "abcd" 0L = "" -// Stdlib.String.first_v0 "abcd" 1L = "a" -// Stdlib.String.first_v0 "abcd" 2L = "ab" -// Stdlib.String.first_v0 "abcd" 3L = "abc" -// Stdlib.String.first_v0 "abcd" 3000000000000000L = "abcd" -// Stdlib.String.first_v0 "" 7L = "" -// Stdlib.String.first_v0 "🍊🍍🍏" 1L = "🍊" -// Stdlib.String.first_v0 "🍊🍍🍏" 2L = "🍊🍍" -// Stdlib.String.first_v0 "🍊🍍🍏" 3L = "🍊🍍🍏" -// Stdlib.String.first_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 1L = "🧑🏽‍🦰" -// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 10L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇" -// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" -// Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 4L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" -// Stdlib.String.first_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽" -// Stdlib.String.first_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L = "👱👱🏻" -// Stdlib.String.first_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♀️" -// Stdlib.String.first_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" +module ToLowercase = + Stdlib.String.toLowercase "HELLO😄WORLD" = "hello😄world" + Stdlib.String.toLowercase "" = "" + Stdlib.String.toLowercase "ABCDEF" = "abcdef" // Stdlib.String.toLowercase_v0 works for ASCII range + Stdlib.String.toLowercase "AB323CDEF" = "ab323cdef" + Stdlib.String.toLowercase "SÁNCHEZ" = "sánchez" // not lowercase a + Stdlib.String.toLowercase "sánchez" = "sánchez" + Stdlib.String.toLowercase "ŻÓŁW" = "żółw" // Stdlib.String.toLowercase works on non-ascii strings + Stdlib.String.toLowercase "😄ORANGE" = "😄orange" + Stdlib.String.toLowercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.toLowercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.toLowercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.toLowercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" + Stdlib.String.toLowercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.toLowercase "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.toLowercase "Ჾ" = "ჾ" + Stdlib.String.toLowercase "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" = "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + + Stdlib.String.toLowercase + "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "h̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈w̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠b̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅt͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝w͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" + + + +module ToUppercase = + Stdlib.String.toUppercase "" = "" + Stdlib.String.toUppercase "hello😄world" = "HELLO😄WORLD" + Stdlib.String.toUppercase "abcdef" = "ABCDEF" + Stdlib.String.toUppercase "ab323cdef" = "AB323CDEF" + Stdlib.String.toUppercase "sánchez" = "SÁNCHEZ" // not lowercase a + Stdlib.String.toUppercase "SÁNChEZ" = "SÁNCHEZ" + Stdlib.String.toUppercase "żółw" = "ŻÓŁW" + Stdlib.String.toUppercase "😄orange" = "😄ORANGE" + Stdlib.String.toUppercase "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.toUppercase "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.toUppercase "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.toUppercase "🧟‍♀️🧟‍♂️" = "🧟‍♀️🧟‍♂️" + Stdlib.String.toUppercase "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.toUppercase "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "ŻÓŁW🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.toUppercase "ჾ" = "Ჾ" + + // TODO: There are two types of unicode case "mapping" (conversion), "simple" + // and "full". .NET supports simple mapping, which maps a single character to a + // single character. It does not support "full" mapping, which maps a single + // character to multiple characters. + + // Discussed at https://github.com/dotnet/runtime/issues/30960, specifially + // https://github.com/dotnet/runtime/issues/30960#issuecomment-535274401 + + // A possible solution is to write our own case mapper, or reuse an existing + // one. A potential candidate is + // https://github.com/dotnet/corefxlab/tree/archive/src/System.Text.CaseFolding + // (packaged at + // https://dnceng.visualstudio.com/public/_packaging?_a=package&feed=dotnet-experimental&view=overview&package=System.Text.CaseFolding&version=0.1.2-alpha.21059.1&protocolType=NuGet) + + Stdlib.String.toUppercase "fifl" = "fifl" // should be "FIFL" + Stdlib.String.toUppercase "և" = "և" // should be "ԵՒ" + + Stdlib.String.toUppercase "z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "Z̤͔ͧ̑̓Ä͖̭̈̇Lͮ̒ͫǦ̗͚̚O̙̔ͮ̇͐̇" + + Stdlib.String.toUppercase + "H̬̤̗̤͝e͜ ̜̥̝̻͍̟́w̕h̖̯͓o̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭a̺̪͍į͈͕̭͙̯̜t̶̼̮s̘͙͖̕ ̠̫̠B̻͍͙͉̳ͅe̵h̵̬͇̫͙i̹͓̳̳̮͎̫̕n͟d̴̪̜̖ ̰͉̩͇͙̲͞ͅT͖̼͓̪͢h͏͓̮̻e̬̝̟ͅ ̤̹̝W͙̞̝͔͇͝ͅa͏͓͔̹̼̣l̴͔̰̤̟͔ḽ̫.͕" = "H̬̤̗̤͝E͜ ̜̥̝̻͍̟́W̕H̖̯͓O̝͙̖͎̱̮ ҉̺̙̞̟͈W̷̼̭A̺̪͍Į͈͕̭͙̯̜T̶̼̮S̘͙͖̕ ̠̫̠B̻͍͙͉̳ΙE̵H̵̬͇̫͙I̹͓̳̳̮͎̫̕N͟D̴̪̜̖ ̰͉̩͇͙̲͞ΙT͖̼͓̪͢H͏͓̮̻E̬̝̟Ι ̤̹̝W͙̞̝͔͇͝ΙA͏͓͔̹̼̣L̴͔̰̤̟͔Ḽ̫.͕" + + + +module TrimEnd = + Stdlib.String.trimEnd_v0 " " = "" + Stdlib.String.trimEnd_v0 "" = "" + Stdlib.String.trimEnd_v0 " foo " = " foo" + Stdlib.String.trimEnd_v0 " foo bar " = " foo bar" + Stdlib.String.trimEnd_v0 " foo" = " foo" + Stdlib.String.trimEnd_v0 " 😄foobar😄 " = " 😄foobar😄" + Stdlib.String.trimEnd_v0 "  foo bar  " = "  foo bar" + Stdlib.String.trimEnd_v0 "foo " = "foo" + Stdlib.String.trimEnd_v0 "foo" = "foo" + + Stdlib.String.trimEnd_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" + + Stdlib.String.trimEnd_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" + + Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.trimEnd_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.trimEnd_v0 " ﷽﷽ " = " ﷽﷽" + Stdlib.String.trimEnd_v0 " 🧟‍♀️🧟‍♂️ " = " 🧟‍♀️🧟‍♂️" + + Stdlib.String.trimEnd_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + + Stdlib.String.trimEnd_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.trimEnd_v0 "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" = "🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸" + + +module TrimStart = + Stdlib.String.trimStart_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " + + Stdlib.String.trimStart_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " + + Stdlib.String.trimStart_v0 " " = "" + Stdlib.String.trimStart_v0 "" = "" + Stdlib.String.trimStart_v0 " foo " = "foo " + Stdlib.String.trimStart_v0 " foo bar " = "foo bar " + Stdlib.String.trimStart_v0 " foo" = "foo" + Stdlib.String.trimStart_v0 " 😄foobar😄 " = "😄foobar😄 " + Stdlib.String.trimStart_v0 "  foo bar  " = "foo bar  " + Stdlib.String.trimStart_v0 "foo " = "foo " + Stdlib.String.trimStart_v0 "foo" = "foo" + Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " + Stdlib.String.trimStart_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " + Stdlib.String.trimStart_v0 " ﷽﷽ " = "﷽﷽ " + Stdlib.String.trimStart_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️ " + + Stdlib.String.trimStart_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " + + Stdlib.String.trimStart_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " + + +module Trim = + Stdlib.String.trim_v0 " " = "" + Stdlib.String.trim_v0 "" = "" + Stdlib.String.trim_v0 " foo " = "foo" // String trims both leading + trailing spaces + Stdlib.String.trim_v0 " foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched + Stdlib.String.trim_v0 " foo" = "foo" // String trims leading spaces + Stdlib.String.trim_v0 " 😄foobar😄 " = "😄foobar😄" // String trims both leading + trailing spaces, preserving emoji + Stdlib.String.trim_v0 "  foo bar " = "foo bar" // String trims both leading + trailing spaces, leaving inner untouched w/ unicode spaces + Stdlib.String.trim_v0 "foo " = "foo" // String trims trailing spaces + Stdlib.String.trim_v0 "foo" = "foo" // String trim noops + Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿 " = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.trim_v0 " Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇ " = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.trim_v0 " ﷽﷽" = "﷽﷽" + Stdlib.String.trim_v0 " 🧟‍♀️🧟‍♂️ " = "🧟‍♀️🧟‍♂️" + Stdlib.String.trim_v0 " 👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷 " = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" + Stdlib.String.trim_v0 " żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + + Stdlib.String.trim_v0 " \xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83 " = "\xe2\x80\x83foo\xe2\x80\x83bar\xe2\x80\x83" + + Stdlib.String.trim_v0 " \xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84 " = "\xf0\x9f\x98\x84foobar\xf0\x9f\x98\x84" + Stdlib.String.trim_v0 "쉆ꥨ逴皪巌䖑ⱝዓ淋" = "쉆ꥨ逴皪巌䖑ⱝዓ淋" + + +module Reverse = + Stdlib.String.reverse_v0 "abcde" = "edcba" + Stdlib.String.reverse_v0 "0abcde" = "edcba0" + Stdlib.String.reverse_v0 "a" = "a" + Stdlib.String.reverse_v0 "" = "" + Stdlib.String.reverse_v0 "ábc" = "cbá" + Stdlib.String.reverse_v0 "🎁🧸DŽʠ123" = "321ʠDŽ🧸🎁" + Stdlib.String.reverse_v0 "😄foobar👽" = "👽raboof😄" + Stdlib.String.reverse_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" = "✋🏿✋🏻✋🧑🏻‍🍼🧑🏽‍🦰włóż" + Stdlib.String.reverse_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.reverse_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = "👱🏿👱🏾👱🏽👱🏼👱🏻👱" + Stdlib.String.reverse_v0 "🧟‍♀️🧟‍♂️" = "🧟‍♂️🧟‍♀️" + Stdlib.String.reverse_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" = "🇵🇷🏳️‍⚧️‍️👩‍👩‍👧‍👦👨‍❤️‍💋‍👨" + Stdlib.String.reverse_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" = "o̙̔ͮ̇͐̇ǧ̗͚̚lͮ̒ͫä͖̭̈̇Z̤͔ͧ̑̓" + + +module DropFirst = + Stdlib.String.dropFirst_v0 "abcd" -3L = "abcd" + Stdlib.String.dropFirst_v0 "abcd" 0L = "abcd" + Stdlib.String.dropFirst_v0 "abcd" 3L = "d" + Stdlib.String.dropFirst_v0 "" 3L = "" + Stdlib.String.dropFirst_v0 "abcd" 3L = "d" + Stdlib.String.dropFirst_v0 "🍏🍒🍒" 1L = "🍒🍒" + Stdlib.String.dropFirst_v0 "🍏🍒🍍" 2L = "🍍" + Stdlib.String.dropFirst_v0 "🍏a🍒b🍍c" 2L = "🍒b🍍c" + Stdlib.String.dropFirst_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 5L = "🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L = "ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.dropFirst_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "ǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.dropFirst_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.dropFirst_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 1L = "👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.dropFirst_v0 "🧟‍♀️🧟‍♂️" 20L = "" + Stdlib.String.dropFirst_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "🇵🇷" + + +module DropLast = + Stdlib.String.dropLast_v0 "abcd" -3L = "abcd" + Stdlib.String.dropLast_v0 "abcd" 0L = "abcd" + Stdlib.String.dropLast_v0 "abcd" 3L = "a" + Stdlib.String.dropLast_v0 "" 3L = "" + Stdlib.String.dropLast_v0 "🍏🍒🍒" 1L = "🍏🍒" + Stdlib.String.dropLast_v0 "🍏🍒🍍" 2L = "🍏" + Stdlib.String.dropLast_v0 "🍏a🍒b🍍c" 2L = "🍏a🍒b" + Stdlib.String.dropLast_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" + Stdlib.String.dropLast_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 10L = "﷽﷽﷽﷽﷽﷽" + Stdlib.String.dropLast_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱👱🏻👱🏼" + Stdlib.String.dropLast_v0 "🧟‍♀️🧟‍♂️" 20L = "" + Stdlib.String.dropLast_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" + Stdlib.String.dropLast_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "żółw🧑🏽‍🦰" + + +module Last = + Stdlib.String.last_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 4L = "🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.last_v0 "abcd" -3L = "" + Stdlib.String.last_v0 "abcd" 0L = "" + Stdlib.String.last_v0 "" 7L = "" + Stdlib.String.last_v0 "abcd" 1L = "d" + Stdlib.String.last_v0 "abcd" 2L = "cd" + Stdlib.String.last_v0 "abcd" 3L = "bcd" + Stdlib.String.last_v0 "🍍🍍🍏" 1L = "🍏" + Stdlib.String.last_v0 "🍊🍍🍏" 2L = "🍍🍏" + Stdlib.String.last_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿🧑🏻‍🍼" 1L = "🧑🏻‍🍼" + Stdlib.String.last_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "ǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.last_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L = "﷽﷽" + Stdlib.String.last_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 3L = "👱🏽👱🏾👱🏿" + Stdlib.String.last_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♂️" + Stdlib.String.last_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 1L = "🇵🇷" + + +module Contains = + Stdlib.String.contains_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "2223" = false + Stdlib.String.contains_v0 "👱👱🏻👱🏼👱🏽👱🏾" "👱🏿" = false + Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️" = true + Stdlib.String.contains_v0 "🧟‍♀️🧟‍♂️" "🧟‍♂️🧟‍♂️" = false + + Stdlib.String.contains_v0 + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦" = true + + Stdlib.String.contains_v0 "اختبار" "اختبار" = true + Stdlib.String.contains_v0 "" "" = true + Stdlib.String.contains_v0 "a" "" = true + Stdlib.String.contains_v0 "" "a" = false + + +module Slice = + Stdlib.String.slice_v0 "abcd" -2L 4L = "cd" + Stdlib.String.slice_v0 "abcd" -5L -6L = "" + Stdlib.String.slice_v0 "abcd" -5L 1L = "a" + Stdlib.String.slice_v0 "abcd" 0L -1L = "abc" + Stdlib.String.slice_v0 "abcd" 2L 3L = "c" + Stdlib.String.slice_v0 "abcd" 2L 6L = "cd" + Stdlib.String.slice_v0 "abcd" 3L 2L = "" + Stdlib.String.slice_v0 "abcd" 5L 6L = "" + Stdlib.String.slice_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 2L 10L = "✋✋🏻✋🏿" + Stdlib.String.slice_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 1L 3L = "ä͖̭̈̇lͮ̒ͫ" + Stdlib.String.slice_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 2L 6L = "﷽﷽﷽﷽" + Stdlib.String.slice_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L 6L = "👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.slice_v0 "🧟‍♀️🧟‍♂️" 2L 4L = "" + Stdlib.String.slice_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 2L 10L = "🏳️‍⚧️‍️🇵🇷" + Stdlib.String.slice_v0 "abc" 0L 4503599627370498L = "abc" + + +module First = + Stdlib.String.first_v0 "abcd" -3L = "" + Stdlib.String.first_v0 "abcd" 0L = "" + Stdlib.String.first_v0 "abcd" 1L = "a" + Stdlib.String.first_v0 "abcd" 2L = "ab" + Stdlib.String.first_v0 "abcd" 3L = "abc" + Stdlib.String.first_v0 "abcd" 3000000000000000L = "abcd" + Stdlib.String.first_v0 "" 7L = "" + Stdlib.String.first_v0 "🍊🍍🍏" 1L = "🍊" + Stdlib.String.first_v0 "🍊🍍🍏" 2L = "🍊🍍" + Stdlib.String.first_v0 "🍊🍍🍏" 3L = "🍊🍍🍏" + Stdlib.String.first_v0 "🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" 1L = "🧑🏽‍🦰" + Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 10L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 2L = "Z̤͔ͧ̑̓ä͖̭̈̇" + Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ" + Stdlib.String.first_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 4L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚" + Stdlib.String.first_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" 1L = "﷽" + Stdlib.String.first_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 2L = "👱👱🏻" + Stdlib.String.first_v0 "🧟‍♀️🧟‍♂️" 1L = "🧟‍♀️" + Stdlib.String.first_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" 3L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️" -// module PadStart = -// Stdlib.String.padStart_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" +module PadStart = + Stdlib.String.padStart_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" -// Stdlib.String.padStart_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" + Stdlib.String.padStart_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" -// Stdlib.String.padStart_v0 "123" "_-" 4L = Stdlib.Result.Result.Error -// "Expected `padWith` to be 1 character long, but it was `\"_-\"`" + Stdlib.String.padStart_v0 "123" "_-" 4L = Stdlib.Result.Result.Error + "Expected `padWith` to be 1 character long, but it was `\"_-\"`" -// Stdlib.String.padStart_v0 "123" "" 10L = Stdlib.Result.Result.Error -// "Expected `padWith` to be 1 character long, but it was `\"\"`" + Stdlib.String.padStart_v0 "123" "" 10L = Stdlib.Result.Result.Error + "Expected `padWith` to be 1 character long, but it was `\"\"`" -// Stdlib.String.padStart_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "000123" + Stdlib.String.padStart_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "000123" -// Stdlib.String.padStart_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" + Stdlib.String.padStart_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" -// Stdlib.String.padStart_v0 "123🍊🍊" "0" 3L = Stdlib.Result.Result.Ok "123🍊🍊" + Stdlib.String.padStart_v0 "123🍊🍊" "0" 3L = Stdlib.Result.Result.Ok "123🍊🍊" -// Stdlib.String.padStart_v0 "🍍🍍🍊🍊" "0" 7L = Stdlib.Result.Result.Ok "000🍍🍍🍊🍊" + Stdlib.String.padStart_v0 "🍍🍍🍊🍊" "0" 7L = Stdlib.Result.Result.Ok "000🍍🍍🍊🍊" -// Stdlib.String.padStart_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok -// "0żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" + Stdlib.String.padStart_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok + "0żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" -// Stdlib.String.padStart_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok -// "00000Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" + Stdlib.String.padStart_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok + "00000Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" -// Stdlib.String.padStart_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok -// "0000﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" + Stdlib.String.padStart_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok + "0000﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" -// Stdlib.String.padStart_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok -// "0000👱👱🏻👱🏼👱🏽👱🏾👱🏿" + Stdlib.String.padStart_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok + "0000👱👱🏻👱🏼👱🏽👱🏾👱🏿" -// Stdlib.String.padStart_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok -// "000🧟‍♀️🧟‍♂️" + Stdlib.String.padStart_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok + "000🧟‍♀️🧟‍♂️" -// Stdlib.String.padStart_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok -// "000000👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" + Stdlib.String.padStart_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok + "000000👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" -// Stdlib.String.padStart_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" + Stdlib.String.padStart_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" -// module PadEnd = -// Stdlib.String.padEnd_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" +module PadEnd = + Stdlib.String.padEnd_v0 "123" "0" 3L = Stdlib.Result.Result.Ok "123" -// Stdlib.String.padEnd_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" + Stdlib.String.padEnd_v0 "123" "0" -3L = Stdlib.Result.Result.Ok "123" -// Stdlib.String.padEnd_v0 "123" "_-" 3L = Stdlib.Result.Result.Error -// "Expected `padWith` to be 1 character long, but it was `\"_-\"`" + Stdlib.String.padEnd_v0 "123" "_-" 3L = Stdlib.Result.Result.Error + "Expected `padWith` to be 1 character long, but it was `\"_-\"`" -// Stdlib.String.padEnd_v0 "123" "" 10L = Stdlib.Result.Result.Error -// "Expected `padWith` to be 1 character long, but it was `\"\"`" + Stdlib.String.padEnd_v0 "123" "" 10L = Stdlib.Result.Result.Error + "Expected `padWith` to be 1 character long, but it was `\"\"`" -// Stdlib.String.padEnd_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "123000" + Stdlib.String.padEnd_v0 "123" "0" 6L = Stdlib.Result.Result.Ok "123000" -// Stdlib.String.padEnd_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" + Stdlib.String.padEnd_v0 "" "0" 0L = Stdlib.Result.Result.Ok "" -// Stdlib.String.padEnd_v0 "123🍊🍊" "0" 8L = Stdlib.Result.Result.Ok "123🍊🍊000" + Stdlib.String.padEnd_v0 "123🍊🍊" "0" 8L = Stdlib.Result.Result.Ok "123🍊🍊000" -// Stdlib.String.padEnd_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok -// "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿0" + Stdlib.String.padEnd_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "0" 10L = Stdlib.Result.Result.Ok + "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿0" -// Stdlib.String.padEnd_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok -// "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇00000" + Stdlib.String.padEnd_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" "0" 10L = Stdlib.Result.Result.Ok + "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇00000" -// Stdlib.String.padEnd_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok -// "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽0000" + Stdlib.String.padEnd_v0 "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽" "0" 20L = Stdlib.Result.Result.Ok + "﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽﷽0000" -// Stdlib.String.padEnd_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok -// "👱👱🏻👱🏼👱🏽👱🏾👱🏿0000" + Stdlib.String.padEnd_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "0" 10L = Stdlib.Result.Result.Ok + "👱👱🏻👱🏼👱🏽👱🏾👱🏿0000" -// Stdlib.String.padEnd_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok -// "🧟‍♀️🧟‍♂️000" + Stdlib.String.padEnd_v0 "🧟‍♀️🧟‍♂️" "0" 5L = Stdlib.Result.Result.Ok + "🧟‍♀️🧟‍♂️000" -// Stdlib.String.padEnd_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok -// "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷000000" + Stdlib.String.padEnd_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷" "0" 10L = Stdlib.Result.Result.Ok + "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️🇵🇷000000" -// Stdlib.String.padEnd_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" + Stdlib.String.padEnd_v0 "鷝" "觌഻" 0L = Stdlib.Result.Result.Ok "鷝" -// module IndexOf = -// Stdlib.String.indexOf_v0 "hello world" "world" = Stdlib.Option.Option.Some 6L +module IndexOf = + Stdlib.String.indexOf_v0 "hello world" "world" = Stdlib.Option.Option.Some 6L -// Stdlib.String.indexOf_v0 "hello world" "earth" = Stdlib.Option.Option.None + Stdlib.String.indexOf_v0 "hello world" "earth" = Stdlib.Option.Option.None -// Stdlib.String.indexOf_v0 "" "" = Stdlib.Option.Option.Some 0L + Stdlib.String.indexOf_v0 "" "" = Stdlib.Option.Option.Some 0L -// Stdlib.String.indexOf_v0 "hello" "" = Stdlib.Option.Option.Some 0L + Stdlib.String.indexOf_v0 "hello" "" = Stdlib.Option.Option.Some 0L -// Stdlib.String.indexOf_v0 "" "hello" = Stdlib.Option.Option.None + Stdlib.String.indexOf_v0 "" "hello" = Stdlib.Option.Option.None -// Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = Stdlib.Option.Option.Some -// 6L + Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏽" = Stdlib.Option.Option.Some + 6L -// Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏿" = Stdlib.Option.Option.None + Stdlib.String.indexOf_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" "👱🏼👱🏿" = Stdlib.Option.Option.None -// Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = Stdlib.Option.Option.Some -// 11L + Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "👩‍👩‍👧‍👦" = Stdlib.Option.Option.Some + 11L -// Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = Stdlib.Option.Option.Some -// 4L + Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "🧑🏽‍🦰" = Stdlib.Option.Option.Some + 4L -// Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "👱🏽" = Stdlib.Option.Option.None + Stdlib.String.indexOf_v0 "żółw🧑🏽‍🦰🧑🏻‍🍼✋✋🏻✋🏿" "👱🏽" = Stdlib.Option.Option.None -// Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🧑🏻‍🍼" = Stdlib.Option.Option.None + Stdlib.String.indexOf_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷" "🧑🏻‍🍼" = Stdlib.Option.Option.None -// module Ellipsis = -// Stdlib.String.ellipsis_v0 "hello world" 5L = "hello..." -// Stdlib.String.ellipsis_v0 "hello world" 9L = "hello wor..." -// Stdlib.String.ellipsis_v0 "hello world" 11L = "hello world" -// Stdlib.String.ellipsis_v0 "hello world" 12L = "hello world" -// Stdlib.String.ellipsis_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 5L = "👱👱🏻👱🏼👱🏽👱🏾..." -// Stdlib.String.ellipsis_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ..." -// Stdlib.String.ellipsis_v0 "👩‍👩‍👧‍👦" 2L = "👩‍👩‍👧‍👦" +module Ellipsis = + Stdlib.String.ellipsis_v0 "hello world" 5L = "hello..." + Stdlib.String.ellipsis_v0 "hello world" 9L = "hello wor..." + Stdlib.String.ellipsis_v0 "hello world" 11L = "hello world" + Stdlib.String.ellipsis_v0 "hello world" 12L = "hello world" + Stdlib.String.ellipsis_v0 "👱👱🏻👱🏼👱🏽👱🏾👱🏿" 5L = "👱👱🏻👱🏼👱🏽👱🏾..." + Stdlib.String.ellipsis_v0 "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫǧ̗͚̚o̙̔ͮ̇͐̇" 3L = "Z̤͔ͧ̑̓ä͖̭̈̇lͮ̒ͫ..." + Stdlib.String.ellipsis_v0 "👩‍👩‍👧‍👦" 2L = "👩‍👩‍👧‍👦" -// Stdlib.String.ellipsis_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷✋✋🏻✋🏿" 4L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷..." + Stdlib.String.ellipsis_v0 "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷✋✋🏻✋🏿" 4L = "👨‍❤️‍💋‍👨👩‍👩‍👧‍👦🏳️‍⚧️‍️🇵🇷..." -// module Head = -// Stdlib.String.head "hello world" = Stdlib.Option.Option.Some 'h' +module Head = + Stdlib.String.head "hello world" = Stdlib.Option.Option.Some 'h' -// Stdlib.String.head "" = Stdlib.Option.Option.None -// // Commented out as Fantomas doesn't like unicode "characters" -// // Stdlib.String.head "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = Stdlib.Option.Option.Some '👱' -// // Stdlib.String.head "🧟‍♀️🧟‍♂️" = Stdlib.Option.Option.Some '🧟' -// // Stdlib.String.head "👨‍❤️‍💋‍👨" = Stdlib.Option.Option.Some '👨‍❤️‍💋‍👨' + Stdlib.String.head "" = Stdlib.Option.Option.None +// Commented out as Fantomas doesn't like unicode "characters" +// Stdlib.String.head "👱👱🏻👱🏼👱🏽👱🏾👱🏿" = Stdlib.Option.Option.Some '👱' +// Stdlib.String.head "🧟‍♀️🧟‍♂️" = Stdlib.Option.Option.Some '🧟' +// Stdlib.String.head "👨‍❤️‍💋‍👨" = Stdlib.Option.Option.Some '👨‍❤️‍💋‍👨' -// module ArticleFor = -// Stdlib.String.articleFor "apple" = "an" -// Stdlib.String.articleFor "banana" = "a" -// Stdlib.String.articleFor "🍍" = "a" -// Stdlib.String.articleFor "🍊" = "a" -// Stdlib.String.articleFor "" = "" \ No newline at end of file +module ArticleFor = + Stdlib.String.articleFor "apple" = "an" + Stdlib.String.articleFor "banana" = "a" + Stdlib.String.articleFor "🍍" = "a" + Stdlib.String.articleFor "🍊" = "a" + Stdlib.String.articleFor "" = "" \ No newline at end of file diff --git a/backend/testfiles/execution/stdlib/tuple.dark b/backend/testfiles/execution/stdlib/tuple.dark index 7570c91665..2f60c37ba2 100644 --- a/backend/testfiles/execution/stdlib/tuple.dark +++ b/backend/testfiles/execution/stdlib/tuple.dark @@ -13,24 +13,22 @@ Stdlib.Tuple2.swap (1L, "two") = ("two", 1L) Stdlib.Tuple2.swap (Stdlib.Tuple2.swap ("two swaps", "back to original")) = ("two swaps", "back to original") -// Stdlib.Tuple2.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L) = ("ONE", -// 2L) +Stdlib.Tuple2.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L) = ("ONE", 2L) -// Stdlib.Tuple2.mapFirst (fun x -> x - 2L) (1L, "two") = (-1L, "two") -// Stdlib.Tuple2.mapSecond (fun x -> x - 2L) ("one", 2L) = ("one", 0L) +Stdlib.Tuple2.mapFirst (fun x -> x - 2L) (1L, "two") = (-1L, "two") +Stdlib.Tuple2.mapSecond (fun x -> x - 2L) ("one", 2L) = ("one", 0L) -// Stdlib.Tuple2.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two") = (1L, -// "TWO") +Stdlib.Tuple2.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two") = (1L, "TWO") -// Stdlib.Tuple2.mapBoth -// (fun x -> Stdlib.String.toUppercase x) -// (fun x -> x - 2L) -// ("one", 2L) = ("ONE", 0L) +Stdlib.Tuple2.mapBoth + (fun x -> Stdlib.String.toUppercase x) + (fun x -> x - 2L) + ("one", 2L) = ("ONE", 0L) -// Stdlib.Tuple2.mapBoth -// (fun x -> x - 2L) -// (fun x -> Stdlib.String.toUppercase x) -// (1L, "two") = (-1L, "TWO") +Stdlib.Tuple2.mapBoth + (fun x -> x - 2L) + (fun x -> Stdlib.String.toUppercase x) + (1L, "two") = (-1L, "TWO") // Tuple3 @@ -44,34 +42,34 @@ Stdlib.Tuple3.second ("one", 2L, "pi") = 2L Stdlib.Tuple3.third (1L, "two", 3.14) = 3.14 Stdlib.Tuple3.third ("one", 2L, "pi") = "pi" -// Stdlib.Tuple3.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("ONE", -// 2L, -// "pi") +Stdlib.Tuple3.mapFirst (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("ONE", + 2L, + "pi") -// Stdlib.Tuple3.mapFirst (fun x -> x - 2L) (1L, "two", 3.14) = (-1L, "two", 3.14) +Stdlib.Tuple3.mapFirst (fun x -> x - 2L) (1L, "two", 3.14) = (-1L, "two", 3.14) -// Stdlib.Tuple3.mapSecond (fun x -> x - 2L) ("one", 2L, "pi") = ("one", 0L, "pi") +Stdlib.Tuple3.mapSecond (fun x -> x - 2L) ("one", 2L, "pi") = ("one", 0L, "pi") -// Stdlib.Tuple3.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two", 3.14) = (1L, -// "TWO", -// 3.14) +Stdlib.Tuple3.mapSecond (fun x -> Stdlib.String.toUppercase x) (1L, "two", 3.14) = (1L, + "TWO", + 3.14) -// Stdlib.Tuple3.mapThird (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("one", -// 2L, -// "PI") +Stdlib.Tuple3.mapThird (fun x -> Stdlib.String.toUppercase x) ("one", 2L, "pi") = ("one", + 2L, + "PI") -// Stdlib.Tuple3.mapThird (fun x -> Stdlib.Float.roundDown_v0 x) (1L, "two", 3.14) = (1L, -// "two", -// 3L) +Stdlib.Tuple3.mapThird (fun x -> Stdlib.Float.roundDown_v0 x) (1L, "two", 3.14) = (1L, + "two", + 3L) -// Stdlib.Tuple3.mapAllThree -// (fun x -> Stdlib.String.toUppercase x) -// (fun x -> x - 2L) -// (fun x -> Stdlib.String.toUppercase x) -// ("one", 2L, "pi") = ("ONE", 0L, "PI") +Stdlib.Tuple3.mapAllThree + (fun x -> Stdlib.String.toUppercase x) + (fun x -> x - 2L) + (fun x -> Stdlib.String.toUppercase x) + ("one", 2L, "pi") = ("ONE", 0L, "PI") -// Stdlib.Tuple3.mapAllThree -// (fun x -> x - 2L) -// (fun x -> Stdlib.String.toUppercase x) -// (fun x -> Stdlib.Float.roundDown_v0 x) -// (1L, "two", 3.14) = (-1L, "TWO", 3L) \ No newline at end of file +Stdlib.Tuple3.mapAllThree + (fun x -> x - 2L) + (fun x -> Stdlib.String.toUppercase x) + (fun x -> Stdlib.Float.roundDown_v0 x) + (1L, "two", 3.14) = (-1L, "TWO", 3L) \ No newline at end of file