diff --git a/implement/pine/ElmTime/compile-elm-program/src/Pine.elm b/implement/pine/ElmTime/compile-elm-program/src/Pine.elm index aa6d18ca..de203959 100644 --- a/implement/pine/ElmTime/compile-elm-program/src/Pine.elm +++ b/implement/pine/ElmTime/compile-elm-program/src/Pine.elm @@ -1176,71 +1176,55 @@ parseListExpression value = parseParseAndEvalExpression : Value -> Result String ( Expression, Expression ) parseParseAndEvalExpression value = case value of - BlobValue _ -> - Err "Is not list but blob" + ListValue ((ListValue [ _, envValue ]) :: (ListValue [ _, exprValue ]) :: _) -> + case parseExpressionFromValue envValue of + Err envErr -> + Err ("Failed to parse env field: " ++ envErr) - ListValue list -> - case parseListOfPairs list of - Err err -> - Err ("Failed to parse kernel application expression: " ++ err) - - Ok pairs -> - case Common.assocListGet stringAsValue_expression pairs of - Nothing -> - Err "Did not find field 'expression'" - - Just expressionValue -> - case parseExpressionFromValue expressionValue of - Err error -> - Err ("Failed to parse field 'expression': " ++ error) + Ok envExpr -> + case parseExpressionFromValue exprValue of + Err exprErr -> + Err ("Failed to parse expr field: " ++ exprErr) - Ok expression -> - case Common.assocListGet stringAsValue_environment pairs of - Nothing -> - Err "Did not find field 'environment'" + Ok exprExpr -> + Ok ( envExpr, exprExpr ) - Just environmentValue -> - case parseExpressionFromValue environmentValue of - Err error -> - Err ("Failed to parse field 'environment': " ++ error) + ListValue list -> + Err + ("Failed to parse parse-and-eval: Too few elements in top list or unexpected shape of fields (" + ++ String.fromInt (List.length list) + ++ ")" + ) - Ok environment -> - Ok ( environment, expression ) + BlobValue _ -> + Err "Failed to parse parse-and-eval: Is not list but blob" parseKernelApplicationExpression : Value -> Result String ( Expression, String ) parseKernelApplicationExpression expressionValue = case expressionValue of - BlobValue _ -> - Err "Is not list but blob" - - ListValue list -> - case parseListOfPairs list of - Err err -> - Err ("Failed to parse kernel application expression: " ++ err) - - Ok pairs -> - case Common.assocListGet stringAsValue_functionName pairs of - Nothing -> - Err "Did not find field 'functionName'" + ListValue ((ListValue [ _, argumentValue ]) :: (ListValue [ _, functionNameValue ]) :: _) -> + case parseExpressionFromValue argumentValue of + Err error -> + Err ("Failed to parse kernel application argument: " ++ error) - Just functionNameValue -> - case Common.assocListGet functionNameValue kernelFunctionsNames of - Nothing -> - Err "Unexpected 'functionName'" + Ok argument -> + case stringFromValue functionNameValue of + Err error -> + Err ("Failed to parse kernel application function name: " ++ error) - Just functionName -> - case Common.assocListGet stringAsValue_argument pairs of - Nothing -> - Err "Did not find field 'argument'" + Ok functionName -> + Ok ( argument, functionName ) - Just argumentValue -> - case parseExpressionFromValue argumentValue of - Err error -> - Err ("Failed to parse field 'argument': " ++ error) + ListValue list -> + Err + ("Failed to parse kernel application expression: Too few items in top list or unexpected shape of fields (" + ++ String.fromInt (List.length list) + ++ ")" + ) - Ok argument -> - Ok ( argument, functionName ) + BlobValue _ -> + Err "Failed to parse kernel application: Is not list but blob" parseKernelFunctionFromName : String -> Result String KernelFunction @@ -1263,46 +1247,33 @@ parseKernelFunctionFromName functionName = parseConditionalExpression : Value -> Result String ( Expression, Expression, Expression ) parseConditionalExpression expressionValue = case expressionValue of - BlobValue _ -> - Err "Is not list but blob" - - ListValue list -> - case parseListOfPairs list of - Err err -> - Err ("Failed to parse kernel application expression: " ++ err) + ListValue [ ListValue [ _, conditionValue ], ListValue [ _, ifFalseValue ], ListValue [ _, ifTrueValue ] ] -> + case parseExpressionFromValue conditionValue of + Err error -> + Err ("Failed to parse condition: " ++ error) - Ok pairs -> - case Common.assocListGet stringAsValue_condition pairs of - Nothing -> - Err "Did not find field 'condition'" + Ok condition -> + case parseExpressionFromValue ifFalseValue of + Err error -> + Err ("Failed to parse false branch: " ++ error) - Just conditionValue -> - case parseExpressionFromValue conditionValue of + Ok ifFalse -> + case parseExpressionFromValue ifTrueValue of Err error -> - Err ("Failed to parse field 'condition': " ++ error) + Err ("Failed to parse true branch: " ++ error) - Ok condition -> - case Common.assocListGet stringAsValue_ifTrue pairs of - Nothing -> - Err "Did not find field 'ifTrue'" + Ok ifTrue -> + Ok ( condition, ifFalse, ifTrue ) - Just ifTrueValue -> - case parseExpressionFromValue ifTrueValue of - Err error -> - Err ("Failed to parse field 'ifTrue': " ++ error) - - Ok ifTrue -> - case Common.assocListGet stringAsValue_ifFalse pairs of - Nothing -> - Err "Did not find field 'ifFalse'" - - Just ifFalseValue -> - case parseExpressionFromValue ifFalseValue of - Err error -> - Err ("Failed to parse field 'ifFalse': " ++ error) + ListValue list -> + Err + ("Failed to parse conditional: Too few items in top list or unexpected shape of fields (" + ++ String.fromInt (List.length list) + ++ ")" + ) - Ok ifFalse -> - Ok ( condition, ifFalse, ifTrue ) + BlobValue _ -> + Err "Failed to parse conditional: Is not list but blob" encodeUnionToPineValue : Value -> Value -> Value @@ -1310,32 +1281,6 @@ encodeUnionToPineValue tagNameValue unionTagValue = ListValue [ tagNameValue, unionTagValue ] -parseListOfPairs : List Value -> Result String (List ( Value, Value )) -parseListOfPairs list = - let - continueRecursive : List Value -> List ( Value, Value ) -> Result String (List ( Value, Value )) - continueRecursive remaining aggregate = - case remaining of - [] -> - Ok (List.reverse aggregate) - - itemValue :: rest -> - case itemValue of - BlobValue _ -> - Err "Is not list but blob" - - ListValue [ first, second ] -> - continueRecursive rest (( first, second ) :: aggregate) - - ListValue innerList -> - Err - ("Unexpected number of list items for pair: " - ++ String.fromInt (List.length innerList) - ) - in - continueRecursive list [] - - parseListWithExactlyTwoElements : Value -> Result String ( Value, Value ) parseListWithExactlyTwoElements value = case value of diff --git a/implement/pine/ElmTime/compile-elm-program/tests/ElmInteractiveTests.elm b/implement/pine/ElmTime/compile-elm-program/tests/ElmInteractiveTests.elm index 5088f248..dc5fd5dc 100644 --- a/implement/pine/ElmTime/compile-elm-program/tests/ElmInteractiveTests.elm +++ b/implement/pine/ElmTime/compile-elm-program/tests/ElmInteractiveTests.elm @@ -406,16 +406,16 @@ evolutionStagesToMakeElmFunction = [ Pine.LiteralExpression (Pine.valueFromString "KernelApplication") , Pine.ListExpression [ Pine.ListExpression - [ Pine.LiteralExpression (Pine.valueFromString "functionName") - , Pine.LiteralExpression (Pine.valueFromString "equal") - ] - , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "argument") , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "List") , Pine.LiteralExpression (Pine.ListValue []) ] ] + , Pine.ListExpression + [ Pine.LiteralExpression (Pine.valueFromString "functionName") + , Pine.LiteralExpression (Pine.valueFromString "equal") + ] ] ] |> Pine.evaluateExpression Pine.emptyEvalEnvironment @@ -433,16 +433,16 @@ evolutionStagesToMakeElmFunction = [ Pine.LiteralExpression (Pine.valueFromString "KernelApplication") , Pine.ListExpression [ Pine.ListExpression - [ Pine.LiteralExpression (Pine.valueFromString "functionName") - , Pine.LiteralExpression (Pine.valueFromString "concat") - ] - , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "argument") , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "Literal") , Pine.EnvironmentExpression ] ] + , Pine.ListExpression + [ Pine.LiteralExpression (Pine.valueFromString "functionName") + , Pine.LiteralExpression (Pine.valueFromString "concat") + ] ] ] |> Pine.evaluateExpression @@ -471,10 +471,6 @@ evolutionStagesToMakeElmFunction = [ Pine.LiteralExpression (Pine.valueFromString "KernelApplication") , Pine.ListExpression [ Pine.ListExpression - [ Pine.LiteralExpression (Pine.valueFromString "functionName") - , Pine.LiteralExpression (Pine.valueFromString "concat") - ] - , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "argument") , Pine.ListExpression [ Pine.LiteralExpression (Pine.valueFromString "List") @@ -490,6 +486,10 @@ evolutionStagesToMakeElmFunction = ] ] ] + , Pine.ListExpression + [ Pine.LiteralExpression (Pine.valueFromString "functionName") + , Pine.LiteralExpression (Pine.valueFromString "concat") + ] ] ] |> Pine.evaluateExpression