experimental: replace result with exceptions in reducer
This commit is contained in:
		
							parent
							
								
									9a67b16eee
								
							
						
					
					
						commit
						c0ccdbc1e9
					
				|  | @ -17,17 +17,22 @@ let testMacro_ = ( | |||
|   expectedCode: string, | ||||
| ) => { | ||||
|   let bindings = Bindings.fromArray(bindArray) | ||||
|   tester(expr->T.toString, () => | ||||
|     expr | ||||
|     ->Macro.expandMacroCall( | ||||
|   tester(expr->T.toString, () => { | ||||
|     let result = switch expr | ||||
|     ->Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( | ||||
|       bindings, | ||||
|       ProjectAccessorsT.identityAccessors, | ||||
|       Expression.reduceExpressionInProject, | ||||
|     ) | ||||
|     ) { | ||||
|       | v => Ok(v) | ||||
|       | exception Reducer_ErrorValue.ErrorException(e) => Error(e) | ||||
|     } | ||||
| 
 | ||||
|     result | ||||
|     ->ExpressionWithContext.toStringResult | ||||
|     ->expect | ||||
|     ->toEqual(expectedCode) | ||||
|   ) | ||||
|   }) | ||||
| } | ||||
| 
 | ||||
| let testMacroEval_ = ( | ||||
|  | @ -44,6 +49,7 @@ let testMacroEval_ = ( | |||
|       ProjectAccessorsT.identityAccessors, | ||||
|       Expression.reduceExpressionInProject, | ||||
|     ) | ||||
|     ->Ok | ||||
|     ->InternalExpressionValue.toStringResult | ||||
|     ->expect | ||||
|     ->toEqual(expectedValue) | ||||
|  |  | |||
|  | @ -16,7 +16,7 @@ let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): re | |||
| > => { | ||||
|   let reducerFn = Expression.reduceExpressionInProject | ||||
|   let rResult = | ||||
|     Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => | ||||
|     Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr => | ||||
|       reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors) | ||||
|     ) | ||||
|   rResult->Belt.Result.flatMap(result => | ||||
|  |  | |||
|  | @ -19,7 +19,7 @@ let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result< | |||
| > => { | ||||
|   let reducerFn = Expression.reduceExpressionInProject | ||||
|   let rResult = | ||||
|     Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => | ||||
|     Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr => | ||||
|       reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors) | ||||
|     ) | ||||
|   rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn)) | ||||
|  |  | |||
|  | @ -74,12 +74,11 @@ module Integration = { | |||
|           reducer, | ||||
|         ) | ||||
|         let result = switch resultAsInternalExpression { | ||||
|         | Ok(IEvNumber(x)) => Ok(x) | ||||
|         | Error(_) => | ||||
|         | IEvNumber(x) => Ok(x) | ||||
|         | _ => | ||||
|           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("Error 2 in Danger.integrate") | ||||
|         } | ||||
|         result | ||||
|       } | ||||
|  | @ -143,7 +142,7 @@ module Integration = { | |||
|         } | ||||
|       | Error(b) => | ||||
|         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: " ++ | ||||
|           b, | ||||
|         ) | ||||
|  | @ -310,15 +309,10 @@ module DiminishingReturns = { | |||
|               reducer, | ||||
|             ) | ||||
|             switch resultAsInternalExpression { | ||||
|             | Ok(IEvNumber(x)) => Ok(x) | ||||
|             | Error(_) => | ||||
|               Error( | ||||
|             | IEvNumber(x) => Ok(x) | ||||
|             | _ => 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 2 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions", | ||||
|               ) | ||||
|             } | ||||
|           } | ||||
| 
 | ||||
|  |  | |||
|  | @ -32,19 +32,17 @@ module Internals = { | |||
|     accessors: ProjectAccessorsT.t, | ||||
|     eLambdaValue, | ||||
|     reducer: ProjectReducerFnT.t, | ||||
|   ): result<ReducerInterface_InternalExpressionValue.t, Reducer_ErrorValue.errorValue> => { | ||||
|     let rMappedList = array->E.A.reduceReverse(Ok(list{}), (rAcc, elem) => | ||||
|       rAcc->E.R.bind(_, acc => { | ||||
|         let rNewElem = Reducer_Expression_Lambda.doLambdaCall( | ||||
|           eLambdaValue, | ||||
|           list{elem}, | ||||
|           (accessors: ProjectAccessorsT.t), | ||||
|           (reducer: ProjectReducerFnT.t), | ||||
|         ) | ||||
|         rNewElem->E.R2.fmap(newElem => list{newElem, ...acc}) | ||||
|       }) | ||||
|     ) | ||||
|     rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray) | ||||
|   ): ReducerInterface_InternalExpressionValue.t => { | ||||
|     let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => { | ||||
|       let newElem = Reducer_Expression_Lambda.doLambdaCall( | ||||
|         eLambdaValue, | ||||
|         list{elem}, | ||||
|         (accessors: ProjectAccessorsT.t), | ||||
|         (reducer: ProjectReducerFnT.t), | ||||
|       ) | ||||
|       list{newElem, ...acc} | ||||
|   }) | ||||
|     mappedList->Belt.List.toArray->Wrappers.evArray | ||||
|   } | ||||
| 
 | ||||
