Merge pull request #1047 from quantified-uncertainty/exceptional-reducer
Exceptional reducer (~20% speedup)
This commit is contained in:
commit
5772c458a8
|
@ -19,7 +19,7 @@ let testMacro_ = (
|
||||||
let bindings = Bindings.fromArray(bindArray)
|
let bindings = Bindings.fromArray(bindArray)
|
||||||
tester(expr->T.toString, () =>
|
tester(expr->T.toString, () =>
|
||||||
expr
|
expr
|
||||||
->Macro.expandMacroCall(
|
->Macro.expandMacroCallRs(
|
||||||
bindings,
|
bindings,
|
||||||
ProjectAccessorsT.identityAccessors,
|
ProjectAccessorsT.identityAccessors,
|
||||||
Expression.reduceExpressionInProject,
|
Expression.reduceExpressionInProject,
|
||||||
|
@ -44,6 +44,7 @@ let testMacroEval_ = (
|
||||||
ProjectAccessorsT.identityAccessors,
|
ProjectAccessorsT.identityAccessors,
|
||||||
Expression.reduceExpressionInProject,
|
Expression.reduceExpressionInProject,
|
||||||
)
|
)
|
||||||
|
->Ok
|
||||||
->InternalExpressionValue.toStringResult
|
->InternalExpressionValue.toStringResult
|
||||||
->expect
|
->expect
|
||||||
->toEqual(expectedValue)
|
->toEqual(expectedValue)
|
||||||
|
|
|
@ -16,7 +16,7 @@ let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): re
|
||||||
> => {
|
> => {
|
||||||
let reducerFn = Expression.reduceExpressionInProject
|
let reducerFn = Expression.reduceExpressionInProject
|
||||||
let rResult =
|
let rResult =
|
||||||
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr =>
|
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||||
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||||
)
|
)
|
||||||
rResult->Belt.Result.flatMap(result =>
|
rResult->Belt.Result.flatMap(result =>
|
||||||
|
|
|
@ -19,7 +19,7 @@ let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
|
||||||
> => {
|
> => {
|
||||||
let reducerFn = Expression.reduceExpressionInProject
|
let reducerFn = Expression.reduceExpressionInProject
|
||||||
let rResult =
|
let rResult =
|
||||||
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr =>
|
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||||
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||||
)
|
)
|
||||||
rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
|
rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
|
||||||
|
|
|
@ -56,7 +56,7 @@ describe("test exceptions", () => {
|
||||||
testDescriptionEvalToBe(
|
testDescriptionEvalToBe(
|
||||||
"javascript exception",
|
"javascript exception",
|
||||||
"javascriptraise('div by 0')",
|
"javascriptraise('div by 0')",
|
||||||
"Error(JS Exception: Error: 'div by 0')",
|
"Error(Error: 'div by 0')",
|
||||||
)
|
)
|
||||||
// testDescriptionEvalToBe(
|
// testDescriptionEvalToBe(
|
||||||
// "rescript exception",
|
// "rescript exception",
|
||||||
|
|
|
@ -74,12 +74,11 @@ module Integration = {
|
||||||
reducer,
|
reducer,
|
||||||
)
|
)
|
||||||
let result = switch resultAsInternalExpression {
|
let result = switch resultAsInternalExpression {
|
||||||
| Ok(IEvNumber(x)) => Ok(x)
|
| IEvNumber(x) => Ok(x)
|
||||||
| Error(_) =>
|
| _ =>
|
||||||
Error(
|
Error(
|
||||||
"Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
"Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
||||||
)
|
)
|
||||||
| _ => Error("Error 2 in Danger.integrate")
|
|
||||||
}
|
}
|
||||||
result
|
result
|
||||||
}
|
}
|
||||||
|
@ -143,7 +142,7 @@ module Integration = {
|
||||||
}
|
}
|
||||||
| Error(b) =>
|
| Error(b) =>
|
||||||
Error(
|
Error(
|
||||||
"Integration error 3 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead." ++
|
"Integration error 2 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead." ++
|
||||||
"Original error: " ++
|
"Original error: " ++
|
||||||
b,
|
b,
|
||||||
)
|
)
|
||||||
|
@ -309,14 +308,10 @@ module DiminishingReturns = {
|
||||||
reducer,
|
reducer,
|
||||||
)
|
)
|
||||||
switch resultAsInternalExpression {
|
switch resultAsInternalExpression {
|
||||||
| Ok(IEvNumber(x)) => Ok(x)
|
| IEvNumber(x) => Ok(x)
|
||||||
| Error(_) =>
|
|
||||||
Error(
|
|
||||||
"Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
|
||||||
)
|
|
||||||
| _ =>
|
| _ =>
|
||||||
Error(
|
Error(
|
||||||
"Error 2 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions",
|
"Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -32,19 +32,17 @@ module Internals = {
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
eLambdaValue,
|
eLambdaValue,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
): result<ReducerInterface_InternalExpressionValue.t, Reducer_ErrorValue.errorValue> => {
|
): ReducerInterface_InternalExpressionValue.t => {
|
||||||
let rMappedList = array->E.A.reduceReverse(Ok(list{}), (rAcc, elem) =>
|
let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => {
|
||||||
rAcc->E.R.bind(_, acc => {
|
let newElem = Reducer_Expression_Lambda.doLambdaCall(
|
||||||
let rNewElem = Reducer_Expression_Lambda.doLambdaCall(
|
|
||||||
eLambdaValue,
|
eLambdaValue,
|
||||||
list{elem},
|
list{elem},
|
||||||
(accessors: ProjectAccessorsT.t),
|
(accessors: ProjectAccessorsT.t),
|
||||||
(reducer: ProjectReducerFnT.t),
|
(reducer: ProjectReducerFnT.t),
|
||||||
)
|
)
|
||||||
rNewElem->E.R2.fmap(newElem => list{newElem, ...acc})
|
list{newElem, ...acc}
|
||||||
})
|
})
|
||||||
)
|
mappedList->Belt.List.toArray->Wrappers.evArray
|
||||||
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let reduce = (
|
let reduce = (
|
||||||
|
@ -54,11 +52,9 @@ module Internals = {
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
) => {
|
) => {
|
||||||
aValueArray->E.A.reduce(Ok(initialValue), (rAcc, elem) =>
|
aValueArray->E.A.reduce(initialValue, (acc, elem) =>
|
||||||
rAcc->E.R.bind(_, acc =>
|
|
||||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
||||||
)
|
)
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let reduceReverse = (
|
let reduceReverse = (
|
||||||
|
@ -68,11 +64,9 @@ module Internals = {
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
) => {
|
) => {
|
||||||
aValueArray->Belt.Array.reduceReverse(Ok(initialValue), (rAcc, elem) =>
|
aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) =>
|
||||||
rAcc->Belt.Result.flatMap(acc =>
|
|
||||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
||||||
)
|
)
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let filter = (
|
let filter = (
|
||||||
|
@ -81,25 +75,19 @@ module Internals = {
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
) => {
|
) => {
|
||||||
let rMappedList = aValueArray->Belt.Array.reduceReverse(Ok(list{}), (rAcc, elem) =>
|
let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => {
|
||||||
rAcc->E.R.bind(_, acc => {
|
let newElem = Reducer_Expression_Lambda.doLambdaCall(
|
||||||
let rNewElem = Reducer_Expression_Lambda.doLambdaCall(
|
|
||||||
aLambdaValue,
|
aLambdaValue,
|
||||||
list{elem},
|
list{elem},
|
||||||
accessors,
|
accessors,
|
||||||
reducer,
|
reducer,
|
||||||
)
|
)
|
||||||
rNewElem->E.R2.fmap(newElem => {
|
|
||||||
switch newElem {
|
switch newElem {
|
||||||
| IEvBool(true) => list{elem, ...acc}
|
| IEvBool(true) => list{elem, ...acc}
|
||||||
| _ => acc
|
| _ => acc
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
})
|
mappedList->Belt.List.toArray->Wrappers.evArray
|
||||||
)
|
|
||||||
let result =
|
|
||||||
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
|
|
||||||
result
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -216,7 +204,7 @@ let library = [
|
||||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||||
switch inputs {
|
switch inputs {
|
||||||
| [IEvArray(array), IEvLambda(lambda)] =>
|
| [IEvArray(array), IEvLambda(lambda)] =>
|
||||||
Internals.map(array, accessors, lambda, reducer)->E.R2.errMap(_ => "Error!")
|
Ok(Internals.map(array, accessors, lambda, reducer))
|
||||||
| _ => Error(impossibleError)
|
| _ => Error(impossibleError)
|
||||||
},
|
},
|
||||||
(),
|
(),
|
||||||
|
@ -236,9 +224,7 @@ let library = [
|
||||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||||
switch inputs {
|
switch inputs {
|
||||||
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
||||||
Internals.reduce(array, initialValue, lambda, accessors, reducer)->E.R2.errMap(_ =>
|
Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer))
|
||||||
"Error!"
|
|
||||||
)
|
|
||||||
| _ => Error(impossibleError)
|
| _ => Error(impossibleError)
|
||||||
},
|
},
|
||||||
(),
|
(),
|
||||||
|
@ -258,13 +244,7 @@ let library = [
|
||||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
||||||
switch inputs {
|
switch inputs {
|
||||||
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
||||||
Internals.reduceReverse(
|
Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer))
|
||||||
array,
|
|
||||||
initialValue,
|
|
||||||
lambda,
|
|
||||||
accessors,
|
|
||||||
reducer,
|
|
||||||
)->E.R2.errMap(_ => "Error!")
|
|
||||||
| _ => Error(impossibleError)
|
| _ => Error(impossibleError)
|
||||||
},
|
},
|
||||||
(),
|
(),
|
||||||
|
@ -284,7 +264,7 @@ let library = [
|
||||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
||||||
switch inputs {
|
switch inputs {
|
||||||
| [IEvArray(array), IEvLambda(lambda)] =>
|
| [IEvArray(array), IEvLambda(lambda)] =>
|
||||||
Internals.filter(array, lambda, accessors, reducer)->E.R2.errMap(_ => "Error!")
|
Ok(Internals.filter(array, lambda, accessors, reducer))
|
||||||
| _ => Error(impossibleError)
|
| _ => Error(impossibleError)
|
||||||
},
|
},
|
||||||
(),
|
(),
|
||||||
|
|
|
@ -37,7 +37,7 @@ module Internal = {
|
||||||
|
|
||||||
let doLambdaCall = (aLambdaValue, list, environment, reducer) =>
|
let doLambdaCall = (aLambdaValue, list, environment, reducer) =>
|
||||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
|
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
|
||||||
| Ok(IEvNumber(f)) => Ok(f)
|
| IEvNumber(f) => Ok(f)
|
||||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -16,7 +16,7 @@ module Internal = {
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
) =>
|
) =>
|
||||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
||||||
| Ok(IEvNumber(f)) => Ok(f)
|
| IEvNumber(f) => Ok(f)
|
||||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -3,6 +3,7 @@ module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||||
module Continuation = ReducerInterface_Value_Continuation
|
module Continuation = ReducerInterface_Value_Continuation
|
||||||
module ExpressionT = Reducer_Expression_T
|
module ExpressionT = Reducer_Expression_T
|
||||||
module ExternalLibrary = ReducerInterface.ExternalLibrary
|
module ExternalLibrary = ReducerInterface.ExternalLibrary
|
||||||
|
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||||
module Lambda = Reducer_Expression_Lambda
|
module Lambda = Reducer_Expression_Lambda
|
||||||
module MathJs = Reducer_MathJs
|
module MathJs = Reducer_MathJs
|
||||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||||
|
@ -111,7 +112,7 @@ let callInternal = (
|
||||||
module SampleMap = {
|
module SampleMap = {
|
||||||
let doLambdaCall = (aLambdaValue, list) =>
|
let doLambdaCall = (aLambdaValue, list) =>
|
||||||
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
||||||
| Ok(IEvNumber(f)) => Ok(f)
|
| IEvNumber(f) => Ok(f)
|
||||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -201,13 +202,17 @@ let dispatch = (
|
||||||
call: functionCall,
|
call: functionCall,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
): result<internalExpressionValue, errorValue> =>
|
): internalExpressionValue =>
|
||||||
try {
|
try {
|
||||||
let (fn, args) = call
|
let (fn, args) = call
|
||||||
// There is a bug that prevents string match in patterns
|
// There is a bug that prevents string match in patterns
|
||||||
// So we have to recreate a copy of the string
|
// So we have to recreate a copy of the string
|
||||||
ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal)
|
ExternalLibrary.dispatch(
|
||||||
|
(Js.String.make(fn), args),
|
||||||
|
accessors,
|
||||||
|
reducer,
|
||||||
|
callInternal,
|
||||||
|
)->InternalExpressionValue.resultToValue
|
||||||
} catch {
|
} catch {
|
||||||
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error
|
| exn => Reducer_ErrorValue.fromException(exn)->Reducer_ErrorValue.toException
|
||||||
| _ => RETodo("unhandled rescript exception")->Error
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -12,11 +12,9 @@ module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||||
module Result = Belt.Result
|
|
||||||
|
|
||||||
open Reducer_Expression_ExpressionBuilder
|
open Reducer_Expression_ExpressionBuilder
|
||||||
|
|
||||||
type errorValue = ErrorValue.errorValue
|
|
||||||
type expression = ExpressionT.expression
|
type expression = ExpressionT.expression
|
||||||
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||||
|
|
||||||
|
@ -25,21 +23,15 @@ let dispatchMacroCall = (
|
||||||
bindings: ExpressionT.bindings,
|
bindings: ExpressionT.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reduceExpression: ProjectReducerFnT.t,
|
reduceExpression: ProjectReducerFnT.t,
|
||||||
): result<expressionWithContext, errorValue> => {
|
): expressionWithContext => {
|
||||||
let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
|
let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
|
||||||
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, accessors)
|
let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
|
||||||
|
|
||||||
rExternalBindingsValue->Result.flatMap(nameSpaceValue => {
|
|
||||||
let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
|
let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
|
||||||
|
|
||||||
let rNewStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
|
let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
|
||||||
rNewStatement->Result.map(boundStatement =>
|
|
||||||
ExpressionWithContext.withContext(
|
ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
|
||||||
newCode(newBindings->eModule, boundStatement),
|
|
||||||
newBindings,
|
|
||||||
)
|
|
||||||
)
|
|
||||||
})
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let correspondingSetBindingsFn = (fnName: string): string =>
|
let correspondingSetBindingsFn = (fnName: string): string =>
|
||||||
|
@ -52,7 +44,7 @@ let dispatchMacroCall = (
|
||||||
}
|
}
|
||||||
|
|
||||||
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
|
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
|
||||||
let defaultStatement = ErrorValue.REAssignmentExpected->Error
|
let defaultStatement = ErrorValue.REAssignmentExpected
|
||||||
switch statement {
|
switch statement {
|
||||||
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
|
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
|
||||||
let setBindingsFn = correspondingSetBindingsFn(callName)
|
let setBindingsFn = correspondingSetBindingsFn(callName)
|
||||||
|
@ -62,17 +54,18 @@ let dispatchMacroCall = (
|
||||||
boundStatement,
|
boundStatement,
|
||||||
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
|
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
|
||||||
} else {
|
} else {
|
||||||
defaultStatement
|
defaultStatement->Reducer_ErrorValue.toException
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
| _ => defaultStatement
|
| _ => defaultStatement->Reducer_ErrorValue.toException
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let doBindExpression = (bindingExpr: expression, statement: expression, accessors): result<
|
let doBindExpression = (
|
||||||
expressionWithContext,
|
bindingExpr: expression,
|
||||||
errorValue,
|
statement: expression,
|
||||||
> => {
|
accessors,
|
||||||
|
): expressionWithContext => {
|
||||||
let defaultStatement = () =>
|
let defaultStatement = () =>
|
||||||
useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||||
_newBindingsExpr,
|
_newBindingsExpr,
|
||||||
|
@ -100,10 +93,11 @@ let dispatchMacroCall = (
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let doBlock = (exprs: list<expression>, _bindings: ExpressionT.bindings, _accessors): result<
|
let doBlock = (
|
||||||
expressionWithContext,
|
exprs: list<expression>,
|
||||||
errorValue,
|
_bindings: ExpressionT.bindings,
|
||||||
> => {
|
_accessors,
|
||||||
|
): expressionWithContext => {
|
||||||
let exprsArray = Belt.List.toArray(exprs)
|
let exprsArray = Belt.List.toArray(exprs)
|
||||||
let maxIndex = Js.Array2.length(exprsArray) - 1
|
let maxIndex = Js.Array2.length(exprsArray) - 1
|
||||||
let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) =>
|
let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) =>
|
||||||
|
@ -119,14 +113,14 @@ let dispatchMacroCall = (
|
||||||
eBindStatement(acc, statement)
|
eBindStatement(acc, statement)
|
||||||
}
|
}
|
||||||
, eSymbol("undefined block"))
|
, eSymbol("undefined block"))
|
||||||
ExpressionWithContext.noContext(newStatement)->Ok
|
ExpressionWithContext.noContext(newStatement)
|
||||||
}
|
}
|
||||||
|
|
||||||
let doLambdaDefinition = (
|
let doLambdaDefinition = (
|
||||||
bindings: ExpressionT.bindings,
|
bindings: ExpressionT.bindings,
|
||||||
parameters: array<string>,
|
parameters: array<string>,
|
||||||
lambdaDefinition: ExpressionT.expression,
|
lambdaDefinition: ExpressionT.expression,
|
||||||
) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))->Ok
|
) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
|
||||||
|
|
||||||
let doTernary = (
|
let doTernary = (
|
||||||
condition: expression,
|
condition: expression,
|
||||||
|
@ -134,28 +128,28 @@ let dispatchMacroCall = (
|
||||||
ifFalse: expression,
|
ifFalse: expression,
|
||||||
bindings: ExpressionT.bindings,
|
bindings: ExpressionT.bindings,
|
||||||
accessors,
|
accessors,
|
||||||
): result<expressionWithContext, errorValue> => {
|
): expressionWithContext => {
|
||||||
let blockCondition = ExpressionBuilder.eBlock(list{condition})
|
let blockCondition = ExpressionBuilder.eBlock(list{condition})
|
||||||
let rCondition = reduceExpression(blockCondition, bindings, accessors)
|
let conditionValue = reduceExpression(blockCondition, bindings, accessors)
|
||||||
rCondition->Result.flatMap(conditionValue =>
|
|
||||||
switch conditionValue {
|
switch conditionValue {
|
||||||
| InternalExpressionValue.IEvBool(false) => {
|
| InternalExpressionValue.IEvBool(false) => {
|
||||||
let ifFalseBlock = eBlock(list{ifFalse})
|
let ifFalseBlock = eBlock(list{ifFalse})
|
||||||
ExpressionWithContext.withContext(ifFalseBlock, bindings)->Ok
|
ExpressionWithContext.withContext(ifFalseBlock, bindings)
|
||||||
}
|
}
|
||||||
| InternalExpressionValue.IEvBool(true) => {
|
| InternalExpressionValue.IEvBool(true) => {
|
||||||
let ifTrueBlock = eBlock(list{ifTrue})
|
let ifTrueBlock = eBlock(list{ifTrue})
|
||||||
ExpressionWithContext.withContext(ifTrueBlock, bindings)->Ok
|
ExpressionWithContext.withContext(ifTrueBlock, bindings)
|
||||||
}
|
}
|
||||||
| _ => REExpectedType("Boolean", "")->Error
|
| _ => REExpectedType("Boolean", "")->Reducer_ErrorValue.toException
|
||||||
}
|
}
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let expandExpressionList = (aList, bindings: ExpressionT.bindings, accessors): result<
|
let expandExpressionList = (
|
||||||
expressionWithContext,
|
aList,
|
||||||
errorValue,
|
bindings: ExpressionT.bindings,
|
||||||
> =>
|
accessors,
|
||||||
|
): expressionWithContext =>
|
||||||
switch aList {
|
switch aList {
|
||||||
| list{
|
| list{
|
||||||
ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
|
ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
|
||||||
|
@ -185,11 +179,11 @@ let dispatchMacroCall = (
|
||||||
doLambdaDefinition(bindings, parameters, lambdaDefinition)
|
doLambdaDefinition(bindings, parameters, lambdaDefinition)
|
||||||
| list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
|
| list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
|
||||||
doTernary(condition, ifTrue, ifFalse, bindings, accessors)
|
doTernary(condition, ifTrue, ifFalse, bindings, accessors)
|
||||||
| _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))->Ok
|
| _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
|
||||||
}
|
}
|
||||||
|
|
||||||
switch macroExpression {
|
switch macroExpression {
|
||||||
| EList(aList) => expandExpressionList(aList, bindings, accessors)
|
| EList(aList) => expandExpressionList(aList, bindings, accessors)
|
||||||
| _ => ExpressionWithContext.noContext(macroExpression)->Ok
|
| _ => ExpressionWithContext.noContext(macroExpression)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -26,6 +26,8 @@ type errorValue =
|
||||||
|
|
||||||
type t = errorValue
|
type t = errorValue
|
||||||
|
|
||||||
|
exception ErrorException(errorValue)
|
||||||
|
|
||||||
let errorToString = err =>
|
let errorToString = err =>
|
||||||
switch err {
|
switch err {
|
||||||
| REArityError(_oFnName, arity, usedArity) =>
|
| REArityError(_oFnName, arity, usedArity) =>
|
||||||
|
@ -62,3 +64,20 @@ let errorToString = err =>
|
||||||
| RENeedToRun => "Need to run"
|
| RENeedToRun => "Need to run"
|
||||||
| REOther(msg) => `Error: ${msg}`
|
| REOther(msg) => `Error: ${msg}`
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let fromException = exn =>
|
||||||
|
switch exn {
|
||||||
|
| ErrorException(e) => e
|
||||||
|
| Js.Exn.Error(e) =>
|
||||||
|
switch Js.Exn.message(e) {
|
||||||
|
| Some(message) => REOther(message)
|
||||||
|
| None =>
|
||||||
|
switch Js.Exn.name(e) {
|
||||||
|
| Some(name) => REOther(name)
|
||||||
|
| None => REOther("Unknown error")
|
||||||
|
}
|
||||||
|
}
|
||||||
|
| _e => REOther("Unknown error")
|
||||||
|
}
|
||||||
|
|
||||||
|
let toException = (errorValue: t) => raise(ErrorException(errorValue))
|
||||||
|
|
|
@ -21,10 +21,10 @@ let rec reduceExpressionInProject = (
|
||||||
expression: t,
|
expression: t,
|
||||||
continuation: T.bindings,
|
continuation: T.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
): result<InternalExpressionValue.t, 'e> => {
|
): InternalExpressionValue.t => {
|
||||||
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
|
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
|
||||||
switch expression {
|
switch expression {
|
||||||
| T.EValue(value) => value->Ok
|
| T.EValue(value) => value
|
||||||
| T.EList(list) =>
|
| T.EList(list) =>
|
||||||
switch list {
|
switch list {
|
||||||
| list{EValue(IEvCall(fName)), ..._args} =>
|
| list{EValue(IEvCall(fName)), ..._args} =>
|
||||||
|
@ -41,20 +41,12 @@ and reduceExpressionList = (
|
||||||
expressions: list<t>,
|
expressions: list<t>,
|
||||||
continuation: T.bindings,
|
continuation: T.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
): result<InternalExpressionValue.t, 'e> => {
|
): InternalExpressionValue.t => {
|
||||||
let racc: result<
|
let acc: list<InternalExpressionValue.t> =
|
||||||
list<InternalExpressionValue.t>,
|
expressions->Belt.List.reduceReverse(list{}, (acc, each: t) =>
|
||||||
'e,
|
acc->Belt.List.add(each->reduceExpressionInProject(continuation, accessors))
|
||||||
> = expressions->Belt.List.reduceReverse(Ok(list{}), (racc, each: t) =>
|
|
||||||
racc->Result.flatMap(acc => {
|
|
||||||
each
|
|
||||||
->reduceExpressionInProject(continuation, accessors)
|
|
||||||
->Result.map(newNode => {
|
|
||||||
acc->Belt.List.add(newNode)
|
|
||||||
})
|
|
||||||
})
|
|
||||||
)
|
)
|
||||||
racc->Result.flatMap(acc => acc->reduceValueList(accessors))
|
acc->reduceValueList(accessors)
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
|
@ -63,48 +55,34 @@ and reduceExpressionList = (
|
||||||
and reduceValueList = (
|
and reduceValueList = (
|
||||||
valueList: list<InternalExpressionValue.t>,
|
valueList: list<InternalExpressionValue.t>,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
): result<InternalExpressionValue.t, 'e> =>
|
): InternalExpressionValue.t =>
|
||||||
switch valueList {
|
switch valueList {
|
||||||
| list{IEvCall(fName), ...args} => {
|
| list{IEvCall(fName), ...args} => {
|
||||||
let rCheckedArgs = switch fName {
|
let checkedArgs = switch fName {
|
||||||
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args->Ok
|
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args
|
||||||
| _ => args->Lambda.checkIfReduced
|
| _ => args->Lambda.checkIfReduced
|
||||||
}
|
}
|
||||||
|
|
||||||
rCheckedArgs->Result.flatMap(checkedArgs =>
|
|
||||||
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
|
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
|
||||||
accessors,
|
accessors,
|
||||||
reduceExpressionInProject,
|
reduceExpressionInProject,
|
||||||
)
|
)
|
||||||
)
|
|
||||||
}
|
}
|
||||||
| list{IEvLambda(_)} =>
|
| list{IEvLambda(_)} =>
|
||||||
// TODO: remove on solving issue#558
|
// TODO: remove on solving issue#558
|
||||||
valueList
|
valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
|
||||||
->Lambda.checkIfReduced
|
|
||||||
->Result.flatMap(reducedValueList =>
|
|
||||||
reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok
|
|
||||||
)
|
|
||||||
| list{IEvLambda(lambdaCall), ...args} =>
|
| list{IEvLambda(lambdaCall), ...args} =>
|
||||||
args
|
args
|
||||||
->Lambda.checkIfReduced
|
->Lambda.checkIfReduced
|
||||||
->Result.flatMap(checkedArgs =>
|
->Lambda.doLambdaCall(lambdaCall, _, accessors, reduceExpressionInProject)
|
||||||
Lambda.doLambdaCall(lambdaCall, checkedArgs, accessors, reduceExpressionInProject)
|
| _ => valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
|
||||||
)
|
|
||||||
|
|
||||||
| _ =>
|
|
||||||
valueList
|
|
||||||
->Lambda.checkIfReduced
|
|
||||||
->Result.flatMap(reducedValueList =>
|
|
||||||
reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let reduceReturningBindings = (
|
let reduceReturningBindings = (
|
||||||
expression: t,
|
expression: t,
|
||||||
continuation: T.bindings,
|
continuation: T.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
): (result<InternalExpressionValue.t, 'e>, T.bindings) => {
|
): (InternalExpressionValue.t, T.bindings) => {
|
||||||
let states = accessors.states
|
let states = accessors.states
|
||||||
let result = reduceExpressionInProject(expression, continuation, accessors)
|
let result = reduceExpressionInProject(expression, continuation, accessors)
|
||||||
(result, states.continuation)
|
(result, states.continuation)
|
||||||
|
@ -118,7 +96,11 @@ module BackCompatible = {
|
||||||
|
|
||||||
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => {
|
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => {
|
||||||
let accessors = ProjectAccessorsT.identityAccessors
|
let accessors = ProjectAccessorsT.identityAccessors
|
||||||
expression->reduceExpressionInProject(accessors.stdLib, accessors)
|
try {
|
||||||
|
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
|
||||||
|
} catch {
|
||||||
|
| exn => Reducer_ErrorValue.fromException(exn)->Error
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>
|
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>
|
||||||
|
|
|
@ -18,12 +18,14 @@ type expressionWithContext =
|
||||||
| ExpressionWithContext(expression, context)
|
| ExpressionWithContext(expression, context)
|
||||||
| ExpressionNoContext(expression)
|
| ExpressionNoContext(expression)
|
||||||
|
|
||||||
|
type t = expressionWithContext
|
||||||
|
|
||||||
let callReducer = (
|
let callReducer = (
|
||||||
expressionWithContext: expressionWithContext,
|
expressionWithContext: expressionWithContext,
|
||||||
bindings: bindings,
|
bindings: bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
): result<internalExpressionValue, errorValue> => {
|
): internalExpressionValue => {
|
||||||
switch expressionWithContext {
|
switch expressionWithContext {
|
||||||
| ExpressionNoContext(expr) =>
|
| ExpressionNoContext(expr) =>
|
||||||
// Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
|
// Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
|
||||||
|
@ -51,3 +53,10 @@ let toStringResult = rExpressionWithContext =>
|
||||||
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
|
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
|
||||||
| Error(errorValue) => ErrorValue.errorToString(errorValue)
|
| Error(errorValue) => ErrorValue.errorToString(errorValue)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let resultToValue = (rExpressionWithContext: result<t, errorValue>): t => {
|
||||||
|
switch rExpressionWithContext {
|
||||||
|
| Ok(expressionWithContext) => expressionWithContext
|
||||||
|
| Error(errorValue) => ErrorValue.toException(errorValue)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
module ErrorValue = Reducer_ErrorValue
|
module ErrorValue = Reducer_ErrorValue
|
||||||
module ExpressionT = Reducer_Expression_T
|
module ExpressionT = Reducer_Expression_T
|
||||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||||
module Result = Belt.Result
|
|
||||||
module Bindings = Reducer_Bindings
|
module Bindings = Reducer_Bindings
|
||||||
|
|
||||||
type errorValue = Reducer_ErrorValue.errorValue
|
type errorValue = Reducer_ErrorValue.errorValue
|
||||||
|
@ -10,19 +9,15 @@ type internalExpressionValue = InternalExpressionValue.t
|
||||||
|
|
||||||
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||||
|
|
||||||
let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): result<
|
let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression =>
|
||||||
expression,
|
|
||||||
errorValue,
|
|
||||||
> =>
|
|
||||||
switch expression {
|
switch expression {
|
||||||
| ExpressionT.EValue(value) =>
|
| ExpressionT.EValue(value) => replaceSymbolOnValue(bindings, value)->ExpressionT.EValue
|
||||||
replaceSymbolOnValue(bindings, value)->Result.map(evValue => evValue->ExpressionT.EValue)
|
|
||||||
| ExpressionT.EList(list) =>
|
| ExpressionT.EList(list) =>
|
||||||
switch list {
|
switch list {
|
||||||
| list{EValue(IEvCall(fName)), ..._args} =>
|
| list{EValue(IEvCall(fName)), ..._args} =>
|
||||||
switch isMacroName(fName) {
|
switch isMacroName(fName) {
|
||||||
// A macro reduces itself so we dont dive in it
|
// A macro reduces itself so we dont dive in it
|
||||||
| true => expression->Ok
|
| true => expression
|
||||||
| false => replaceSymbolsOnExpressionList(bindings, list)
|
| false => replaceSymbolsOnExpressionList(bindings, list)
|
||||||
}
|
}
|
||||||
| _ => replaceSymbolsOnExpressionList(bindings, list)
|
| _ => replaceSymbolsOnExpressionList(bindings, list)
|
||||||
|
@ -30,23 +25,21 @@ let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression
|
||||||
}
|
}
|
||||||
|
|
||||||
and replaceSymbolsOnExpressionList = (bindings, list) => {
|
and replaceSymbolsOnExpressionList = (bindings, list) => {
|
||||||
let racc = list->Belt.List.reduceReverse(Ok(list{}), (racc, each: expression) =>
|
let racc =
|
||||||
racc->Result.flatMap(acc => {
|
list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
|
||||||
replaceSymbols(bindings, each)->Result.flatMap(newNode => {
|
replaceSymbols(bindings, each)->Belt.List.add(acc, _)
|
||||||
acc->Belt.List.add(newNode)->Ok
|
|
||||||
})
|
|
||||||
})
|
|
||||||
)
|
)
|
||||||
racc->Result.map(acc => acc->ExpressionT.EList)
|
ExpressionT.EList(racc)
|
||||||
}
|
}
|
||||||
and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
|
and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
|
||||||
switch evValue {
|
switch evValue {
|
||||||
| IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->Ok
|
| IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)
|
||||||
| IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
|
| IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
|
||||||
| _ => evValue->Ok
|
| _ => evValue
|
||||||
}
|
}
|
||||||
and checkIfCallable = (evValue: internalExpressionValue) =>
|
and checkIfCallable = (evValue: internalExpressionValue) =>
|
||||||
switch evValue {
|
switch evValue {
|
||||||
| IEvCall(_) | IEvLambda(_) => evValue->Ok
|
| IEvCall(_) | IEvLambda(_) => evValue
|
||||||
| _ => ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->Error
|
| _ =>
|
||||||
|
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->ErrorValue.toException
|
||||||
}
|
}
|
||||||
|
|
|
@ -23,27 +23,25 @@ let checkArity = (
|
||||||
let argsLength = Belt.List.length(args)
|
let argsLength = Belt.List.length(args)
|
||||||
let parametersLength = Js.Array2.length(lambdaValue.parameters)
|
let parametersLength = Js.Array2.length(lambdaValue.parameters)
|
||||||
if argsLength !== parametersLength {
|
if argsLength !== parametersLength {
|
||||||
ErrorValue.REArityError(None, parametersLength, argsLength)->Error
|
ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.toException
|
||||||
} else {
|
} else {
|
||||||
args->Ok
|
args
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
||||||
switch exprOrFFI {
|
switch exprOrFFI {
|
||||||
| NotFFI(_) => reallyCheck
|
| NotFFI(_) => reallyCheck
|
||||||
| FFI(_) => args->Ok
|
| FFI(_) => args
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let checkIfReduced = (args: list<internalExpressionValue>) =>
|
let checkIfReduced = (args: list<internalExpressionValue>) =>
|
||||||
args->Belt.List.reduceReverse(Ok(list{}), (rAcc, arg) =>
|
args->Belt.List.reduceReverse(list{}, (acc, arg) =>
|
||||||
rAcc->Result.flatMap(acc =>
|
|
||||||
switch arg {
|
switch arg {
|
||||||
| IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->Error
|
| IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->ErrorValue.toException
|
||||||
| _ => list{arg, ...acc}->Ok
|
| _ => list{arg, ...acc}
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
)
|
|
||||||
|
|
||||||
let caseNotFFI = (
|
let caseNotFFI = (
|
||||||
lambdaValue: ExpressionValue.lambdaValue,
|
lambdaValue: ExpressionValue.lambdaValue,
|
||||||
|
@ -63,7 +61,10 @@ let caseNotFFI = (
|
||||||
}
|
}
|
||||||
|
|
||||||
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
|
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
|
||||||
ffiFn(args->Belt.List.toArray, accessors.environment)
|
switch ffiFn(args->Belt.List.toArray, accessors.environment) {
|
||||||
|
| Ok(value) => value
|
||||||
|
| Error(value) => value->ErrorValue.toException
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let applyParametersToLambda = (
|
let applyParametersToLambda = (
|
||||||
|
@ -71,16 +72,13 @@ let applyParametersToLambda = (
|
||||||
args,
|
args,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
): result<internalExpressionValue, 'e> => {
|
): internalExpressionValue => {
|
||||||
checkArity(lambdaValue, args)->Result.flatMap(args =>
|
let args = checkArity(lambdaValue, args)->checkIfReduced
|
||||||
checkIfReduced(args)->Result.flatMap(args => {
|
|
||||||
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
||||||
switch exprOrFFI {
|
switch exprOrFFI {
|
||||||
| NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer)
|
| NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer)
|
||||||
| FFI(ffiFn) => caseFFI(ffiFn, args, accessors)
|
| FFI(ffiFn) => caseFFI(ffiFn, args, accessors)
|
||||||
}
|
}
|
||||||
})
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let doLambdaCall = (
|
let doLambdaCall = (
|
||||||
|
@ -95,7 +93,7 @@ let foreignFunctionInterface = (
|
||||||
argArray: array<internalExpressionValue>,
|
argArray: array<internalExpressionValue>,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reducer: ProjectReducerFnT.t,
|
reducer: ProjectReducerFnT.t,
|
||||||
): result<internalExpressionValue, Reducer_ErrorValue.errorValue> => {
|
): internalExpressionValue => {
|
||||||
let args = argArray->Belt.List.fromArray
|
let args = argArray->Belt.List.fromArray
|
||||||
applyParametersToLambda(lambdaValue, args, accessors, reducer)
|
applyParametersToLambda(lambdaValue, args, accessors, reducer)
|
||||||
}
|
}
|
||||||
|
|
|
@ -10,32 +10,34 @@ type expression = ExpressionT.expression
|
||||||
type internalExpressionValue = InternalExpressionValue.t
|
type internalExpressionValue = InternalExpressionValue.t
|
||||||
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||||
|
|
||||||
let expandMacroCall = (
|
let expandMacroCallRs = (
|
||||||
macroExpression: expression,
|
macroExpression: expression,
|
||||||
bindings: ExpressionT.bindings,
|
bindings: ExpressionT.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reduceExpression: ProjectReducerFnT.t,
|
reduceExpression: ProjectReducerFnT.t,
|
||||||
): result<expressionWithContext, 'e> =>
|
): result<expressionWithContext, 'e> =>
|
||||||
|
try {
|
||||||
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||||
macroExpression,
|
macroExpression,
|
||||||
bindings,
|
bindings,
|
||||||
accessors,
|
accessors,
|
||||||
reduceExpression,
|
reduceExpression,
|
||||||
)
|
)->Ok
|
||||||
|
} catch {
|
||||||
|
| exn => Reducer_ErrorValue.fromException(exn)->Error
|
||||||
|
}
|
||||||
|
|
||||||
let doMacroCall = (
|
let doMacroCall = (
|
||||||
macroExpression: expression,
|
macroExpression: expression,
|
||||||
bindings: ExpressionT.bindings,
|
bindings: ExpressionT.bindings,
|
||||||
accessors: ProjectAccessorsT.t,
|
accessors: ProjectAccessorsT.t,
|
||||||
reduceExpression: ProjectReducerFnT.t,
|
reduceExpression: ProjectReducerFnT.t,
|
||||||
): result<internalExpressionValue, 'e> =>
|
): internalExpressionValue =>
|
||||||
expandMacroCall(
|
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||||
macroExpression,
|
macroExpression,
|
||||||
bindings,
|
bindings,
|
||||||
(accessors: ProjectAccessorsT.t),
|
(accessors: ProjectAccessorsT.t),
|
||||||
(reduceExpression: ProjectReducerFnT.t),
|
(reduceExpression: ProjectReducerFnT.t),
|
||||||
)->Result.flatMap(expressionWithContext =>
|
)->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
|
||||||
ExpressionWithContext.callReducer(expressionWithContext, bindings, accessors, reduceExpression)
|
|
||||||
)
|
|
||||||
|
|
||||||
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||||
|
|
|
@ -82,3 +82,9 @@ type optionFfiFnReturningResult = (
|
||||||
type expressionOrFFI =
|
type expressionOrFFI =
|
||||||
| NotFFI(expression)
|
| NotFFI(expression)
|
||||||
| FFI(ffiFn)
|
| FFI(ffiFn)
|
||||||
|
|
||||||
|
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
|
||||||
|
switch rExpression {
|
||||||
|
| Ok(expression) => expression
|
||||||
|
| Error(errorValue) => Reducer_ErrorValue.toException(errorValue)
|
||||||
|
}
|
||||||
|
|
|
@ -15,17 +15,13 @@ let ievFromTypeExpression = (
|
||||||
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
|
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
|
||||||
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
|
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
|
||||||
let accessors = ProjectAccessorsT.identityAccessors
|
let accessors = ProjectAccessorsT.identityAccessors
|
||||||
let result = reducerFn(expr, Bindings.emptyBindings, accessors)
|
let _result = reducerFn(expr, Bindings.emptyBindings, accessors)
|
||||||
let nameSpace = accessors.states.continuation
|
let nameSpace = accessors.states.continuation
|
||||||
|
|
||||||
switch result {
|
|
||||||
| Ok(_) =>
|
|
||||||
switch Bindings.getType(nameSpace, sIndex) {
|
switch Bindings.getType(nameSpace, sIndex) {
|
||||||
| Some(value) => value->Ok
|
| Some(value) => value->Ok
|
||||||
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
|
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
|
||||||
}
|
}
|
||||||
| err => err
|
|
||||||
}
|
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -244,3 +244,9 @@ let nameSpaceGet = (nameSpace: nameSpace, key: string): option<t> => {
|
||||||
let NameSpace(container) = nameSpace
|
let NameSpace(container) = nameSpace
|
||||||
container->Belt.Map.String.get(key)
|
container->Belt.Map.String.get(key)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
|
||||||
|
switch rExpression {
|
||||||
|
| Ok(expression) => expression
|
||||||
|
| Error(errorValue) => Reducer_ErrorValue.toException(errorValue)
|
||||||
|
}
|
||||||
|
|
|
@ -183,17 +183,6 @@ let buildExpression = (this: t): t => {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let wrappedReducer = (
|
|
||||||
rExpression: T.expressionArgumentType,
|
|
||||||
aContinuation: T.continuation,
|
|
||||||
accessors: ProjectAccessorsT.t,
|
|
||||||
): T.resultArgumentType => {
|
|
||||||
Belt.Result.flatMap(
|
|
||||||
rExpression,
|
|
||||||
Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors),
|
|
||||||
)
|
|
||||||
}
|
|
||||||
|
|
||||||
let doBuildResult = (
|
let doBuildResult = (
|
||||||
this: t,
|
this: t,
|
||||||
aContinuation: T.continuation,
|
aContinuation: T.continuation,
|
||||||
|
@ -202,9 +191,12 @@ let doBuildResult = (
|
||||||
this
|
this
|
||||||
->getExpression
|
->getExpression
|
||||||
->Belt.Option.map(
|
->Belt.Option.map(
|
||||||
Belt.Result.flatMap(
|
Belt.Result.flatMap(_, expression =>
|
||||||
_,
|
try {
|
||||||
Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors),
|
Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
|
||||||
|
} catch {
|
||||||
|
| exn => Reducer_ErrorValue.fromException(exn)->Error
|
||||||
|
}
|
||||||
),
|
),
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -2,8 +2,4 @@ module ExpressionT = Reducer_Expression_T
|
||||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||||
|
|
||||||
type t = (
|
type t = (ExpressionT.t, ExpressionT.bindings, ProjectAccessorsT.t) => InternalExpressionValue.t
|
||||||
ExpressionT.t,
|
|
||||||
ExpressionT.bindings,
|
|
||||||
ProjectAccessorsT.t,
|
|
||||||
) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user