From 87abb2b8c63d4f6dd0391fe89d075a85221f0981 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Michael=20R=C3=A4tzel?= Date: Thu, 9 May 2024 10:17:41 +0000 Subject: [PATCH] Clean up compilation of applications from Elm core `Debug` module + Simplify compilation of `Debug.log` and reduce the size of emitted code. + Change `Debug.toString` to fail at compile time instead of returning a static placeholder at runtime. --- implement/Pine.Core/Pine.Core.csproj | 6 +- .../compile-elm-program/src/ElmCompiler.elm | 175 ++++++++---------- implement/pine/Program.cs | 2 +- implement/pine/pine.csproj | 4 +- .../steps/210/expected-error-contains.txt | 1 + .../steps/210/expected-value.txt | 1 - 6 files changed, 80 insertions(+), 109 deletions(-) create mode 100644 implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-error-contains.txt delete mode 100644 implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-value.txt diff --git a/implement/Pine.Core/Pine.Core.csproj b/implement/Pine.Core/Pine.Core.csproj index dc9867b7..d0a255ea 100644 --- a/implement/Pine.Core/Pine.Core.csproj +++ b/implement/Pine.Core/Pine.Core.csproj @@ -3,13 +3,13 @@ net8.0 enable - 0.3.6 - 0.3.6 + 0.3.7 + 0.3.7 Pine.Core - 0.3.6 + 0.3.7 The cross-platform Elm runtime environment Functional;Elm;Runtime;Compiler;VM;DBMS https://github.com/pine-vm/pine.git diff --git a/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm b/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm index 149b746f..42195bc7 100644 --- a/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm +++ b/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm @@ -128,11 +128,6 @@ type alias ElmModuleChoiceType = } -pineKernelModuleName : String -pineKernelModuleName = - "Pine_kernel" - - elmStringTypeTagName : String elmStringTypeTagName = "String" @@ -1407,35 +1402,60 @@ compileElmSyntaxApplication stack appliedFunctionElmSyntax argumentsElmSyntax = in case appliedFunctionElmSyntax of Elm.Syntax.Expression.FunctionOrValue functionModuleName functionLocalName -> - if functionModuleName == [ pineKernelModuleName ] then - case arguments of - [ singleArgumentExpression ] -> - Ok - (KernelApplicationExpression - { functionName = functionLocalName - , argument = singleArgumentExpression - } - ) + let + continueWithDefaultNamedApplication () = + let + functionFlatName = + String.join "." (List.concat [ functionModuleName, [ functionLocalName ] ]) + in + case Dict.get functionFlatName elmDeclarationsOverridesExpressions of + Just declarationOverride -> + Ok declarationOverride - _ -> - Err "Invalid argument list for kernel application: Wrap arguments into a single list expression" + Nothing -> + case Dict.get functionFlatName stack.inlineableDeclarations of + Just applicableDeclaration -> + Ok (applicableDeclaration arguments) - else - let - functionFlatName = - String.join "." (List.concat [ functionModuleName, [ functionLocalName ] ]) - in - case Dict.get functionFlatName elmDeclarationsOverridesExpressions of - Just declarationOverride -> - Ok declarationOverride + _ -> + continueWithDefaultApplication () + in + case functionModuleName of + [ "Pine_kernel" ] -> + case arguments of + [ singleArgumentExpression ] -> + Ok + (KernelApplicationExpression + { functionName = functionLocalName + , argument = singleArgumentExpression + } + ) - Nothing -> - case Dict.get functionFlatName stack.inlineableDeclarations of - Just applicableDeclaration -> - Ok (applicableDeclaration arguments) + _ -> + Err "Invalid argument list for kernel application: Wrap arguments into a single list expression" - _ -> - continueWithDefaultApplication () + [ "Debug" ] -> + case functionLocalName of + "log" -> + case arguments of + [ _, contentArg ] -> + let + stringTag = + "Elm application of Debug.log" + in + Ok (StringTagExpression stringTag contentArg) + + _ -> + Err "Invalid argument list for Debug.log: Expected two arguments" + + "toString" -> + Err "Unsupported - Debug.toString is not implemented yet" + + _ -> + continueWithDefaultNamedApplication () + + _ -> + continueWithDefaultNamedApplication () _ -> continueWithDefaultApplication () @@ -2891,8 +2911,7 @@ getDeclarationValueFromCompilation ( localModuleName, nameInModule ) compilation flatName = String.join "." (List.concat [ canonicalModuleName, [ nameInModule ] ]) - - continueWithDefault () = + in case compilation.availableModules |> Dict.get canonicalModuleName of Nothing -> Err @@ -2951,54 +2970,6 @@ getDeclarationValueFromCompilation ( localModuleName, nameInModule ) compilation Just declarationValue -> Ok (LiteralExpression declarationValue) - in - case Dict.get canonicalModuleName getDeclarationValueFromCompilationOverrides of - Nothing -> - continueWithDefault () - - Just overrides -> - case Dict.get nameInModule overrides of - Just overrideValue -> - Result.map LiteralExpression overrideValue - - Nothing -> - continueWithDefault () - - -getDeclarationValueFromCompilationOverrides : Dict.Dict (List String) (Dict.Dict String (Result String Pine.Value)) -getDeclarationValueFromCompilationOverrides = - [ ( [ "Debug" ] - , [ ( "log" - -- TODO: mapping for Debug.log so we can get messages. - , FunctionExpression - [ [ ( "message", [] ) ], [ ( "payload", [] ) ] ] - (ReferenceExpression "payload") - |> FirCompiler.emitExpression - { importedFunctions = Dict.empty - , declarationsDependencies = Dict.empty - , environmentFunctions = [] - , environmentDeconstructions = Dict.empty - } - |> Result.andThen evaluateAsIndependentExpression - ) - , ( "toString" - -- TODO: mapping for Debug.toString - , FunctionExpression - [ [ ( "elm_value", [] ) ] ] - (LiteralExpression (valueFromString "Debug.toString is not implemented yet")) - |> FirCompiler.emitExpression - { importedFunctions = Dict.empty - , declarationsDependencies = Dict.empty - , environmentFunctions = [] - , environmentDeconstructions = Dict.empty - } - |> Result.andThen evaluateAsIndependentExpression - ) - ] - |> Dict.fromList - ) - ] - |> Dict.fromList compileLookupForInlineableDeclaration : ( List String, String ) -> Expression -> Expression @@ -3734,35 +3705,35 @@ separateEnvironmentDeclarations : , otherDeclarations : Dict.Dict String Pine.Value } separateEnvironmentDeclarations environmentDeclarations = - Dict.foldl + Dict.foldl (\declNameFlat declValue -> Result.andThen (\aggregate -> - if stringStartsWithUpper declNameFlat then - case Result.andThen parseModuleValue (getDeclarationsFromEnvironment declValue) of - Err err -> - Err ("Failed to parse module " ++ declNameFlat ++ ": " ++ err) + if stringStartsWithUpper declNameFlat then + case Result.andThen parseModuleValue (getDeclarationsFromEnvironment declValue) of + Err err -> + Err ("Failed to parse module " ++ declNameFlat ++ ": " ++ err) - Ok moduleDeclarations -> - Ok - { aggregate - | modules = - Dict.insert - (String.split "." declNameFlat) - ( declValue, moduleDeclarations ) - aggregate.modules - } + Ok moduleDeclarations -> + Ok + { aggregate + | modules = + Dict.insert + (String.split "." declNameFlat) + ( declValue, moduleDeclarations ) + aggregate.modules + } - else - Ok - { aggregate - | otherDeclarations = - Dict.insert declNameFlat declValue aggregate.otherDeclarations - } - ) + else + Ok + { aggregate + | otherDeclarations = + Dict.insert declNameFlat declValue aggregate.otherDeclarations + } + ) ) (Ok { modules = Dict.empty, otherDeclarations = Dict.empty }) - environmentDeclarations + environmentDeclarations getDeclarationsFromEnvironment : Pine.Value -> Result String (Dict.Dict String Pine.Value) diff --git a/implement/pine/Program.cs b/implement/pine/Program.cs index 4154c39d..79ae62a9 100644 --- a/implement/pine/Program.cs +++ b/implement/pine/Program.cs @@ -18,7 +18,7 @@ namespace ElmTime; public class Program { - public static string AppVersionId => "0.3.6"; + public static string AppVersionId => "0.3.7"; private static int AdminInterfaceDefaultPort => 4000; diff --git a/implement/pine/pine.csproj b/implement/pine/pine.csproj index f52932b6..2bdfed11 100644 --- a/implement/pine/pine.csproj +++ b/implement/pine/pine.csproj @@ -4,8 +4,8 @@ Exe net8.0 pine - 0.3.6 - 0.3.6 + 0.3.7 + 0.3.7 enable true diff --git a/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-error-contains.txt b/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-error-contains.txt new file mode 100644 index 00000000..12917912 --- /dev/null +++ b/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-error-contains.txt @@ -0,0 +1 @@ +Debug.toString is not implemented yet \ No newline at end of file diff --git a/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-value.txt b/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-value.txt deleted file mode 100644 index 26d5a365..00000000 --- a/implement/test-and-train/elm-interactive-scenarios-core/elm-core-debug/steps/210/expected-value.txt +++ /dev/null @@ -1 +0,0 @@ -"Debug.toString is not implemented yet" \ No newline at end of file