|   let reduce = ( | ||||
|  | @ -54,10 +52,8 @@ module Internals = { | |||
|     accessors: ProjectAccessorsT.t, | ||||
|     reducer: ProjectReducerFnT.t, | ||||
|   ) => { | ||||
|     aValueArray->E.A.reduce(Ok(initialValue), (rAcc, elem) => | ||||
|       rAcc->E.R.bind(_, acc => | ||||
|         Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer) | ||||
|       ) | ||||
|     aValueArray->E.A.reduce(initialValue, (acc, elem) => | ||||
|       Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer) | ||||
|     ) | ||||
|   } | ||||
| 
 | ||||
|  | @ -68,10 +64,8 @@ module Internals = { | |||
|     accessors: ProjectAccessorsT.t, | ||||
|     reducer: ProjectReducerFnT.t, | ||||
|   ) => { | ||||
|     aValueArray->Belt.Array.reduceReverse(Ok(initialValue), (rAcc, elem) => | ||||
|       rAcc->Belt.Result.flatMap(acc => | ||||
|         Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer) | ||||
|       ) | ||||
|     aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) => | ||||
|       Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer) | ||||
|     ) | ||||
|   } | ||||
| 
 | ||||
|  | @ -81,25 +75,19 @@ module Internals = { | |||
|     accessors: ProjectAccessorsT.t, | ||||
|     reducer: ProjectReducerFnT.t, | ||||
|   ) => { | ||||
|     let rMappedList = aValueArray->Belt.Array.reduceReverse(Ok(list{}), (rAcc, elem) => | ||||
|       rAcc->E.R.bind(_, acc => { | ||||
|         let rNewElem = Reducer_Expression_Lambda.doLambdaCall( | ||||
|           aLambdaValue, | ||||
|           list{elem}, | ||||
|           accessors, | ||||
|           reducer, | ||||
|         ) | ||||
|         rNewElem->E.R2.fmap(newElem => { | ||||
|           switch newElem { | ||||
|           | IEvBool(true) => list{elem, ...acc} | ||||
|           | _ => acc | ||||
|           } | ||||
|         }) | ||||
|       }) | ||||
|     ) | ||||
|     let result = | ||||
|       rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray) | ||||
|     result | ||||
|     let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => { | ||||
|       let newElem = Reducer_Expression_Lambda.doLambdaCall( | ||||
|         aLambdaValue, | ||||
|         list{elem}, | ||||
|         accessors, | ||||
|         reducer, | ||||
|       ) | ||||
|       switch newElem { | ||||
|         | IEvBool(true) => list{elem, ...acc} | ||||
|         | _ => acc | ||||
|       } | ||||
|     }) | ||||
|     mappedList->Belt.List.toArray->Wrappers.evArray | ||||
|   } | ||||
| } | ||||
| 
 | ||||
