This commit is contained in:
Umur Ozkul 2022-07-05 04:30:08 +02:00
parent c0329dc73d
commit 6edacc78e4
5 changed files with 150 additions and 24 deletions

View File

@ -0,0 +1,94 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionT = Reducer_Expression_T
module Module = Reducer_Module
module Bindings = Reducer_Module
module ErrorValue = Reducer_ErrorValue
open Jest
open Expect
// ----------------------
// --- Start of Module File
// ----------------------
module FooImplementation = {
let fooNumber = 0.0
let fooString = "Foo String"
let fooBool = true
let makeFoo = (a: string, b: string, _environment): string => `I am ${a}-foo and I am ${b}-foo`
let makeBar = (a: float, b: float, _environment): string =>
`I am ${a->Js.Float.toString}-bar and I am ${b->Js.Float.toString}-bar`
}
module FooFFI = {
let makeFoo: ExpressionT.optionFfiFn = (args: array<InternalExpressionValue.t>, environment) => {
switch args {
| [IEvString(a), IEvString(b)] => FooImplementation.makeFoo(a, b, environment)->IEvString->Some
| _ => None
}
}
let makeBar: ExpressionT.optionFfiFn = (args: array<InternalExpressionValue.t>, environment) =>
switch args {
| [IEvNumber(a), IEvNumber(b)] => FooImplementation.makeBar(a, b, environment)->IEvString->Some
| _ => None
}
}
let fooModule: Module.t =
Module.emptyStdLib
->Module.defineNumber("fooNumber", FooImplementation.fooNumber)
->Module.defineString("fooString", FooImplementation.fooString)
->Module.defineBool("fooBool", FooImplementation.fooBool)
->Module.defineFunction("makeFoo", FooFFI.makeFoo)
->Module.defineFunction("makeBar", FooFFI.makeBar)
let makeBindings = (prevBindings: Bindings.t): Bindings.t =>
prevBindings->Module.defineModule("Foo", fooModule)
// ----------------------
// --- End of Module File
// ----------------------
let stdLibWithFoo = Bindings.emptyBindings->makeBindings
let evalWithFoo = sourceCode =>
Reducer_Expression.parse(sourceCode)->Belt.Result.flatMap(expr =>
Reducer_Expression.reduceExpression(
expr,
stdLibWithFoo,
InternalExpressionValue.defaultEnvironment,
)
)
let evalToStringResultWithFoo = sourceCode =>
evalWithFoo(sourceCode)->InternalExpressionValue.toStringResult
describe("Module", () => {
test("fooNumber", () => {
let result = evalToStringResultWithFoo("Foo.fooNumber")
expect(result)->toEqual("Ok(0)")
})
test("fooString", () => {
let result = evalToStringResultWithFoo("Foo.fooString")
expect(result)->toEqual("Ok('Foo String')")
})
test("fooBool", () => {
let result = evalToStringResultWithFoo("Foo.fooBool")
expect(result)->toEqual("Ok(true)")
})
test("fooBool", () => {
let result = evalToStringResultWithFoo("Foo.fooBool")
expect(result)->toEqual("Ok(true)")
})
test("makeFoo", () => {
let result = evalToStringResultWithFoo("Foo.makeFoo('a', 'b')")
expect(result)->toEqual("Ok('I am a-foo and I am b-foo')")
})
test("makeFoo wrong arguments", () => {
let result = evalToStringResultWithFoo("Foo.makeFoo(1, 2)")
// Notice the error with types
expect(result)->toEqual("Error(Function not found: makeFoo(Number,Number))")
})
test("makeBar", () => {
let result = evalToStringResultWithFoo("Foo.makeBar(1, 2)")
expect(result)->toEqual("Ok('I am 1-bar and I am 2-bar')")
})
})

View File

