refactor passToFunction

2022-04-25 08:17:44 +02:00 · 2022-04-25 08:17:44 +02:00 · 1fb9218a94
commit 1fb9218a94
parent d214bddc82
4 changed files with 80 additions and 52 deletions
--- a/packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltInMacros.res
+++ b/packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltInMacros.res
@ -34,25 +34,25 @@ let rec replaceSymbols = (expression: expression, bindings: ExpressionT.bindings
  ): ExpressionT.bindings =>
    Belt.Map.String.set(bindings, "$parameters", ExpressionT.EParameters(parameters))

-  let answerBindingIfNotParameter = (aSymbol, defaultExpression, parameters, bindings) =>       
+  let answerBindingIfNotParameter = (aSymbol, defaultExpression, parameters, bindings) =>
    switch Js.Array2.some(parameters, a => a == aSymbol) {
-      | true => defaultExpression->Ok // We cannot bind the parameters with global values
-      | false =>
-        switch bindings->Belt.Map.String.get(aSymbol) {
-        | Some(boundExpression) => boundExpression->Ok
-        | None => RESymbolNotFound(aSymbol)->Error
-        }
+    | true => defaultExpression->Ok // We cannot bind the parameters with global values
+    | false =>
+      switch bindings->Belt.Map.String.get(aSymbol) {
+      | Some(boundExpression) => boundExpression->Ok
+      | None => RESymbolNotFound(aSymbol)->Error
      }
+    }