|  | @ -216,7 +204,7 @@ let library = [ | |||
|         ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => | ||||
|           switch inputs { | ||||
|           | [IEvArray(array), IEvLambda(lambda)] => | ||||
|             Internals.map(array, accessors, lambda, reducer)->E.R2.errMap(_ => "Error!") | ||||
|             Ok(Internals.map(array, accessors, lambda, reducer)) | ||||
|           | _ => Error(impossibleError) | ||||
|           }, | ||||
|         (), | ||||
|  | @ -236,9 +224,7 @@ let library = [ | |||
|         ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => | ||||
|           switch inputs { | ||||
|           | [IEvArray(array), initialValue, IEvLambda(lambda)] => | ||||
|             Internals.reduce(array, initialValue, lambda, accessors, reducer)->E.R2.errMap(_ => | ||||
|               "Error!" | ||||
|             ) | ||||
|             Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer)) | ||||
|           | _ => Error(impossibleError) | ||||
|           }, | ||||
|         (), | ||||
|  | @ -258,13 +244,13 @@ let library = [ | |||
|         ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => | ||||
|           switch inputs { | ||||
|           | [IEvArray(array), initialValue, IEvLambda(lambda)] => | ||||
|             Internals.reduceReverse( | ||||
|             Ok(Internals.reduceReverse( | ||||
|               array, | ||||
|               initialValue, | ||||
|               lambda, | ||||
|               accessors, | ||||
|               reducer, | ||||
|             )->E.R2.errMap(_ => "Error!") | ||||
|             )) | ||||
|           | _ => Error(impossibleError) | ||||
|           }, | ||||
|         (), | ||||
|  | @ -284,7 +270,7 @@ let library = [ | |||
|         ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => | ||||
|           switch inputs { | ||||
|           | [IEvArray(array), IEvLambda(lambda)] => | ||||
|             Internals.filter(array, lambda, accessors, reducer)->E.R2.errMap(_ => "Error!") | ||||
|             Ok(Internals.filter(array, lambda, accessors, reducer)) | ||||
|           | _ => Error(impossibleError) | ||||
|           }, | ||||
|         (), | ||||
|  |  | |||
|  | @ -37,7 +37,7 @@ module Internal = { | |||
| 
 | ||||
|   let 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) | ||||
|     } | ||||
| 
 | ||||
|  |  | |||
|  | @ -16,7 +16,7 @@ module Internal = { | |||
|     reducer: ProjectReducerFnT.t, | ||||
|   ) => | ||||
|     switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) { | ||||
|     | Ok(IEvNumber(f)) => Ok(f) | ||||
|     | IEvNumber(f) => Ok(f) | ||||
|     | _ => Error(Operation.SampleMapNeedsNtoNFunction) | ||||
|     } | ||||
| 
 | ||||
|  |  | |||
|  | @ -13,6 +13,7 @@ module TypeBuilder = Reducer_Type_TypeBuilder | |||
| open ReducerInterface_InternalExpressionValue | ||||
| open Reducer_ErrorValue | ||||
| 
 | ||||
| 
 | ||||
