Skip to content

Commit

Permalink
Optimize parsing of expressions for efficiency
Browse files Browse the repository at this point in the history
  • Loading branch information
@Viir
Viir committed Jul 6, 2024
1 parent e08d6da commit 0d116b2
Show file tree
Hide file tree
Showing 2 changed files with 69 additions and 124 deletions.
169 changes: 57 additions & 112 deletions implement/pine/ElmTime/compile-elm-program/src/Pine.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -1263,79 +1247,40 @@ 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
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
Expand Down
24 changes: 12 additions & 12 deletions implement/pine/ElmTime/compile-elm-program/tests/ElmInteractiveTests.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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")
Expand All @@ -490,6 +486,10 @@ evolutionStagesToMakeElmFunction =
]
]
]
, Pine.ListExpression
[ Pine.LiteralExpression (Pine.valueFromString "functionName")
, Pine.LiteralExpression (Pine.valueFromString "concat")
]
]
]
|> Pine.evaluateExpression
Expand Down

0 comments on commit 0d116b2

Please sign in to comment.