-  let answerCallBindingIfNotParameter = (aSymbol, defaultExpression, parameters, bindings) =>       
+  let answerCallBindingIfNotParameter = (aSymbol, defaultExpression, parameters, bindings) =>
    switch Js.Array2.some(parameters, a => a == aSymbol) {
-      | true => defaultExpression->Ok // We cannot bind the parameters with global values
-      | false =>
-        switch bindings->Belt.Map.String.get(aSymbol) {
-        | Some(boundExpression) => boundExpression->Ok
-        | None => defaultExpression->Ok
-        }
+    | true => defaultExpression->Ok // We cannot bind the parameters with global values
+    | false =>
+      switch bindings->Belt.Map.String.get(aSymbol) {
+      | Some(boundExpression) => boundExpression->Ok
+      | None => defaultExpression->Ok
      }
+    }

  switch expression {
  | ExpressionT.EValue(EvSymbol(aSymbol)) => {
--- a/packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression.res
+++ b/packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression.res
@ -12,7 +12,7 @@ type internalCode = ExpressionValue.internalCode
 type t = expression

 external castExpressionToInternalCode: expression => internalCode = "%identity"
-external castInternalCodeToInternalCode: internalCode => expression = "%identity"
+external castInternalCodeToExpression: internalCode => expression = "%identity"

 /*
  Shows the expression as text of expression
@ -64,12 +64,36 @@ let rec reduceExpression = (expression: t, bindings: T.bindings): result<express
  let doMacroCall = (list: list<t>, bindings: T.bindings): result<t, 'e> =>
    Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(list, bindings, reduceExpression)

+  let applyParametersToLambda = (
+    internal: internalCode,
+    parameters: array<string>,
+    args: list<expressionValue>,
+  ): result<expressionValue, 'e> => {
+    let expr = castInternalCodeToExpression(internal)
+    let parameterList = parameters->Belt.List.fromArray
+    let zippedParameterList = parameterList->Belt.List.zip(args)
+    let bindings = Belt.List.reduce(zippedParameterList, defaultBindings, (a, (p, e)) =>
+      a->Belt.Map.String.set(p, e->EValue)
+    )
+    Js.log(`applyParametersToLambda: ${toString(expr)}`)
+    let inspectBindings =
+      bindings
+      ->Belt.Map.String.mapWithKey((k, v) => `${k}: ${toString(v)}`)
+      ->Belt.Map.String.valuesToArray
+      ->Js.Array2.toString
+    Js.log(`    inspectBindings: ${inspectBindings}`)
+    reduceExpression(expr, bindings)
+  }
+
  /*
    After reducing each level of expression(Lisp AST), we have a value list to evaluate
 */
  let reduceValueList = (valueList: list<expressionValue>): result<expressionValue, 'e> =>
    switch valueList {
    | list{EvCall(fName), ...args} => (fName, args->Belt.List.toArray)->BuiltIn.dispatch
+    // "(lambda(x=>internal) param)"
+    | list{EvLambda(parameters, internal), ...args} =>
+      applyParametersToLambda(internal, parameters, args)
    | _ => valueList->Belt.List.toArray->ExpressionValue.EvArray->Ok
    }

@ -97,11 +121,8 @@ let rec reduceExpression = (expression: t, bindings: T.bindings): result<express

  let rec reduceExpandedExpression = (expression: t): result<expressionValue, 'e> =>
    switch expression {
-    | T.EList(list{
-        T.EValue(EvCall("$lambda")),
-        T.EParameters(parameters),
-        functionDefinition,
-      }) => EvLambda(parameters, functionDefinition->castExpressionToInternalCode)->Ok
+    | T.EList(list{T.EValue(EvCall("$lambda")), T.EParameters(parameters), functionDefinition}) =>
+      EvLambda(parameters, functionDefinition->castExpressionToInternalCode)->Ok
    | T.EValue(value) => value->Ok
    | T.EList(list) => {
        let racc: result<list<expressionValue>, 'e> = list->Belt.List.reduceReverse(Ok(list{}), (
--- a/packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression_Builder.res
+++ b/packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression_Builder.res
@ -0,0 +1,16 @@
+module ErrorValue = Reducer_ErrorValue
+module ExpressionT = Reducer_Expression_T
+module ExpressionValue = ReducerInterface.ExpressionValue
+module Result = Belt.Result
+
+type errorValue = ErrorValue.errorValue
+type expression = ExpressionT.expression
+
+let passToFunction = (fName: string, lispArgs: list<expression>): expression => {
+  let toEvCallValue = (name: string): expression => name->ExpressionValue.EvCall->ExpressionT.EValue
+  let fn = fName->toEvCallValue
+  list{fn, ...lispArgs}->ExpressionT.EList
+}
+
+let toEvSymbolValue = (name: string): expression =>
+  name->ExpressionValue.EvSymbol->ExpressionT.EValue
--- a/packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs_ToExpression.res
+++ b/packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs_ToExpression.res
@ -1,6 +1,7 @@
+module Builder = Reducer_Expression_Builder
 module ErrorValue = Reducer_ErrorValue
-module ExpressionValue = ReducerInterface.ExpressionValue
 module ExpressionT = Reducer_Expression_T
+module ExpressionValue = ReducerInterface.ExpressionValue
 module JavaScript = Reducer_Js
 module Parse = Reducer_MathJs_Parse
 module Result = Belt.Result
@ -9,13 +10,6 @@ type expression = ExpressionT.expression
 type expressionValue = ExpressionValue.expressionValue
 type errorValue = ErrorValue.errorValue

-let passToFunction = (fName: string, rLispArgs): result<expression, errorValue> => {
-  let toEvCallValue = (name: string): expression => name->ExpressionValue.EvCall->ExpressionT.EValue
-
-  let fn = fName->toEvCallValue
-  rLispArgs->Result.flatMap(lispArgs => list{fn, ...lispArgs}->ExpressionT.EList->Ok)
-}
-
 type blockTag =
  | ImportVariablesStatement
  | ExportVariablesExpression
@ -34,12 +28,11 @@ let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
        )
      )

-    let toEvSymbolValue = (name: string): expression =>
-      name->ExpressionValue.EvSymbol->ExpressionT.EValue
-
    let caseFunctionNode = fNode => {
-      let lispArgs = fNode["args"]->Belt.List.fromArray->fromNodeList
-      passToFunction(fNode->Parse.nameOfFunctionNode, lispArgs)
+      let rLispArgs = fNode["args"]->Belt.List.fromArray->fromNodeList
+      rLispArgs->Result.flatMap(lispArgs =>
+        Builder.passToFunction(fNode->Parse.nameOfFunctionNode, lispArgs)->Ok
+      )
    }

    let caseObjectNode = oNode => {
@ -60,8 +53,8 @@ let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
          )
        )
        rargs->Result.flatMap(args =>
-          passToFunction("$constructRecord", list{ExpressionT.EList(args)}->Ok)
-        ) // $consturctRecord gets a single argument: List of key-value paiers
+          Builder.passToFunction("$constructRecord", list{ExpressionT.EList(args)})->Ok
+        ) // $constructRecord gets a single argument: List of key-value paiers
      }

      oNode["properties"]->Js.Dict.entries->Belt.List.fromArray->fromObjectEntries