| /* | ||||
|   MathJs provides default implementations for built-ins | ||||
|   This is where all the expected built-ins like + = * / sin cos log ln etc are handled | ||||
|  | @ -111,7 +112,7 @@ let callInternal = ( | |||
|   module SampleMap = { | ||||
|     let doLambdaCall = (aLambdaValue, list) => | ||||
|       switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) { | ||||
|       | Ok(IEvNumber(f)) => Ok(f) | ||||
|       | IEvNumber(f) => Ok(f) | ||||
|       | _ => Error(Operation.SampleMapNeedsNtoNFunction) | ||||
|       } | ||||
| 
 | ||||
|  | @ -201,13 +202,17 @@ let dispatch = ( | |||
|   call: functionCall, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reducer: ProjectReducerFnT.t, | ||||
| ): result<internalExpressionValue, errorValue> => | ||||
| ): internalExpressionValue => | ||||
|   try { | ||||
|     let (fn, args) = call | ||||
|     // There is a bug that prevents string match in patterns | ||||
|     // So we have to recreate a copy of the string | ||||
|     ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) | ||||
|     switch ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) { | ||||
|     | Ok(v) => v | ||||
|     | Error(e) => raise(ErrorException(e)) | ||||
|     } | ||||
|   } catch { | ||||
|   | Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error | ||||
|   | _ => RETodo("unhandled rescript exception")->Error | ||||
|   | ErrorException(e) => raise(ErrorException(e)) | ||||
|   | Js.Exn.Error(obj) => raise(ErrorException(REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj)))) | ||||
|   | _ => raise(ErrorException(RETodo("unhandled rescript exception"))) | ||||
|   } | ||||
|  |  | |||
|  | @ -12,11 +12,10 @@ module ExpressionWithContext = Reducer_ExpressionWithContext | |||
| module InternalExpressionValue = ReducerInterface_InternalExpressionValue | ||||
| module ProjectAccessorsT = ReducerProject_ProjectAccessors_T | ||||
| module ProjectReducerFnT = ReducerProject_ReducerFn_T | ||||
| module Result = Belt.Result | ||||
| 
 | ||||
| open Reducer_Expression_ExpressionBuilder | ||||
| 
 | ||||
| type errorValue = ErrorValue.errorValue | ||||
| exception ErrorException = ErrorValue.ErrorException | ||||
| type expression = ExpressionT.expression | ||||
| type expressionWithContext = ExpressionWithContext.expressionWithContext | ||||
| 
 | ||||
|  | @ -25,21 +24,18 @@ let dispatchMacroCall = ( | |||
|   bindings: ExpressionT.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reduceExpression: ProjectReducerFnT.t, | ||||
| ): result<expressionWithContext, errorValue> => { | ||||
| ): expressionWithContext => { | ||||
|   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) | ||||
|       rNewStatement->Result.map(boundStatement => | ||||
|         ExpressionWithContext.withContext( | ||||
|           newCode(newBindings->eModule, boundStatement), | ||||
|           newBindings, | ||||
|         ) | ||||
|       ) | ||||
|     }) | ||||
|     let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement) | ||||
| 
 | ||||
|     ExpressionWithContext.withContext( | ||||
|       newCode(newBindings->eModule, boundStatement), | ||||
|       newBindings, | ||||
|     ) | ||||
|   } | ||||
| 
 | ||||
|   let correspondingSetBindingsFn = (fnName: string): string => | ||||
|  | @ -52,7 +48,7 @@ let dispatchMacroCall = ( | |||
|     } | ||||
| 
 | ||||
|   let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => { | ||||
|     let defaultStatement = ErrorValue.REAssignmentExpected->Error | ||||
|     let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException | ||||
|     switch statement { | ||||
|     | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => { | ||||
|         let setBindingsFn = correspondingSetBindingsFn(callName) | ||||
|  | @ -62,17 +58,14 @@ let dispatchMacroCall = ( | |||
|             boundStatement, | ||||
|           ) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})) | ||||
|         } else { | ||||
|           defaultStatement | ||||
|           raise(defaultStatement) | ||||
|         } | ||||
|       } | ||||
|     | _ => defaultStatement | ||||
|     | _ => raise(defaultStatement) | ||||
|     } | ||||
|   } | ||||
| 
 | ||||
|   let doBindExpression = (bindingExpr: expression, statement: expression, accessors): result< | ||||
|     expressionWithContext, | ||||
|     errorValue, | ||||
|   > => { | ||||
|   let doBindExpression = (bindingExpr: expression, statement: expression, accessors): expressionWithContext => { | ||||
|     let defaultStatement = () => | ||||
|       useExpressionToSetBindings(bindingExpr, accessors, statement, ( | ||||
|         _newBindingsExpr, | ||||
|  | @ -100,10 +93,7 @@ let dispatchMacroCall = ( | |||
|     } | ||||
|   } | ||||
| 
 | ||||
|   let doBlock = (exprs: list<expression>, _bindings: ExpressionT.bindings, _accessors): result< | ||||
|     expressionWithContext, | ||||
|     errorValue, | ||||
|   > => { | ||||
|   let doBlock = (exprs: list<expression>, _bindings: ExpressionT.bindings, _accessors): expressionWithContext => { | ||||
|     let exprsArray = Belt.List.toArray(exprs) | ||||
|     let maxIndex = Js.Array2.length(exprsArray) - 1 | ||||
|     let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) => | ||||
|  | @ -119,14 +109,14 @@ let dispatchMacroCall = ( | |||
|         eBindStatement(acc, statement) | ||||
|       } | ||||
|     , eSymbol("undefined block")) | ||||
|     ExpressionWithContext.noContext(newStatement)->Ok | ||||
|     ExpressionWithContext.noContext(newStatement) | ||||
|   } | ||||
| 
 | ||||
|   let doLambdaDefinition = ( | ||||
|     bindings: ExpressionT.bindings, | ||||
|     parameters: array<string>, | ||||
|     lambdaDefinition: ExpressionT.expression, | ||||
|   ) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))->Ok | ||||
|   ) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition)) | ||||
| 
 | ||||
|   let doTernary = ( | ||||
|     condition: expression, | ||||
|  | @ -134,28 +124,25 @@ let dispatchMacroCall = ( | |||
|     ifFalse: expression, | ||||
|     bindings: ExpressionT.bindings, | ||||
|     accessors, | ||||
|   ): result<expressionWithContext, errorValue> => { | ||||
|   ): expressionWithContext => { | ||||
|     let blockCondition = ExpressionBuilder.eBlock(list{condition}) | ||||
|     let rCondition = reduceExpression(blockCondition, bindings, accessors) | ||||
|     rCondition->Result.flatMap(conditionValue => | ||||
|       switch conditionValue { | ||||
|       | InternalExpressionValue.IEvBool(false) => { | ||||
|           let ifFalseBlock = eBlock(list{ifFalse}) | ||||
|           ExpressionWithContext.withContext(ifFalseBlock, bindings)->Ok | ||||
|         } | ||||
|       | InternalExpressionValue.IEvBool(true) => { | ||||
|           let ifTrueBlock = eBlock(list{ifTrue}) | ||||
|           ExpressionWithContext.withContext(ifTrueBlock, bindings)->Ok | ||||
|         } | ||||
|       | _ => REExpectedType("Boolean", "")->Error | ||||
|     let conditionValue = reduceExpression(blockCondition, bindings, accessors) | ||||
| 
 | ||||
|     switch conditionValue { | ||||
|     | InternalExpressionValue.IEvBool(false) => { | ||||
|         let ifFalseBlock = eBlock(list{ifFalse}) | ||||
|         ExpressionWithContext.withContext(ifFalseBlock, bindings) | ||||
|       } | ||||
|     ) | ||||
|     | InternalExpressionValue.IEvBool(true) => { | ||||
|         let ifTrueBlock = eBlock(list{ifTrue}) | ||||
|         ExpressionWithContext.withContext(ifTrueBlock, bindings) | ||||
|       } | ||||
|     | _ => raise(ErrorException(REExpectedType("Boolean", ""))) | ||||
|     } | ||||
|   } | ||||
| 
 | ||||
|   let expandExpressionList = (aList, bindings: ExpressionT.bindings, accessors): result< | ||||
|     expressionWithContext, | ||||
|     errorValue, | ||||
|   > => | ||||
|   let expandExpressionList = (aList, bindings: ExpressionT.bindings, accessors): expressionWithContext | ||||
|    => | ||||
|     switch aList { | ||||
|     | list{ | ||||
|         ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), | ||||
|  | @ -185,11 +172,11 @@ let dispatchMacroCall = ( | |||
|       doLambdaDefinition(bindings, parameters, lambdaDefinition) | ||||
|     | list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} => | ||||
|       doTernary(condition, ifTrue, ifFalse, bindings, accessors) | ||||
|     | _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))->Ok | ||||
|     | _ => ExpressionWithContext.noContext(ExpressionT.EList(aList)) | ||||
|     } | ||||
| 
 | ||||
|   switch macroExpression { | ||||
|   | EList(aList) => expandExpressionList(aList, bindings, accessors) | ||||
|   | _ => ExpressionWithContext.noContext(macroExpression)->Ok | ||||
|   | _ => ExpressionWithContext.noContext(macroExpression) | ||||
|   } | ||||
| } | ||||
|  |  | |||
|  | @ -26,6 +26,8 @@ type errorValue = | |||
| 
 | ||||
| type t = errorValue | ||||
| 
 | ||||
| exception ErrorException(errorValue) | ||||
| 
 | ||||
| let errorToString = err => | ||||
|   switch err { | ||||
|   | REArityError(_oFnName, arity, usedArity) => | ||||
|  |  | |||
|  | @ -14,6 +14,8 @@ module T = Reducer_Expression_T | |||
| type errorValue = Reducer_ErrorValue.errorValue | ||||
| type t = T.t | ||||
| 
 | ||||
| exception ErrorException = Reducer_ErrorValue.ErrorException | ||||
| 
 | ||||
| /* | ||||
|   Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus) | ||||
| */ | ||||
|  | @ -21,10 +23,10 @@ let rec reduceExpressionInProject = ( | |||
|   expression: t, | ||||
|   continuation: T.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
| ): result<InternalExpressionValue.t, 'e> => { | ||||
| ): InternalExpressionValue.t => { | ||||
|   // Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`) | ||||
|   switch expression { | ||||
|   | T.EValue(value) => value->Ok | ||||
|   | T.EValue(value) => value | ||||
|   | T.EList(list) => | ||||
|     switch list { | ||||
|     | list{EValue(IEvCall(fName)), ..._args} => | ||||
|  | @ -41,20 +43,13 @@ and reduceExpressionList = ( | |||
|   expressions: list<t>, | ||||
|   continuation: T.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
| ): result<InternalExpressionValue.t, 'e> => { | ||||
|   let racc: result< | ||||
|     list<InternalExpressionValue.t>, | ||||
|     'e, | ||||
|   > = 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) | ||||
|       }) | ||||
|     }) | ||||
| ): InternalExpressionValue.t => { | ||||
|   let acc: list<InternalExpressionValue.t> = expressions->Belt.List.reduceReverse(list{}, (acc, each: t) => | ||||
|     acc->Belt.List.add( | ||||
|       each->reduceExpressionInProject(continuation, accessors) | ||||
|     ) | ||||
|   ) | ||||
|   racc->Result.flatMap(acc => acc->reduceValueList(accessors)) | ||||
|   acc->reduceValueList(accessors) | ||||
| } | ||||
| 
 | ||||
