Skip to content

Commit

Permalink
Improve error reporting on invalid case-of blocks with crash
Browse files Browse the repository at this point in the history 
Change the compilation of Elm case-of expressions to crash when none of the branch conditions is met at runtime.
  • Loading branch information
@Viir
Viir committed May 9, 2024
1 parent 4e5e7a1 commit ef72746
Show file tree
Hide file tree
Showing 3 changed files with 96 additions and 83 deletions.
170 changes: 87 additions & 83 deletions implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm
View file
Expand Up @@ -426,9 +426,9 @@ expandEnvWithModulesRecursive environmentBefore parsedElmModules =
nextEnvironment =
Dict.insert moduleName moduleValue environmentBefore
in
expandEnvWithModulesRecursive
nextEnvironment
followingModules
expandEnvWithModulesRecursive
nextEnvironment
followingModules


compileElmModuleIntoNamedExports :
Expand Down Expand Up @@ -1859,10 +1859,14 @@ compileCaseBlockInline stack caseBlockExpr caseBlockCases =
Ok
(List.foldr
conditionalFromCase
(ListExpression
[ LiteralExpression stringAsValue_errorNoMatchingBranch
, caseBlockExpr
]
(PineFunctionApplicationExpression
-- Crash in case none of the branches match.
(Pine.ParseAndEvalExpression
{ expression = Pine.LiteralExpression stringAsValue_errorNoMatchingBranch
, environment = Pine.EnvironmentExpression
}
)
caseBlockExpr
)
cases
)
Expand Down Expand Up @@ -2912,64 +2916,64 @@ getDeclarationValueFromCompilation ( localModuleName, nameInModule ) compilation
flatName =
String.join "." (List.concat [ canonicalModuleName, [ nameInModule ] ])
in
case compilation.availableModules |> Dict.get canonicalModuleName of
case compilation.availableModules |> Dict.get canonicalModuleName of
Nothing ->
Err
("Did not find module '"
++ String.join "." canonicalModuleName
++ "'. There are "
++ String.fromInt (Dict.size compilation.availableModules)
++ " declarations in this scope: "
++ String.join ", " (List.map (String.join ".") (Dict.keys compilation.availableModules))
)

Just moduleValue ->
case Dict.get nameInModule moduleValue.functionDeclarations of
Nothing ->
Err
("Did not find module '"
++ String.join "." canonicalModuleName
++ "'. There are "
++ String.fromInt (Dict.size compilation.availableModules)
++ " declarations in this scope: "
++ String.join ", " (List.map (String.join ".") (Dict.keys compilation.availableModules))
)
case Dict.get flatName compilation.inlineableDeclarations of
Just applicableDeclaration ->
Ok (applicableDeclaration [])

Just moduleValue ->
case Dict.get nameInModule moduleValue.functionDeclarations of
Nothing ->
case Dict.get flatName compilation.inlineableDeclarations of
Just applicableDeclaration ->
Ok (applicableDeclaration [])

Nothing ->
let
declsReport =
if stringStartsWithUpper nameInModule then
let
allTypesNames =
Dict.foldl
(\typeName value aggregate ->
case value of
ElmModuleChoiceTypeDeclaration choiceType ->
List.concat [ [ typeName ], Dict.keys choiceType.tags, aggregate ]

ElmModuleRecordTypeDeclaration _ ->
typeName :: aggregate
)
[]
moduleValue.typeDeclarations
in
"There are "
++ String.fromInt (List.length allTypesNames)
++ " type declarations available in that module: "
++ String.join ", " allTypesNames

else
"There are "
++ String.fromInt (Dict.size moduleValue.functionDeclarations)
++ " function declarations available in that module: "
++ String.join ", " (Dict.keys moduleValue.functionDeclarations)
in
Err
("Did not find '"
++ nameInModule
++ "' in module '"
++ String.join "." canonicalModuleName
++ "'. "
++ declsReport
)
let
declsReport =
if stringStartsWithUpper nameInModule then
let
allTypesNames =
Dict.foldl
(\typeName value aggregate ->
case value of
ElmModuleChoiceTypeDeclaration choiceType ->
List.concat [ [ typeName ], Dict.keys choiceType.tags, aggregate ]

ElmModuleRecordTypeDeclaration _ ->
typeName :: aggregate
)
[]
moduleValue.typeDeclarations
in
"There are "
++ String.fromInt (List.length allTypesNames)
++ " type declarations available in that module: "
++ String.join ", " allTypesNames

else
"There are "
++ String.fromInt (Dict.size moduleValue.functionDeclarations)
++ " function declarations available in that module: "
++ String.join ", " (Dict.keys moduleValue.functionDeclarations)
in
Err
("Did not find '"
++ nameInModule
++ "' in module '"
++ String.join "." canonicalModuleName
++ "'. "
++ declsReport
)

Just declarationValue ->
Ok (LiteralExpression declarationValue)
Just declarationValue ->
Ok (LiteralExpression declarationValue)


compileLookupForInlineableDeclaration : ( List String, String ) -> Expression -> Expression
Expand Down Expand Up @@ -3705,35 +3709,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)
Expand Down
1 change: 1 addition & 0 deletions ...est-and-train/elm-interactive-scenarios-core/errors/steps/171/expected-error-contains.txt
View file
@@ -0,0 +1 @@
Error in case-of block: No matching branch
8 changes: 8 additions & 0 deletions implement/test-and-train/elm-interactive-scenarios-core/errors/steps/171/submission.txt
View file
@@ -0,0 +1,8 @@
let
switch_func a =
case a of
0 -> "zero"
1 -> "one"

in
switch_func 3

0 comments on commit ef72746

Please sign in to comment.