@ -85,30 +78,27 @@ let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
    let caseAccessorNode = (objectNode, indexNode) => {
      caseIndexNode(indexNode)->Result.flatMap(indexCode => {
        fromNode(objectNode)->Result.flatMap(objectCode =>
-          passToFunction("$atIndex", list{objectCode, indexCode}->Ok)
+          Builder.passToFunction("$atIndex", list{objectCode, indexCode})->Ok
        )
      })
    }

    let caseAssignmentNode = aNode => {
-      let symbol = aNode["object"]["name"]->toEvSymbolValue
+      let symbol = aNode["object"]["name"]->Builder.toEvSymbolValue
      let rValueExpression = fromNode(aNode["value"])
-      rValueExpression->Result.flatMap(valueExpression => {
-        let lispArgs = list{symbol, valueExpression}->Ok
-        passToFunction("$let", lispArgs)
-      })
+      rValueExpression->Result.flatMap(valueExpression =>
+        Builder.passToFunction("$let", list{symbol, valueExpression})->Ok
+      )
    }

    let caseFunctionAssignmentNode = faNode => {
-      let symbol = faNode["name"]->toEvSymbolValue
+      let symbol = faNode["name"]->Builder.toEvSymbolValue
      let rValueExpression = fromNode(faNode["expr"])

      rValueExpression->Result.flatMap(valueExpression => {
        let lispParams = faNode["params"]->ExpressionT.EParameters
-        let rLambda = passToFunction("$lambda", list{lispParams, valueExpression}->Ok)
-        rLambda->Result.flatMap(lambda => {
-          passToFunction("$let", list{symbol, lambda}->Ok)
-        })
+        let lambda = Builder.passToFunction("$lambda", list{lispParams, valueExpression})
+        Builder.passToFunction("$let", list{symbol, lambda})->Ok
      })
    }

@ -121,7 +111,7 @@ let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
    | MjArrayNode(aNode) => caseArrayNode(aNode)
    | MjAssignmentNode(aNode) => caseAssignmentNode(aNode)
    | MjSymbolNode(sNode) => {
-        let expr: expression = toEvSymbolValue(sNode["name"])
+        let expr: expression = Builder.toEvSymbolValue(sNode["name"])
        let rExpr: result<expression, errorValue> = expr->Ok
        rExpr
      }
@ -138,7 +128,7 @@ let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
    rFinalExpression
  })
 and caseTagOrNodes = (tagOrNodes): result<expression, errorValue> => {
-  let initialBindings = passToFunction("$$bindings", list{}->Ok)
+  let initialBindings = Builder.passToFunction("$$bindings", list{})->Ok
  let lastIndex = Belt.Array.length(tagOrNodes) - 1
  tagOrNodes->Belt.Array.reduceWithIndex(initialBindings, (rPreviousBindings, tagOrNode, i) => {
    rPreviousBindings->Result.flatMap(previousBindings => {
@ -146,8 +136,10 @@ and caseTagOrNodes = (tagOrNodes): result<expression, errorValue> => {
      | BlockNode(node) => fromNode(node)
      | BlockTag(tag) =>
        switch tag {
-        | ImportVariablesStatement => passToFunction("$importVariablesStatement", list{}->Ok)
-        | ExportVariablesExpression => passToFunction("$exportVariablesExpression", list{}->Ok)
+        | ImportVariablesStatement =>
+          Builder.passToFunction("$importVariablesStatement", list{})->Ok
+        | ExportVariablesExpression =>
+          Builder.passToFunction("$exportVariablesExpression", list{})->Ok
        }
      }

@ -158,8 +150,7 @@ and caseTagOrNodes = (tagOrNodes): result<expression, errorValue> => {
      }

      rStatement->Result.flatMap((statement: expression) => {
-        let lispArgs = list{previousBindings, statement}->Ok
-        passToFunction(bindName, lispArgs)
+        Builder.passToFunction(bindName, list{previousBindings, statement})->Ok
      })
    })
  })