| /* | ||||
|  | @ -63,48 +58,39 @@ and reduceExpressionList = ( | |||
| and reduceValueList = ( | ||||
|   valueList: list<InternalExpressionValue.t>, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
| ): result<InternalExpressionValue.t, 'e> => | ||||
| ): InternalExpressionValue.t => | ||||
|   switch valueList { | ||||
|   | list{IEvCall(fName), ...args} => { | ||||
|       let rCheckedArgs = switch fName { | ||||
|       | "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args->Ok | ||||
|       let checkedArgs = switch fName { | ||||
|       | "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args | ||||
|       | _ => args->Lambda.checkIfReduced | ||||
|       } | ||||
| 
 | ||||
|       rCheckedArgs->Result.flatMap(checkedArgs => | ||||
|         (fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch( | ||||
|           accessors, | ||||
|           reduceExpressionInProject, | ||||
|         ) | ||||
|       (fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch( | ||||
|         accessors, | ||||
|         reduceExpressionInProject, | ||||
|       ) | ||||
|     } | ||||
|   | list{IEvLambda(_)} => | ||||
|     // TODO: remove on solving issue#558 | ||||
|     valueList | ||||
|     ->Lambda.checkIfReduced | ||||
|     ->Result.flatMap(reducedValueList => | ||||
|       reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok | ||||
|     ) | ||||
|     ->Belt.List.toArray->InternalExpressionValue.IEvArray | ||||
|   | list{IEvLambda(lambdaCall), ...args} => | ||||
|     args | ||||
|     ->Lambda.checkIfReduced | ||||
|     ->Result.flatMap(checkedArgs => | ||||
|       Lambda.doLambdaCall(lambdaCall, checkedArgs, accessors, reduceExpressionInProject) | ||||
|     ) | ||||
| 
 | ||||
|     ->Lambda.doLambdaCall(lambdaCall, _, accessors, reduceExpressionInProject) | ||||
|   | _ => | ||||
|     valueList | ||||
|     ->Lambda.checkIfReduced | ||||
|     ->Result.flatMap(reducedValueList => | ||||
|       reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok | ||||
|     ) | ||||
|     ->Belt.List.toArray->InternalExpressionValue.IEvArray | ||||
|   } | ||||
| 
 | ||||
| let reduceReturningBindings = ( | ||||
|   expression: t, | ||||
|   continuation: T.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
| ): (result<InternalExpressionValue.t, 'e>, T.bindings) => { | ||||
| ): (InternalExpressionValue.t, T.bindings) => { | ||||
|   let states = accessors.states | ||||
|   let result = reduceExpressionInProject(expression, continuation, accessors) | ||||
|   (result, states.continuation) | ||||
|  | @ -118,7 +104,12 @@ module BackCompatible = { | |||
| 
 | ||||
|   let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => { | ||||
|     let accessors = ProjectAccessorsT.identityAccessors | ||||
|     expression->reduceExpressionInProject(accessors.stdLib, accessors) | ||||
|     try { | ||||
|       expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok | ||||
|     } catch { | ||||
|     | ErrorException(e) => Error(e) | ||||
|     | _ => raise(ErrorException(RETodo("internal exception"))) | ||||
|     } | ||||
|   } | ||||
| 
 | ||||
|   let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> => | ||||
|  |  | |||
|  | @ -23,7 +23,7 @@ let callReducer = ( | |||
|   bindings: bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reducer: ProjectReducerFnT.t, | ||||
| ): result<internalExpressionValue, errorValue> => { | ||||
| ): internalExpressionValue => { | ||||
|   switch expressionWithContext { | ||||
|   | ExpressionNoContext(expr) => | ||||
|     // Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`) | ||||
|  |  | |||
|  | @ -1,7 +1,6 @@ | |||
| module ErrorValue = Reducer_ErrorValue | ||||
| module ExpressionT = Reducer_Expression_T | ||||
| module InternalExpressionValue = ReducerInterface_InternalExpressionValue | ||||
| module Result = Belt.Result | ||||
| module Bindings = Reducer_Bindings | ||||
| 
 | ||||
| type errorValue = Reducer_ErrorValue.errorValue | ||||
|  | @ -10,19 +9,16 @@ type internalExpressionValue = InternalExpressionValue.t | |||
| 
 | ||||
| let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$") | ||||
| 
 | ||||
| let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): result< | ||||
|   expression, | ||||
|   errorValue, | ||||
| > => | ||||
| let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression => | ||||
|   switch expression { | ||||
|   | ExpressionT.EValue(value) => | ||||
|     replaceSymbolOnValue(bindings, value)->Result.map(evValue => evValue->ExpressionT.EValue) | ||||
|     replaceSymbolOnValue(bindings, value)->ExpressionT.EValue | ||||
|   | ExpressionT.EList(list) => | ||||
|     switch list { | ||||
|     | list{EValue(IEvCall(fName)), ..._args} => | ||||
|       switch isMacroName(fName) { | ||||
|       // A macro reduces itself so we dont dive in it | ||||
|       | true => expression->Ok | ||||
|       | true => expression | ||||
|       | false => replaceSymbolsOnExpressionList(bindings, list) | ||||
|       } | ||||
|     | _ => replaceSymbolsOnExpressionList(bindings, list) | ||||
|  | @ -30,23 +26,19 @@ let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression | |||
|   } | ||||
| 
 | ||||
| and replaceSymbolsOnExpressionList = (bindings, list) => { | ||||
|   let racc = list->Belt.List.reduceReverse(Ok(list{}), (racc, each: expression) => | ||||
|     racc->Result.flatMap(acc => { | ||||
|       replaceSymbols(bindings, each)->Result.flatMap(newNode => { | ||||
|         acc->Belt.List.add(newNode)->Ok | ||||
|       }) | ||||
|     }) | ||||
|   let racc = list->Belt.List.reduceReverse(list{}, (acc, each: expression) => | ||||
|     replaceSymbols(bindings, each)->Belt.List.add(acc, _) | ||||
|   ) | ||||
|   racc->Result.map(acc => acc->ExpressionT.EList) | ||||
|   ExpressionT.EList(racc) | ||||
| } | ||||
| and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) => | ||||
|   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 | ||||
|   | _ => evValue->Ok | ||||
|   | _ => evValue | ||||
|   } | ||||
| and checkIfCallable = (evValue: internalExpressionValue) => | ||||
|   switch evValue { | ||||
|   | IEvCall(_) | IEvLambda(_) => evValue->Ok | ||||
|   | _ => ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->Error | ||||
|   | IEvCall(_) | IEvLambda(_) => evValue | ||||
|   | _ => raise(ErrorValue.ErrorException(ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)))) | ||||
|   } | ||||
|  |  | |||
|  | @ -23,26 +23,24 @@ let checkArity = ( | |||
|     let argsLength = Belt.List.length(args) | ||||
|     let parametersLength = Js.Array2.length(lambdaValue.parameters) | ||||
|     if argsLength !== parametersLength { | ||||
|       ErrorValue.REArityError(None, parametersLength, argsLength)->Error | ||||
|       raise(ErrorValue.ErrorException(ErrorValue.REArityError(None, parametersLength, argsLength))) | ||||
|     } else { | ||||
|       args->Ok | ||||
|       args | ||||
|     } | ||||
|   } | ||||
|   let exprOrFFI = castInternalCodeToExpression(lambdaValue.body) | ||||
|   switch exprOrFFI { | ||||
|   | NotFFI(_) => reallyCheck | ||||
|   | FFI(_) => args->Ok | ||||
|   | FFI(_) => args | ||||
|   } | ||||
| } | ||||
| 
 | ||||
| let checkIfReduced = (args: list<internalExpressionValue>) => | ||||
|   args->Belt.List.reduceReverse(Ok(list{}), (rAcc, arg) => | ||||
|     rAcc->Result.flatMap(acc => | ||||
|   args->Belt.List.reduceReverse(list{}, (acc, arg) => | ||||
|       switch arg { | ||||
|       | IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->Error | ||||
|       | _ => list{arg, ...acc}->Ok | ||||
|       | IEvSymbol(symbol) => raise(ErrorValue.ErrorException(ErrorValue.RESymbolNotFound(symbol))) | ||||
|       | _ => list{arg, ...acc} | ||||
|       } | ||||
|     ) | ||||
|   ) | ||||
| 
 | ||||
| let caseNotFFI = ( | ||||
|  | @ -63,7 +61,10 @@ let caseNotFFI = ( | |||
| } | ||||
| 
 | ||||
| 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) => raise(ErrorValue.ErrorException(value)) | ||||
|   } | ||||
| } | ||||
| 
 | ||||
| let applyParametersToLambda = ( | ||||
|  | @ -71,16 +72,13 @@ let applyParametersToLambda = ( | |||
|   args, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reducer: ProjectReducerFnT.t, | ||||
| ): result<internalExpressionValue, 'e> => { | ||||
|   checkArity(lambdaValue, args)->Result.flatMap(args => | ||||
|     checkIfReduced(args)->Result.flatMap(args => { | ||||
|       let exprOrFFI = castInternalCodeToExpression(lambdaValue.body) | ||||
|       switch exprOrFFI { | ||||
|       | NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer) | ||||
|       | FFI(ffiFn) => caseFFI(ffiFn, args, accessors) | ||||
|       } | ||||
|     }) | ||||
|   ) | ||||
| ): internalExpressionValue => { | ||||
|   let args = checkArity(lambdaValue, args)->checkIfReduced | ||||
|   let exprOrFFI = castInternalCodeToExpression(lambdaValue.body) | ||||
|   switch exprOrFFI { | ||||
|   | NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer) | ||||
|   | FFI(ffiFn) => caseFFI(ffiFn, args, accessors) | ||||
|   } | ||||
| } | ||||
| 
 | ||||
| let doLambdaCall = ( | ||||
|  | @ -95,7 +93,7 @@ let foreignFunctionInterface = ( | |||
|   argArray: array<internalExpressionValue>, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reducer: ProjectReducerFnT.t, | ||||
| ): result<internalExpressionValue, Reducer_ErrorValue.errorValue> => { | ||||
| ): internalExpressionValue => { | ||||
|   let args = argArray->Belt.List.fromArray | ||||
|   applyParametersToLambda(lambdaValue, args, accessors, reducer) | ||||
| } | ||||
|  |  | |||
|  | @ -10,32 +10,17 @@ type expression = ExpressionT.expression | |||
| type internalExpressionValue = InternalExpressionValue.t | ||||
| type expressionWithContext = ExpressionWithContext.expressionWithContext | ||||
| 
 | ||||
| let expandMacroCall = ( | ||||
|   macroExpression: expression, | ||||
|   bindings: ExpressionT.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reduceExpression: ProjectReducerFnT.t, | ||||
| ): result<expressionWithContext, 'e> => | ||||
|   Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( | ||||
|     macroExpression, | ||||
|     bindings, | ||||
|     accessors, | ||||
|     reduceExpression, | ||||
|   ) | ||||
| 
 | ||||
| let doMacroCall = ( | ||||
|   macroExpression: expression, | ||||
|   bindings: ExpressionT.bindings, | ||||
|   accessors: ProjectAccessorsT.t, | ||||
|   reduceExpression: ProjectReducerFnT.t, | ||||
| ): result<internalExpressionValue, 'e> => | ||||
|   expandMacroCall( | ||||
| ): internalExpressionValue => | ||||
|   Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( | ||||
|     macroExpression, | ||||
|     bindings, | ||||
|     (accessors: ProjectAccessorsT.t), | ||||
|     (reduceExpression: ProjectReducerFnT.t), | ||||
|   )->Result.flatMap(expressionWithContext => | ||||
|     ExpressionWithContext.callReducer(expressionWithContext, bindings, accessors, reduceExpression) | ||||
|   ) | ||||
|   )->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression) | ||||
| 
 | ||||
| let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$") | ||||
|  |  | |||
|  | @ -18,13 +18,9 @@ let ievFromTypeExpression = ( | |||
|     let result = reducerFn(expr, Bindings.emptyBindings, accessors) | ||||
|     let nameSpace = accessors.states.continuation | ||||
| 
 | ||||
|     switch result { | ||||
|     | Ok(_) => | ||||
|       switch Bindings.getType(nameSpace, sIndex) { | ||||
|       | Some(value) => value->Ok | ||||
|       | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none")) | ||||
|       } | ||||
|     | err => err | ||||
|     switch Bindings.getType(nameSpace, sIndex) { | ||||
|     | Some(value) => value->Ok | ||||
|     | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none")) | ||||
|     } | ||||
|   }) | ||||
| } | ||||
|  |  | |||
|  | @ -183,16 +183,16 @@ 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 wrappedReducer = ( | ||||
| //   rExpression: T.expressionArgumentType, | ||||
| //   aContinuation: T.continuation, | ||||
| //   accessors: ProjectAccessorsT.t, | ||||
| // ): T.resultArgumentType => { | ||||
| //   Belt.Result.flatMap( | ||||
| //     rExpression, | ||||
| //     Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors), | ||||
| //   ) | ||||
| // } | ||||
| 
 | ||||
| let doBuildResult = ( | ||||
|   this: t, | ||||
|  | @ -204,7 +204,13 @@ let doBuildResult = ( | |||
|   ->Belt.Option.map( | ||||
|     Belt.Result.flatMap( | ||||
|       _, | ||||
|       Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors), | ||||
|       expression => | ||||
|       try { | ||||
|         Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok | ||||
|       } catch { | ||||
|       | Reducer_ErrorValue.ErrorException(e) => e->Error | ||||
|       | _ => RETodo("unhandled rescript exception")->Error | ||||
|       } | ||||
|     ), | ||||
|   ) | ||||
| 
 | ||||
|  |  | |||
|  | @ -6,4 +6,4 @@ type t = ( | |||
|   ExpressionT.t, | ||||
|   ExpressionT.bindings, | ||||
|   ProjectAccessorsT.t, | ||||
| ) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue> | ||||
| ) => InternalExpressionValue.t | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	Block a user