@ -19,6 +19,7 @@ let checkArity = (
lambdaValue: ExpressionValue.lambdaValue, lambdaValue: ExpressionValue.lambdaValue,
args: list<internalExpressionValue>, args: list<internalExpressionValue>,
) => { ) => {
let reallyCheck = {
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 {
@ -27,6 +28,12 @@ let checkArity = (
args->Ok args->Ok
} }
} }
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
switch exprOrFFI {
| NotFFI(_) => reallyCheck
| FFI(_) => args->Ok
}
}
let checkIfReduced = (args: list<internalExpressionValue>) => let checkIfReduced = (args: list<internalExpressionValue>) =>
args->Belt.List.reduceReverse(Ok(list{}), (rAcc, arg) => args->Belt.List.reduceReverse(Ok(list{}), (rAcc, arg) =>

View File

@ -71,6 +71,8 @@ type ffiFn = (
environment, environment,
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue> ) => result<internalExpressionValue, Reducer_ErrorValue.errorValue>
type optionFfiFn = (array<internalExpressionValue>, environment) => option<internalExpressionValue>
type expressionOrFFI = type expressionOrFFI =
| NotFFI(expression) | NotFFI(expression)
| FFI(ffiFn) | FFI(ffiFn)

View File

@ -1,4 +1,6 @@
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue
open ReducerInterface_InternalExpressionValue open ReducerInterface_InternalExpressionValue
let expressionValueToString = toString let expressionValueToString = toString
@ -68,6 +70,7 @@ let set = (nameSpace: t, id: string, value): t => {
} }
let emptyModule: t = NameSpace(emptyMap) let emptyModule: t = NameSpace(emptyMap)
let emptyBindings = emptyModule
let fromTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceFromTypeScriptBindings let fromTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceFromTypeScriptBindings
let toTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceToTypeScriptBindings let toTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceToTypeScriptBindings
@ -110,16 +113,50 @@ let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
}) })
} }
let functionNotFoundError = (call: functionCall) =>
REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
let functionNotFoundErrorFFIFn = (functionName: string): ExpressionT.ffiFn => {
(args: array<internalExpressionValue>, _environment: environment): result<
internalExpressionValue,
errorValue,
> => {
let call = (functionName, args)
functionNotFoundError(call)
}
}
let convertOptionToFfiFn = (
myFunctionName: string,
myFunction: ExpressionT.optionFfiFn,
): ExpressionT.ffiFn => {
(args: array<InternalExpressionValue.t>, environment) => {
myFunction(args, environment)
->Belt.Option.map(v => v->Ok)
->Belt.Option.getWithDefault(functionNotFoundErrorFFIFn(myFunctionName)(args, environment))
}
}
// -- Module definition // -- Module definition
let define = (nameSpace: t, identifier: string, ev: internalExpressionValue): t => { let define = (nameSpace: t, identifier: string, ev: internalExpressionValue): t => {
let NameSpace(container) = nameSpace let NameSpace(container) = nameSpace
Belt.Map.String.set(container, identifier, ev)->NameSpace Belt.Map.String.set(container, identifier, ev)->NameSpace
} }
let defineNumber = (nameSpace: t, identifier: string, value: float): t => let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
nameSpace->define(identifier, IEvNumber(value)) nameSpace->define(identifier, IEvNumber(value))
let defineString = (nameSpace: t, identifier: string, value: string): t =>
nameSpace->define(identifier, IEvString(value))
let defineBool = (nameSpace: t, identifier: string, value: bool): t =>
nameSpace->define(identifier, IEvBool(value))
let defineModule = (nameSpace: t, identifier: string, value: t): t => let defineModule = (nameSpace: t, identifier: string, value: t): t =>
nameSpace->define(identifier, toExpressionValue(value)) nameSpace->define(identifier, toExpressionValue(value))
let defineFFI = (nameSpace: t, identifier: string, value: ExpressionT.ffiFn): t => let defineFunction = (nameSpace: t, identifier: string, value: ExpressionT.optionFfiFn): t => {
nameSpace->define(identifier, value->eLambdaFFIValue) nameSpace->define(identifier, convertOptionToFfiFn(identifier, value)->eLambdaFFIValue)
}
let emptyStdLib: t = emptyModule->defineBool("stdlib", true)

View File

@ -1,25 +1,11 @@
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
open Reducer_ErrorValue // open ReducerInterface_InternalExpressionValue
open ReducerInterface_InternalExpressionValue
type expression = ExpressionT.expression type expression = ExpressionT.expression
let defaultCase = (call: functionCall) =>
REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
let defaultCaseFFIFn = (functionName: string): ExpressionT.ffiFn => {
(args: array<internalExpressionValue>, _environment: environment): result<
internalExpressionValue,
errorValue,
> => {
let call = (functionName, args)
defaultCase(call)
}
}
let defaultCaseFFI = (functionName: string): expression => { let defaultCaseFFI = (functionName: string): expression => {
ExpressionBuilder.eLambdaFFI(defaultCaseFFIFn(functionName)) ExpressionBuilder.eLambdaFFI(Reducer_Module.functionNotFoundErrorFFIFn(functionName))
} }
let addGuard = ( let addGuard = (