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 2dc4437
Show file tree
Hide file tree
Showing 3 changed files with 103 additions and 90 deletions.
184 changes: 94 additions & 90 deletions implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm
View file
Expand Up @@ -350,44 +350,44 @@ expandEnvWithModulesOrdered environmentBefore newParsedElmModules =
case
expandEnvWithModulesRecursive
(Dict.map
(\_ ( _, moduleParsed ) ->
moduleParsed
)
(\_ ( _, moduleParsed ) ->
moduleParsed
)
separateEnvironmentDeclarationsBefore.modules
)
newParsedElmModules
of
Err error ->
Err error
newParsedElmModules
of
Err error ->
Err error

Ok compiledModules ->
let
modulesValues : List ( List String, Pine.Value )
modulesValues =
Dict.foldl
(\moduleName moduleStruct aggregate ->
let
modulesValues : List ( List String, Pine.Value )
modulesValues =
Dict.foldl
(\moduleName moduleStruct aggregate ->
let
moduleValue =
emitModuleValue moduleStruct
in
( moduleName, moduleValue )
:: aggregate
)
[]
compiledModules

modulesValuesWithFlatNames : List ( String, Pine.Value )
modulesValuesWithFlatNames =
List.map
(\( moduleName, moduleValue ) ->
( String.join "." moduleName, moduleValue )
)
modulesValues
moduleValue =
emitModuleValue moduleStruct
in
Ok
{ addedModules = modulesValues
, environment = Pine.environmentFromDeclarations modulesValuesWithFlatNames
}
( moduleName, moduleValue )
:: aggregate
)
[]
compiledModules

modulesValuesWithFlatNames : List ( String, Pine.Value )
modulesValuesWithFlatNames =
List.map
(\( moduleName, moduleValue ) ->
( String.join "." moduleName, moduleValue )
)
modulesValues
in
Ok
{ addedModules = modulesValues
, environment = Pine.environmentFromDeclarations modulesValuesWithFlatNames
}


expandEnvWithModulesRecursive :
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
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 2dc4437

Please sign in to comment.