Merge branch 'exceptional-reducer' into map-efficiency

This commit is contained in:
Umur Ozkul 2022-09-11 15:31:40 +02:00
commit 4fc10823fe
14 changed files with 83 additions and 38 deletions

View File

@ -17,18 +17,17 @@ let testMacro_ = (
expectedCode: string, expectedCode: string,
) => { ) => {
let bindings = Bindings.fromArray(bindArray) let bindings = Bindings.fromArray(bindArray)
tester(expr->T.toString, () => { tester(expr->T.toString, () =>
let result = switch expr->Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( expr
->Macro.expandMacroCallRs(
bindings, bindings,
ProjectAccessorsT.identityAccessors, ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject, Expression.reduceExpressionInProject,
) { )
| v => Ok(v) ->ExpressionWithContext.toStringResult
| exception Reducer_ErrorValue.ErrorException(e) => Error(e) ->expect
} ->toEqual(expectedCode)
)
result->ExpressionWithContext.toStringResult->expect->toEqual(expectedCode)
})
} }
let testMacroEval_ = ( let testMacroEval_ = (

View File

@ -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",

View File

@ -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
@ -206,13 +207,12 @@ let dispatch = (
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
switch ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) { ExternalLibrary.dispatch(
| Ok(v) => v (Js.String.make(fn), args),
| Error(e) => raise(ErrorException(e)) accessors,
} reducer,
callInternal,
)->InternalExpressionValue.resultToValue
} catch { } catch {
| ErrorException(e) => raise(ErrorException(e)) | exn => Reducer_ErrorValue.fromException(exn)->Reducer_ErrorValue.toException
| Js.Exn.Error(obj) =>
raise(ErrorException(REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))))
| _ => raise(ErrorException(RETodo("unhandled rescript exception")))
} }

View File

@ -15,7 +15,6 @@ module ProjectReducerFnT = ReducerProject_ReducerFn_T
open Reducer_Expression_ExpressionBuilder open Reducer_Expression_ExpressionBuilder
exception ErrorException = ErrorValue.ErrorException
type expression = ExpressionT.expression type expression = ExpressionT.expression
type expressionWithContext = ExpressionWithContext.expressionWithContext type expressionWithContext = ExpressionWithContext.expressionWithContext
@ -45,7 +44,7 @@ let dispatchMacroCall = (
} }
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => { let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException 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)
@ -55,10 +54,10 @@ let dispatchMacroCall = (
boundStatement, boundStatement,
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})) ) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
} else { } else {
raise(defaultStatement) defaultStatement->Reducer_ErrorValue.toException
} }
} }
| _ => raise(defaultStatement) | _ => defaultStatement->Reducer_ErrorValue.toException
} }
} }
@ -142,7 +141,7 @@ let dispatchMacroCall = (
let ifTrueBlock = eBlock(list{ifTrue}) let ifTrueBlock = eBlock(list{ifTrue})
ExpressionWithContext.withContext(ifTrueBlock, bindings) ExpressionWithContext.withContext(ifTrueBlock, bindings)
} }
| _ => raise(ErrorException(REExpectedType("Boolean", ""))) | _ => REExpectedType("Boolean", "")->Reducer_ErrorValue.toException
} }
} }

View File

@ -64,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))

View File

@ -14,8 +14,6 @@ module T = Reducer_Expression_T
type errorValue = Reducer_ErrorValue.errorValue type errorValue = Reducer_ErrorValue.errorValue
type t = T.t type t = T.t
exception ErrorException = Reducer_ErrorValue.ErrorException
/* /*
Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus) Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus)
*/ */
@ -101,8 +99,7 @@ module BackCompatible = {
try { try {
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
} catch { } catch {
| ErrorException(e) => Error(e) | exn => Reducer_ErrorValue.fromException(exn)->Error
| _ => raise(ErrorException(RETodo("internal exception")))
} }
} }

View File

@ -18,6 +18,8 @@ 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,
@ -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)
}
}

View File

@ -41,9 +41,5 @@ and checkIfCallable = (evValue: internalExpressionValue) =>
switch evValue { switch evValue {
| IEvCall(_) | IEvLambda(_) => evValue | IEvCall(_) | IEvLambda(_) => evValue
| _ => | _ =>
raise( ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->ErrorValue.toException
ErrorValue.ErrorException(
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)),
),
)
} }

View File

@ -23,7 +23,7 @@ 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 {
raise(ErrorValue.ErrorException(ErrorValue.REArityError(None, parametersLength, argsLength))) ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.toException
} else { } else {
args args
} }
@ -38,7 +38,7 @@ let checkArity = (
let checkIfReduced = (args: list<internalExpressionValue>) => let checkIfReduced = (args: list<internalExpressionValue>) =>
args->Belt.List.reduceReverse(list{}, (acc, arg) => args->Belt.List.reduceReverse(list{}, (acc, arg) =>
switch arg { switch arg {
| IEvSymbol(symbol) => raise(ErrorValue.ErrorException(ErrorValue.RESymbolNotFound(symbol))) | IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->ErrorValue.toException
| _ => list{arg, ...acc} | _ => list{arg, ...acc}
} }
) )
@ -63,7 +63,7 @@ let caseNotFFI = (
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => { let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
switch ffiFn(args->Belt.List.toArray, accessors.environment) { switch ffiFn(args->Belt.List.toArray, accessors.environment) {
| Ok(value) => value | Ok(value) => value
| Error(value) => raise(ErrorValue.ErrorException(value)) | Error(value) => value->ErrorValue.toException
} }
} }

View File

@ -10,6 +10,23 @@ type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t type internalExpressionValue = InternalExpressionValue.t
type expressionWithContext = ExpressionWithContext.expressionWithContext type expressionWithContext = ExpressionWithContext.expressionWithContext
let expandMacroCallRs = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): result<expressionWithContext, 'e> =>
try {
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression,
bindings,
accessors,
reduceExpression,
)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
let doMacroCall = ( let doMacroCall = (
macroExpression: expression, macroExpression: expression,
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,

View File

@ -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)
}

View File

@ -15,7 +15,7 @@ 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 Bindings.getType(nameSpace, sIndex) { switch Bindings.getType(nameSpace, sIndex) {

View File

@ -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)
}

View File

@ -195,8 +195,7 @@ let doBuildResult = (
try { try {
Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
} catch { } catch {
| Reducer_ErrorValue.ErrorException(e) => e->Error | exn => Reducer_ErrorValue.fromException(exn)->Error
| _ => RETodo("unhandled rescript exception")->Error
} }
), ),
) )