WIP (basic functionality, stdlib not converted yet)

This commit is contained in:
Vyacheslav Matyukhin 2022-09-11 19:22:07 +04:00
parent fe56e81710
commit 7a29be3845
No known key found for this signature in database
GPG Key ID: 3D2A774C5489F96C
70 changed files with 2472 additions and 2614 deletions

View File

@ -7,21 +7,21 @@ open Expect
open Expect.Operators
describe("Name Space", () => {
let value = InternalExpressionValue.IEvNumber(1967.0)
let nameSpace = Bindings.emptyNameSpace->Bindings.set("value", value)
let value = Reducer_T.IEvNumber(1967.0)
let nameSpace = Bindings.makeEmptyBindings()->Bindings.set("value", value)
test("get", () => {
expect(Bindings.get(nameSpace, "value")) == Some(value)
})
test("chain and get", () => {
let mainNameSpace = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
let mainNameSpace = Bindings.makeEmptyBindings()->Bindings.chainTo([nameSpace])
expect(Bindings.get(mainNameSpace, "value")) == Some(value)
})
test("chain and set", () => {
let mainNameSpace0 = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
let mainNameSpace0 = Bindings.makeEmptyBindings()->Bindings.chainTo([nameSpace])
let mainNameSpace =
mainNameSpace0->Bindings.set("value", InternalExpressionValue.IEvNumber(1968.0))
expect(Bindings.get(mainNameSpace, "value")) == Some(InternalExpressionValue.IEvNumber(1968.0))
mainNameSpace0->Bindings.set("value", Reducer_T.IEvNumber(1968.0))
expect(Bindings.get(mainNameSpace, "value")) == Some(Reducer_T.IEvNumber(1968.0))
})
})

View File

@ -1,146 +1,146 @@
open Jest
// open Expect
// open Jest
// // open Expect
open Reducer_Expression_ExpressionBuilder
open Reducer_TestMacroHelpers
module ExpressionT = Reducer_Expression_T
// open Reducer_Expression_ExpressionBuilder
// open Reducer_TestMacroHelpers
// module ExpressionT = Reducer_Expression_T
let exampleExpression = eNumber(1.)
let exampleExpressionY = eSymbol("y")
let exampleStatementY = eLetStatement("y", eNumber(1.))
let exampleStatementX = eLetStatement("y", eSymbol("x"))
let exampleStatementZ = eLetStatement("z", eSymbol("y"))
// let exampleExpression = eNumber(1.)
// let exampleExpressionY = eSymbol("y")
// let exampleStatementY = eLetStatement("y", eNumber(1.))
// let exampleStatementX = eLetStatement("y", eSymbol("x"))
// let exampleStatementZ = eLetStatement("z", eSymbol("y"))
// If it is not a macro then it is not expanded
testMacro([], exampleExpression, "Ok(1)")
// // If it is not a macro then it is not expanded
// testMacro([], exampleExpression, "Ok(1)")
describe("bindStatement", () => {
// A statement is bound by the bindings created by the previous statement
testMacro(
[],
eBindStatement(eBindings([]), exampleStatementY),
"Ok((:$_setBindings_$ @{} :y 1) context: @{})",
)
// Then it answers the bindings for the next statement when reduced
testMacroEval([], eBindStatement(eBindings([]), exampleStatementY), "Ok(@{y: 1})")
// Now let's feed a binding to see what happens
testMacro(
[],
eBindStatement(eBindings([("x", IEvNumber(2.))]), exampleStatementX),
"Ok((:$_setBindings_$ @{x: 2} :y 2) context: @{x: 2})",
)
// An expression does not return a binding, thus error
testMacro([], eBindStatement(eBindings([]), exampleExpression), "Assignment expected")
// When bindings from previous statement are missing the context is injected. This must be the first statement of a block
testMacro(
[("z", IEvNumber(99.))],
eBindStatementDefault(exampleStatementY),
"Ok((:$_setBindings_$ @{z: 99} :y 1) context: @{z: 99})",
)
})
// describe("bindStatement", () => {
// // A statement is bound by the bindings created by the previous statement
// testMacro(
// [],
// eBindStatement(eBindings([]), exampleStatementY),
// "Ok((:$_setBindings_$ @{} :y 1) context: @{})",
// )
// // Then it answers the bindings for the next statement when reduced
// testMacroEval([], eBindStatement(eBindings([]), exampleStatementY), "Ok(@{y: 1})")
// // Now let's feed a binding to see what happens
// testMacro(
// [],
// eBindStatement(eBindings([("x", IEvNumber(2.))]), exampleStatementX),
// "Ok((:$_setBindings_$ @{x: 2} :y 2) context: @{x: 2})",
// )
// // An expression does not return a binding, thus error
// testMacro([], eBindStatement(eBindings([]), exampleExpression), "Assignment expected")
// // When bindings from previous statement are missing the context is injected. This must be the first statement of a block
// testMacro(
// [("z", IEvNumber(99.))],
// eBindStatementDefault(exampleStatementY),
// "Ok((:$_setBindings_$ @{z: 99} :y 1) context: @{z: 99})",
// )
// })
describe("bindExpression", () => {
// x is simply bound in the expression
testMacro(
[],
eBindExpression(eBindings([("x", IEvNumber(2.))]), eSymbol("x")),
"Ok(2 context: @{x: 2})",
)
// When an let statement is the end expression then bindings are returned
testMacro(
[],
eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
"Ok((:$_exportBindings_$ (:$_setBindings_$ @{x: 2} :y 1)) context: @{x: 2})",
)
// Now let's reduce that expression
testMacroEval(
[],
eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
"Ok(@{x: 2,y: 1})",
)
// When bindings are missing the context is injected. This must be the first and last statement of a block
testMacroEval(
[("z", IEvNumber(99.))],
eBindExpressionDefault(exampleStatementY),
"Ok(@{y: 1,z: 99})",
)
})
// describe("bindExpression", () => {
// // x is simply bound in the expression
// testMacro(
// [],
// eBindExpression(eBindings([("x", IEvNumber(2.))]), eSymbol("x")),
// "Ok(2 context: @{x: 2})",
// )
// // When an let statement is the end expression then bindings are returned
// testMacro(
// [],
// eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
// "Ok((:$_exportBindings_$ (:$_setBindings_$ @{x: 2} :y 1)) context: @{x: 2})",
// )
// // Now let's reduce that expression
// testMacroEval(
// [],
// eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
// "Ok(@{x: 2,y: 1})",
// )
// // When bindings are missing the context is injected. This must be the first and last statement of a block
// testMacroEval(
// [("z", IEvNumber(99.))],
// eBindExpressionDefault(exampleStatementY),
// "Ok(@{y: 1,z: 99})",
// )
// })
describe("block", () => {
// Block with a single expression
testMacro([], eBlock(list{exampleExpression}), "Ok((:$$_bindExpression_$$ 1))")
testMacroEval([], eBlock(list{exampleExpression}), "Ok(1)")
// Block with a single statement
testMacro([], eBlock(list{exampleStatementY}), "Ok((:$$_bindExpression_$$ (:$_let_$ :y 1)))")
testMacroEval([], eBlock(list{exampleStatementY}), "Ok(@{y: 1})")
// Block with a statement and an expression
testMacro(
[],
eBlock(list{exampleStatementY, exampleExpressionY}),
"Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) :y))",
)
testMacroEval([], eBlock(list{exampleStatementY, exampleExpressionY}), "Ok(1)")
// Block with a statement and another statement
testMacro(
[],
eBlock(list{exampleStatementY, exampleStatementZ}),
"Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) (:$_let_$ :z :y)))",
)
testMacroEval([], eBlock(list{exampleStatementY, exampleStatementZ}), "Ok(@{y: 1,z: 1})")
// Block inside a block
testMacro([], eBlock(list{eBlock(list{exampleExpression})}), "Ok((:$$_bindExpression_$$ {1}))")
testMacroEval([], eBlock(list{eBlock(list{exampleExpression})}), "Ok(1)")
// Block assigned to a variable
testMacro(
[],
eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
"Ok((:$$_bindExpression_$$ (:$_let_$ :z {{:y}})))",
)
testMacroEval(
[],
eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
"Ok(@{z: :y})",
)
// Empty block
testMacro([], eBlock(list{}), "Ok(:undefined block)") //TODO: should be an error
// :$$_block_$$ (:$$_block_$$ (:$_let_$ :y (:add :x 1)) :y)"
testMacro(
[],
eBlock(list{
eBlock(list{
eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
eSymbol("y"),
}),
}),
"Ok((:$$_bindExpression_$$ {(:$_let_$ :y (:add :x 1)); :y}))",
)
testMacroEval(
[("x", IEvNumber(1.))],
eBlock(list{
eBlock(list{
eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
eSymbol("y"),
}),
}),
"Ok(2)",
)
})
// describe("block", () => {
// // Block with a single expression
// testMacro([], eBlock(list{exampleExpression}), "Ok((:$$_bindExpression_$$ 1))")
// testMacroEval([], eBlock(list{exampleExpression}), "Ok(1)")
// // Block with a single statement
// testMacro([], eBlock(list{exampleStatementY}), "Ok((:$$_bindExpression_$$ (:$_let_$ :y 1)))")
// testMacroEval([], eBlock(list{exampleStatementY}), "Ok(@{y: 1})")
// // Block with a statement and an expression
// testMacro(
// [],
// eBlock(list{exampleStatementY, exampleExpressionY}),
// "Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) :y))",
// )
// testMacroEval([], eBlock(list{exampleStatementY, exampleExpressionY}), "Ok(1)")
// // Block with a statement and another statement
// testMacro(
// [],
// eBlock(list{exampleStatementY, exampleStatementZ}),
// "Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) (:$_let_$ :z :y)))",
// )
// testMacroEval([], eBlock(list{exampleStatementY, exampleStatementZ}), "Ok(@{y: 1,z: 1})")
// // Block inside a block
// testMacro([], eBlock(list{eBlock(list{exampleExpression})}), "Ok((:$$_bindExpression_$$ {1}))")
// testMacroEval([], eBlock(list{eBlock(list{exampleExpression})}), "Ok(1)")
// // Block assigned to a variable
// testMacro(
// [],
// eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
// "Ok((:$$_bindExpression_$$ (:$_let_$ :z {{:y}})))",
// )
// testMacroEval(
// [],
// eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
// "Ok(@{z: :y})",
// )
// // Empty block
// testMacro([], eBlock(list{}), "Ok(:undefined block)") //TODO: should be an error
// // :$$_block_$$ (:$$_block_$$ (:$_let_$ :y (:add :x 1)) :y)"
// testMacro(
// [],
// eBlock(list{
// eBlock(list{
// eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
// eSymbol("y"),
// }),
// }),
// "Ok((:$$_bindExpression_$$ {(:$_let_$ :y (:add :x 1)); :y}))",
// )
// testMacroEval(
// [("x", IEvNumber(1.))],
// eBlock(list{
// eBlock(list{
// eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
// eSymbol("y"),
// }),
// }),
// "Ok(2)",
// )
// })
describe("lambda", () => {
// assign a lambda to a variable
let lambdaExpression = eFunction("$$_lambda_$$", list{eArrayString(["y"]), exampleExpressionY})
testMacro([], lambdaExpression, "Ok(lambda(y=>internal code))")
// call a lambda
let callLambdaExpression = list{lambdaExpression, eNumber(1.)}->ExpressionT.EList
testMacro([], callLambdaExpression, "Ok(((:$$_lambda_$$ [y] :y) 1))")
testMacroEval([], callLambdaExpression, "Ok(1)")
// Parameters shadow the outer scope
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(1)")
// When not shadowed by the parameters, the outer scope variables are available
let lambdaExpression = eFunction(
"$$_lambda_$$",
list{eArrayString(["z"]), eFunction("add", list{eSymbol("y"), eSymbol("z")})},
)
let callLambdaExpression = eList(list{lambdaExpression, eNumber(1.)})
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(667)")
})
// describe("lambda", () => {
// // assign a lambda to a variable
// let lambdaExpression = eFunction("$$_lambda_$$", list{eArrayString(["y"]), exampleExpressionY})
// testMacro([], lambdaExpression, "Ok(lambda(y=>internal code))")
// // call a lambda
// let callLambdaExpression = list{lambdaExpression, eNumber(1.)}->ExpressionT.EList
// testMacro([], callLambdaExpression, "Ok(((:$$_lambda_$$ [y] :y) 1))")
// testMacroEval([], callLambdaExpression, "Ok(1)")
// // Parameters shadow the outer scope
// testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(1)")
// // When not shadowed by the parameters, the outer scope variables are available
// let lambdaExpression = eFunction(
// "$$_lambda_$$",
// list{eArrayString(["z"]), eFunction("add", list{eSymbol("y"), eSymbol("z")})},
// )
// let callLambdaExpression = eList(list{lambdaExpression, eNumber(1.)})
// testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(667)")
// })

View File

@ -1,17 +1,17 @@
// Reducer_Helpers
module ErrorValue = Reducer_ErrorValue
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
module Bindings = Reducer_Bindings
let removeDefaultsInternal = (iev: InternalExpressionValue.t) => {
switch iev {
| InternalExpressionValue.IEvBindings(nameSpace) =>
Bindings.removeOther(
nameSpace,
ReducerInterface.StdLib.internalStdLib,
)->InternalExpressionValue.IEvBindings
| value => value
}
Not_found->raise
// switch iev {
// | Reducer_T.IEvBindings(nameSpace) =>
// Reducer_Bindings.removeOther(
// nameSpace,
// ReducerInterface.StdLib.internalStdLib,
// )->Reducer_T.IEvBindings
// | value => value
// }
}
let rRemoveDefaultsInternal = r => Belt.Result.map(r, removeDefaultsInternal)

View File

@ -9,7 +9,7 @@ open Expect
let unwrapRecord = rValue =>
rValue->Belt.Result.flatMap(value =>
switch value {
| InternalExpressionValue.IEvRecord(aRecord) => Ok(aRecord)
| Reducer_T.IEvRecord(aRecord) => Ok(aRecord)
| _ => ErrorValue.RETodo("TODO: Internal bindings must be returned")->Error
}
)

View File

@ -1,90 +1,89 @@
open Jest
open Expect
// open Jest
// open Expect
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module Expression = Reducer_Expression
module ExpressionWithContext = Reducer_ExpressionWithContext
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
module Macro = Reducer_Expression_Macro
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module T = Reducer_Expression_T
// module BindingsReplacer = Reducer_Expression_BindingsReplacer
// module Expression = Reducer_Expression
// module ExpressionWithContext = Reducer_ExpressionWithContext
// module InternalExpressionValue = ReducerInterface.InternalExpressionValue
// module Macro = Reducer_Expression_Macro
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module T = Reducer_Expression_T
let testMacro_ = (
tester,
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedCode: string,
) => {
let bindings = Bindings.fromArray(bindArray)
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)
}
// let testMacro_ = (
// tester,
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedCode: string,
// ) => {
// let bindings = Reducer_Bindings.fromArray(bindArray)
// 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)
})
}
// result->ExpressionWithContext.toStringResult->expect->toEqual(expectedCode)
// })
// }
let testMacroEval_ = (
tester,
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedValue: string,
) => {
let bindings = Bindings.fromArray(bindArray)
tester(expr->T.toString, () =>
expr
->Macro.doMacroCall(
bindings,
ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject,
)
->Ok
->InternalExpressionValue.toStringResult
->expect
->toEqual(expectedValue)
)
}
// let testMacroEval_ = (
// tester,
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedValue: string,
// ) => {
// let bindings = Reducer_Bindings.fromArray(bindArray)
// tester(expr->T.toString, () =>
// expr
// ->Macro.doMacroCall(
// bindings,
// ProjectAccessorsT.identityAccessors,
// Expression.reduceExpressionInProject,
// )
// ->Ok
// ->InternalExpressionValue.toStringResult
// ->expect
// ->toEqual(expectedValue)
// )
// }
let testMacro = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedExpr: string,
) => testMacro_(test, bindArray, expr, expectedExpr)
let testMacroEval = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedValue: string,
) => testMacroEval_(test, bindArray, expr, expectedValue)
// let testMacro = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedExpr: string,
// ) => testMacro_(test, bindArray, expr, expectedExpr)
// let testMacroEval = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedValue: string,
// ) => testMacroEval_(test, bindArray, expr, expectedValue)
module MySkip = {
let testMacro = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedExpr: string,
) => testMacro_(Skip.test, bindArray, expr, expectedExpr)
let testMacroEval = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedValue: string,
) => testMacroEval_(Skip.test, bindArray, expr, expectedValue)
}
// module MySkip = {
// let testMacro = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedExpr: string,
// ) => testMacro_(Skip.test, bindArray, expr, expectedExpr)
// let testMacroEval = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedValue: string,
// ) => testMacroEval_(Skip.test, bindArray, expr, expectedValue)
// }
module MyOnly = {
let testMacro = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedExpr: string,
) => testMacro_(Only.test, bindArray, expr, expectedExpr)
let testMacroEval = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedValue: string,
) => testMacroEval_(Only.test, bindArray, expr, expectedValue)
}
// module MyOnly = {
// let testMacro = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedExpr: string,
// ) => testMacro_(Only.test, bindArray, expr, expectedExpr)
// let testMacroEval = (
// bindArray: array<(string, InternalExpressionValue.t)>,
// expr: T.expression,
// expectedValue: string,
// ) => testMacroEval_(Only.test, bindArray, expr, expectedValue)
// }

View File

@ -1,52 +1,52 @@
module Expression = Reducer_Expression
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Bindings = Reducer_Bindings
module T = Reducer_Type_T
module TypeCompile = Reducer_Type_Compile
// module Expression = Reducer_Expression
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module Bindings = Reducer_Bindings
// module T = Reducer_Type_T
// module TypeCompile = Reducer_Type_Compile
open Jest
open Expect
// open Jest
// open Expect
let myIevEval = (aTypeSourceCode: string) =>
TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
let myIevEvalToString = (aTypeSourceCode: string) =>
myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
// let myIevEval = (aTypeSourceCode: string) =>
// TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
// let myIevEvalToString = (aTypeSourceCode: string) =>
// myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
let myIevExpectEqual = (aTypeSourceCode, answer) =>
expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
// let myIevExpectEqual = (aTypeSourceCode, answer) =>
// expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
let myIevTest = (test, aTypeSourceCode, answer) =>
test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
// let myIevTest = (test, aTypeSourceCode, answer) =>
// test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
let myTypeEval = (aTypeSourceCode: string) =>
TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
// let myTypeEval = (aTypeSourceCode: string) =>
// TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
// let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
let myTypeExpectEqual = (aTypeSourceCode, answer) =>
expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
// let myTypeExpectEqual = (aTypeSourceCode, answer) =>
// expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
let myTypeTest = (test, aTypeSourceCode, answer) =>
test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
// let myTypeTest = (test, aTypeSourceCode, answer) =>
// test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
// | ItTypeIdentifier(string)
myTypeTest(test, "number", "number")
myTypeTest(test, "(number)", "number")
// | ItModifiedType({modifiedType: iType})
myIevTest(test, "number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
myTypeTest(test, "number<-min(0)", "number<-min(0)")
// | ItTypeOr({typeOr: array<iType>})
myTypeTest(test, "number | string", "(number | string)")
// | ItTypeFunction({inputs: array<iType>, output: iType})
myTypeTest(test, "number => number => number", "(number => number => number)")
// | ItTypeArray({element: iType})
myIevTest(test, "[number]", "Ok({element: #number,typeTag: 'typeArray'})")
myTypeTest(test, "[number]", "[number]")
// | ItTypeTuple({elements: array<iType>})
myTypeTest(test, "[number, string]", "[number, string]")
// | ItTypeRecord({properties: Belt.Map.String.t<iType>})
myIevTest(
test,
"{age: number, name: string}",
"Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
)
myTypeTest(test, "{age: number, name: string}", "{age: number, name: string}")
// // | ItTypeIdentifier(string)
// myTypeTest(test, "number", "number")
// myTypeTest(test, "(number)", "number")
// // | ItModifiedType({modifiedType: iType})
// myIevTest(test, "number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
// myTypeTest(test, "number<-min(0)", "number<-min(0)")
// // | ItTypeOr({typeOr: array<iType>})
// myTypeTest(test, "number | string", "(number | string)")
// // | ItTypeFunction({inputs: array<iType>, output: iType})
// myTypeTest(test, "number => number => number", "(number => number => number)")
// // | ItTypeArray({element: iType})
// myIevTest(test, "[number]", "Ok({element: #number,typeTag: 'typeArray'})")
// myTypeTest(test, "[number]", "[number]")
// // | ItTypeTuple({elements: array<iType>})
// myTypeTest(test, "[number, string]", "[number, string]")
// // | ItTypeRecord({properties: Belt.Map.String.t<iType>})
// myIevTest(
// test,
// "{age: number, name: string}",
// "Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
// )
// myTypeTest(test, "{age: number, name: string}", "{age: number, name: string}")

View File

@ -1,42 +1,42 @@
module Bindings = Reducer_Bindings
module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module T = Reducer_Type_T
module TypeChecker = Reducer_Type_TypeChecker
// module Bindings = Reducer_Bindings
// module ErrorValue = Reducer_ErrorValue
// module Expression = Reducer_Expression
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module T = Reducer_Type_T
// module TypeChecker = Reducer_Type_TypeChecker
open Jest
open Expect
// open Jest
// open Expect
let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
'v,
ErrorValue.t,
> => {
let reducerFn = Expression.reduceExpressionInProject
let rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
)
rResult->Belt.Result.flatMap(result =>
switch result {
| IEvArray(args) => TypeChecker.checkArguments(aTypeSourceCode, args, reducerFn)
| _ => Js.Exn.raiseError("Arguments has to be an array")
}
)
}
// let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
// 'v,
// ErrorValue.t,
// > => {
// let reducerFn = Expression.reduceExpressionInProject
// let rResult =
// Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
// reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
// )
// rResult->Belt.Result.flatMap(result =>
// switch result {
// | IEvArray(args) => TypeChecker.checkArguments(aTypeSourceCode, args, reducerFn)
// | _ => Js.Exn.raiseError("Arguments has to be an array")
// }
// )
// }
let myCheckArguments = (aTypeSourceCode: string, sourceCode: string): string =>
switch checkArgumentsSourceCode(aTypeSourceCode, sourceCode) {
| Ok(_) => "Ok"
| Error(error) => ErrorValue.errorToString(error)
}
// let myCheckArguments = (aTypeSourceCode: string, sourceCode: string): string =>
// switch checkArgumentsSourceCode(aTypeSourceCode, sourceCode) {
// | Ok(_) => "Ok"
// | Error(error) => ErrorValue.errorToString(error)
// }
let myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
// let myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
// expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
let myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
// let myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
// test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
myCheckArgumentsTest(test, "number=>number=>number", "[1,2]", "Ok")
// myCheckArgumentsTest(test, "number=>number=>number", "[1,2]", "Ok")

View File

@ -1,73 +1,73 @@
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module ErrorValue = Reducer_ErrorValue
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Bindings = Reducer_Bindings
module T = Reducer_Type_T
module TypeChecker = Reducer_Type_TypeChecker
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module Expression = Reducer_Expression
// module ExpressionT = Reducer_Expression_T
// module ErrorValue = Reducer_ErrorValue
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module Bindings = Reducer_Bindings
// module T = Reducer_Type_T
// module TypeChecker = Reducer_Type_TypeChecker
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
open Jest
open Expect
// open Jest
// open Expect
// In development, you are expected to use TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn).
// isTypeOfSourceCode is written to use strings instead of expression values.
// // In development, you are expected to use TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn).
// // isTypeOfSourceCode is written to use strings instead of expression values.
let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
'v,
ErrorValue.t,
> => {
let reducerFn = Expression.reduceExpressionInProject
let rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
)
rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
}
// let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
// 'v,
// ErrorValue.t,
// > => {
// let reducerFn = Expression.reduceExpressionInProject
// let rResult =
// Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
// reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
// )
// rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
// }
let myTypeCheck = (aTypeSourceCode: string, sourceCode: string): string =>
switch isTypeOfSourceCode(aTypeSourceCode, sourceCode) {
| Ok(_) => "Ok"
| Error(error) => ErrorValue.errorToString(error)
}
// let myTypeCheck = (aTypeSourceCode: string, sourceCode: string): string =>
// switch isTypeOfSourceCode(aTypeSourceCode, sourceCode) {
// | Ok(_) => "Ok"
// | Error(error) => ErrorValue.errorToString(error)
// }
let myTypeCheckExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
expect(myTypeCheck(aTypeSourceCode, sourceCode))->toEqual(answer)
// let myTypeCheckExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
// expect(myTypeCheck(aTypeSourceCode, sourceCode))->toEqual(answer)
let myTypeCheckTest = (test, aTypeSourceCode, sourceCode, answer) =>
test(aTypeSourceCode, () => myTypeCheckExpectEqual(aTypeSourceCode, sourceCode, answer))
// let myTypeCheckTest = (test, aTypeSourceCode, sourceCode, answer) =>
// test(aTypeSourceCode, () => myTypeCheckExpectEqual(aTypeSourceCode, sourceCode, answer))
myTypeCheckTest(test, "number", "1", "Ok")
myTypeCheckTest(test, "number", "'2'", "Expected type: number but got: '2'")
myTypeCheckTest(test, "string", "3", "Expected type: string but got: 3")
myTypeCheckTest(test, "string", "'a'", "Ok")
myTypeCheckTest(test, "[number]", "[1,2,3]", "Ok")
myTypeCheckTest(test, "[number]", "['a','a','a']", "Expected type: number but got: 'a'")
myTypeCheckTest(test, "[number]", "[1,'a',3]", "Expected type: number but got: 'a'")
myTypeCheckTest(test, "[number, string]", "[1,'a']", "Ok")
myTypeCheckTest(test, "[number, string]", "[1, 2]", "Expected type: string but got: 2")
myTypeCheckTest(
test,
"[number, string, string]",
"[1,'a']",
"Expected type: [number, string, string] but got: [1,'a']",
)
myTypeCheckTest(
test,
"[number, string]",
"[1,'a', 3]",
"Expected type: [number, string] but got: [1,'a',3]",
)
myTypeCheckTest(test, "{age: number, name: string}", "{age: 1, name: 'a'}", "Ok")
myTypeCheckTest(
test,
"{age: number, name: string}",
"{age: 1, name: 'a', job: 'IT'}",
"Expected type: {age: number, name: string} but got: {age: 1,job: 'IT',name: 'a'}",
)
myTypeCheckTest(test, "number | string", "1", "Ok")
myTypeCheckTest(test, "date | string", "1", "Expected type: (date | string) but got: 1")
myTypeCheckTest(test, "number<-min(10)", "10", "Ok")
myTypeCheckTest(test, "number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")
myTypeCheckTest(test, "any", "0", "Ok")
myTypeCheckTest(test, "any", "'a'", "Ok")
// myTypeCheckTest(test, "number", "1", "Ok")
// myTypeCheckTest(test, "number", "'2'", "Expected type: number but got: '2'")
// myTypeCheckTest(test, "string", "3", "Expected type: string but got: 3")
// myTypeCheckTest(test, "string", "'a'", "Ok")
// myTypeCheckTest(test, "[number]", "[1,2,3]", "Ok")
// myTypeCheckTest(test, "[number]", "['a','a','a']", "Expected type: number but got: 'a'")
// myTypeCheckTest(test, "[number]", "[1,'a',3]", "Expected type: number but got: 'a'")
// myTypeCheckTest(test, "[number, string]", "[1,'a']", "Ok")
// myTypeCheckTest(test, "[number, string]", "[1, 2]", "Expected type: string but got: 2")
// myTypeCheckTest(
// test,
// "[number, string, string]",
// "[1,'a']",
// "Expected type: [number, string, string] but got: [1,'a']",
// )
// myTypeCheckTest(
// test,
// "[number, string]",
// "[1,'a', 3]",
// "Expected type: [number, string] but got: [1,'a',3]",
// )
// myTypeCheckTest(test, "{age: number, name: string}", "{age: 1, name: 'a'}", "Ok")
// myTypeCheckTest(
// test,
// "{age: number, name: string}",
// "{age: 1, name: 'a', job: 'IT'}",
// "Expected type: {age: number, name: string} but got: {age: 1,job: 'IT',name: 'a'}",
// )
// myTypeCheckTest(test, "number | string", "1", "Ok")
// myTypeCheckTest(test, "date | string", "1", "Expected type: (date | string) but got: 1")
// myTypeCheckTest(test, "number<-min(10)", "10", "Ok")
// myTypeCheckTest(test, "number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")
// myTypeCheckTest(test, "any", "0", "Ok")
// myTypeCheckTest(test, "any", "'a'", "Ok")

View File

@ -1,127 +1,126 @@
open Jest
open Expect
// open Jest
// open Expect
module DispatchT = Reducer_Dispatch_T
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module TypeChecker = Reducer_Type_TypeChecker
module TypeCompile = Reducer_Type_Compile
// module DispatchT = Reducer_Dispatch_T
// module Expression = Reducer_Expression
// module ExpressionT = Reducer_Expression_T
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module TypeChecker = Reducer_Type_TypeChecker
// module TypeCompile = Reducer_Type_Compile
open ReducerInterface_InternalExpressionValue
// open ReducerInterface_InternalExpressionValue
type errorValue = Reducer_ErrorValue.errorValue
// type errorValue = Reducer_ErrorValue.errorValue
// Let's build a function to replace switch statements
// In dispatchChainPiece, we execute an return the result of execution if there is a type match.
// Otherwise we return None so that the call chain can continue.
// So we want to build a function like
// dispatchChainPiece = (call: functionCall, accessors): option<result<internalExpressionValue, errorValue>>
// Use accessors.environment to get the environment finally.
// // Let's build a function to replace switch statements
// // In dispatchChainPiece, we execute an return the result of execution if there is a type match.
// // Otherwise we return None so that the call chain can continue.
// // So we want to build a function like
// // dispatchChainPiece = (call: functionCall, accessors): option<result<internalExpressionValue, errorValue>>
// // Use accessors.environment to get the environment finally.
// Now lets make the dispatchChainPiece itself.
// Note that I am not passing the reducer to the dispatchChainPiece as an argument because it is in the context anyway.
// Keep in mind that reducerFn is necessary for map/reduce so dispatchChainPiece should have a reducerFn in context.
// // Now lets make the dispatchChainPiece itself.
// // Note that I am not passing the reducer to the dispatchChainPiece as an argument because it is in the context anyway.
// // Keep in mind that reducerFn is necessary for map/reduce so dispatchChainPiece should have a reducerFn in context.
let makeMyDispatchChainPiece = (reducer: ProjectReducerFnT.t): DispatchT.dispatchChainPiece => {
// Let's have a pure implementations
module Implementation = {
let stringConcat = (a: string, b: string): string => Js.String2.concat(a, b)
let arrayConcat = (
a: Js.Array2.t<internalExpressionValue>,
b: Js.Array2.t<internalExpressionValue>,
): Js.Array2.t<internalExpressionValue> => Js.Array2.concat(a, b)
let plot = _r => "yey, plotted"
}
// let makeMyDispatchChainPiece = (reducer: Reducer_T.reducerFn): DispatchT.dispatchChainPiece => {
// // Let's have a pure implementations
// module Implementation = {
// let stringConcat = (a: string, b: string): string => Js.String2.concat(a, b)
// let arrayConcat = (
// a: Js.Array2.t<internalExpressionValue>,
// b: Js.Array2.t<internalExpressionValue>,
// ): Js.Array2.t<internalExpressionValue> => Js.Array2.concat(a, b)
// let plot = _r => "yey, plotted"
// }
let extractStringString = args =>
switch args {
| [IEvString(a), IEvString(b)] => (a, b)
| _ => raise(Reducer_Exception.ImpossibleException("extractStringString developer error"))
}
// let extractStringString = args =>
// switch args {
// | [IEvString(a), IEvString(b)] => (a, b)
// | _ => raise(Reducer_Exception.ImpossibleException("extractStringString developer error"))
// }
let extractArrayArray = args =>
switch args {
| [IEvArray(a), IEvArray(b)] => (a, b)
| _ => raise(Reducer_Exception.ImpossibleException("extractArrayArray developer error"))
}
// let extractArrayArray = args =>
// switch args {
// | [IEvArray(a), IEvArray(b)] => (a, b)
// | _ => raise(Reducer_Exception.ImpossibleException("extractArrayArray developer error"))
// }
// Let's bridge the pure implementation to expression values
module Bridge = {
let stringConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
let (a, b) = extractStringString(args)
Implementation.stringConcat(a, b)->IEvString->Ok
}
let arrayConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
let (a, b) = extractArrayArray(args)
Implementation.arrayConcat(a, b)->IEvArray->Ok
}
let plot: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
switch args {
// Just assume that we are doing the business of extracting and converting the deep record
| [IEvRecord(_)] => Implementation.plot({"title": "This is a plot"})->IEvString->Ok
| _ => raise(Reducer_Exception.ImpossibleException("plot developer error"))
}
}
}
// // Let's bridge the pure implementation to expression values
// module Bridge = {
// let stringConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
// let (a, b) = extractStringString(args)
// Implementation.stringConcat(a, b)->IEvString->Ok
// }
// let arrayConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
// let (a, b) = extractArrayArray(args)
// Implementation.arrayConcat(a, b)->IEvArray->Ok
// }
// let plot: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
// switch args {
// // Just assume that we are doing the business of extracting and converting the deep record
// | [IEvRecord(_)] => Implementation.plot({"title": "This is a plot"})->IEvString->Ok
// | _ => raise(Reducer_Exception.ImpossibleException("plot developer error"))
// }
// }
// }
// concat functions are to illustrate polymoprhism. And the plot function is to illustrate complex types
let jumpTable = [
(
"concat",
TypeCompile.fromTypeExpressionExn("string=>string=>string", reducer),
Bridge.stringConcat,
),
(
"concat",
TypeCompile.fromTypeExpressionExn("[any]=>[any]=>[any]", reducer),
Bridge.arrayConcat,
),
(
"plot",
TypeCompile.fromTypeExpressionExn(
// Nested complex types are available
// records {property: type}
// arrays [type]
// tuples [type, type]
// <- type contracts are available naturally and they become part of dispatching
// Here we are not enumerating the possibilities because type checking has a dedicated test
"{title: string, line: {width: number, color: string}}=>string",
reducer,
),
Bridge.plot,
),
]
// // concat functions are to illustrate polymoprhism. And the plot function is to illustrate complex types
// let jumpTable = [
// (
// "concat",
// TypeCompile.fromTypeExpressionExn("string=>string=>string", reducer),
// Bridge.stringConcat,
// ),
// (
// "concat",
// TypeCompile.fromTypeExpressionExn("[any]=>[any]=>[any]", reducer),
// Bridge.arrayConcat,
// ),
// (
// "plot",
// TypeCompile.fromTypeExpressionExn(
// // Nested complex types are available
// // records {property: type}
// // arrays [type]
// // tuples [type, type]
// // <- type contracts are available naturally and they become part of dispatching
// // Here we are not enumerating the possibilities because type checking has a dedicated test
// "{title: string, line: {width: number, color: string}}=>string",
// reducer,
// ),
// Bridge.plot,
// ),
// ]
//Here we are creating a dispatchChainPiece function that will do the actual dispatch from the jumpTable
Reducer_Dispatch_ChainPiece.makeFromTypes(jumpTable)
}
// //Here we are creating a dispatchChainPiece function that will do the actual dispatch from the jumpTable
// Reducer_Dispatch_ChainPiece.makeFromTypes(jumpTable)
// }
// And finally, let's write a library dispatch for our external library
// Exactly the same as the one used in real life
let _dispatch = (
call: functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
chain,
): result<internalExpressionValue, 'e> => {
let dispatchChainPiece = makeMyDispatchChainPiece(reducer)
dispatchChainPiece(call, accessors)->E.O2.defaultFn(() => chain(call, accessors, reducer))
}
// // And finally, let's write a library dispatch for our external library
// // Exactly the same as the one used in real life
// let _dispatch = (
// call: functionCall,
// accessors: ProjectAccessorsT.t,
// reducer: Reducer_T.reducerFn,
// chain,
// ): result<internalExpressionValue, 'e> => {
// let dispatchChainPiece = makeMyDispatchChainPiece(reducer)
// dispatchChainPiece(call, accessors)->E.O2.defaultFn(() => chain(call, accessors, reducer))
// }
// What is important about this implementation?
// A) Exactly the same function jump table can be used to create type guarded lambda functions
// Guarded lambda functions will be the basis of the next version of Squiggle
// B) Complicated recursive record types are not a problem.
// // What is important about this implementation?
// // A) Exactly the same function jump table can be used to create type guarded lambda functions
// // Guarded lambda functions will be the basis of the next version of Squiggle
// // B) Complicated recursive record types are not a problem.
describe("Type Dispatch", () => {
let reducerFn = Expression.reduceExpressionInProject
let dispatchChainPiece = makeMyDispatchChainPiece(reducerFn)
test("stringConcat", () => {
let call: functionCall = ("concat", [IEvString("hello"), IEvString("world")])
// describe("Type Dispatch", () => {
// let reducerFn = Expression.reduceExpressionInProject
// let dispatchChainPiece = makeMyDispatchChainPiece(reducerFn)
// test("stringConcat", () => {
// let call: functionCall = ("concat", [IEvString("hello"), IEvString("world")])
let result = dispatchChainPiece(call, ProjectAccessorsT.identityAccessors)
expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
})
})
// let result = dispatchChainPiece(call, ProjectAccessorsT.identityAccessors)
// expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
// })
// })

View File

@ -1,121 +1,121 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
// @@warning("-44")
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module Project = ForTS_ReducerProject
// module Bindings = Reducer_Bindings
open Jest
open Expect
open Expect.Operators
// open Jest
// open Expect
// open Expect.Operators
describe("Parse includes", () => {
let project = Project.createProject()
Project.setSource(
project,
"main",
`
#include 'common'
x=1`,
)
Project.parseIncludes(project, "main")
test("dependencies", () => {
expect(Project.getDependencies(project, "main")) == ["common"]
})
test("dependents", () => {
expect(Project.getDependents(project, "main")) == []
})
test("getIncludes", () => {
let mainIncludes = Project.getIncludes(project, "main")
switch mainIncludes {
| Ok(includes) => expect(includes) == ["common"]
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
}
})
let internalProject = project->Project.T.Private.castToInternalProject
test("past chain", () => {
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
})
test("import as variables", () => {
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == []
})
})
// describe("Parse includes", () => {
// let project = Project.createProject()
// Project.setSource(
// project,
// "main",
// `
// #include 'common'
// x=1`,
// )
// Project.parseIncludes(project, "main")
// test("dependencies", () => {
// expect(Project.getDependencies(project, "main")) == ["common"]
// })
// test("dependents", () => {
// expect(Project.getDependents(project, "main")) == []
// })
// test("getIncludes", () => {
// let mainIncludes = Project.getIncludes(project, "main")
// switch mainIncludes {
// | Ok(includes) => expect(includes) == ["common"]
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
// }
// })
// let internalProject = project->Project.T.Private.castToInternalProject
// test("past chain", () => {
// expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
// })
// test("import as variables", () => {
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == []
// })
// })
describe("Parse includes", () => {
let project = Project.createProject()
Project.setSource(
project,
"main",
`
#include 'common'
#include 'myModule' as myVariable
x=1`,
)
Project.parseIncludes(project, "main")
// describe("Parse includes", () => {
// let project = Project.createProject()
// Project.setSource(
// project,
// "main",
// `
// #include 'common'
// #include 'myModule' as myVariable
// x=1`,
// )
// Project.parseIncludes(project, "main")
test("dependencies", () => {
expect(Project.getDependencies(project, "main")) == ["common", "myModule"]
})
// test("dependencies", () => {
// expect(Project.getDependencies(project, "main")) == ["common", "myModule"]
// })
test("dependents", () => {
expect(Project.getDependents(project, "main")) == []
})
// test("dependents", () => {
// expect(Project.getDependents(project, "main")) == []
// })
test("getIncludes", () => {
let mainIncludes = Project.getIncludes(project, "main")
switch mainIncludes {
| Ok(includes) => expect(includes) == ["common", "myModule"]
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
}
})
// test("getIncludes", () => {
// let mainIncludes = Project.getIncludes(project, "main")
// switch mainIncludes {
// | Ok(includes) => expect(includes) == ["common", "myModule"]
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
// }
// })
let internalProject = project->Project.T.Private.castToInternalProject
// let internalProject = project->Project.T.Private.castToInternalProject
test("direct past chain", () => {
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
})
// test("direct past chain", () => {
// expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
// })
test("direct includes", () => {
expect(Project.Private.getDirectIncludes(internalProject, "main")) == ["common"]
})
// test("direct includes", () => {
// expect(Project.Private.getDirectIncludes(internalProject, "main")) == ["common"]
// })
test("include as variables", () => {
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
("myVariable", "myModule"),
]
})
})
// test("include as variables", () => {
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
// ("myVariable", "myModule"),
// ]
// })
// })
describe("Parse multiple direct includes", () => {
let project = Project.createProject()
Project.setSource(
project,
"main",
`
#include 'common'
#include 'common2'
#include 'myModule' as myVariable
x=1`,
)
Project.parseIncludes(project, "main")
test("dependencies", () => {
expect(Project.getDependencies(project, "main")) == ["common", "common2", "myModule"]
})
test("dependents", () => {
expect(Project.getDependents(project, "main")) == []
})
test("getIncludes", () => {
let mainIncludes = Project.getIncludes(project, "main")
switch mainIncludes {
| Ok(includes) => expect(includes) == ["common", "common2", "myModule"]
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
}
})
let internalProject = project->Project.T.Private.castToInternalProject
test("direct past chain", () => {
expect(Project.getPastChain(project, "main")) == ["common", "common2"]
})
test("include as variables", () => {
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
("myVariable", "myModule"),
]
})
})
// describe("Parse multiple direct includes", () => {
// let project = Project.createProject()
// Project.setSource(
// project,
// "main",
// `
// #include 'common'
// #include 'common2'
// #include 'myModule' as myVariable
// x=1`,
// )
// Project.parseIncludes(project, "main")
// test("dependencies", () => {
// expect(Project.getDependencies(project, "main")) == ["common", "common2", "myModule"]
// })
// test("dependents", () => {
// expect(Project.getDependents(project, "main")) == []
// })
// test("getIncludes", () => {
// let mainIncludes = Project.getIncludes(project, "main")
// switch mainIncludes {
// | Ok(includes) => expect(includes) == ["common", "common2", "myModule"]
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
// }
// })
// let internalProject = project->Project.T.Private.castToInternalProject
// test("direct past chain", () => {
// expect(Project.getPastChain(project, "main")) == ["common", "common2"]
// })
// test("include as variables", () => {
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
// ("myVariable", "myModule"),
// ]
// })
// })

View File

@ -23,10 +23,9 @@ let runFetchFlatBindings = (project, sourceId) => {
test("setting continuation", () => {
let project = Project.createProject()
let privateProject = project->Project.T.Private.castToInternalProject
let sampleBindings = Bindings.emptyBindings->Bindings.set("test", IEvVoid)
Project.Private.setContinuation(privateProject, "main", sampleBindings)
let answer = Project.Private.getContinuation(privateProject, "main")
let sampleBindings = Bindings.makeEmptyBindings()->Bindings.set("test", IEvVoid)
ReducerProject.setContinuation(project, "main", sampleBindings)
let answer = ReducerProject.getContinuation(project, "main")
expect(answer)->toBe(sampleBindings)
})
@ -59,7 +58,6 @@ describe("project1", () => {
Project.setSource(project, "first", "x=1")
Project.setSource(project, "main", "x")
Project.setContinues(project, "main", ["first"])
let internalProject = project->Project.T.Private.castToInternalProject
test("runOrder", () => {
expect(Project.getRunOrder(project)) == ["first", "main"]
@ -78,10 +76,10 @@ describe("project1", () => {
})
test("past chain first", () => {
expect(Project.Private.getPastChain(internalProject, "first")) == []
expect(ReducerProject.getPastChain(project, "first")) == []
})
test("past chain main", () => {
expect(Project.Private.getPastChain(internalProject, "main")) == ["first"]
expect(ReducerProject.getPastChain(project, "main")) == ["first"]
})
test("test result", () => {

View File

@ -65,7 +65,7 @@ Case "Running a single source".
/* Now you have external bindings and external result. */
(
result->InternalExpressionValue.toStringResult,
bindings->InternalExpressionValue.IEvBindings->InternalExpressionValue.toString,
bindings->Reducer_T.IEvBindings->InternalExpressionValue.toString,
)->expect == ("Ok(3)", "@{}")
})

View File

@ -62,13 +62,13 @@ export class SqBoolValue extends SqAbstractValue {
}
}
export class SqCallValue extends SqAbstractValue {
tag = Tag.Call as const;
// export class SqCallValue extends SqAbstractValue {
// tag = Tag.Call as const;
get value() {
return this.valueMethod(RSValue.getCall);
}
}
// get value() {
// return this.valueMethod(RSValue.getCall);
// }
// }
export class SqDateValue extends SqAbstractValue {
tag = Tag.Date as const;
@ -134,13 +134,13 @@ export class SqStringValue extends SqAbstractValue {
}
}
export class SqSymbolValue extends SqAbstractValue {
tag = Tag.Symbol as const;
// export class SqSymbolValue extends SqAbstractValue {
// tag = Tag.Symbol as const;
get value(): string {
return this.valueMethod(RSValue.getSymbol);
}
}
// get value(): string {
// return this.valueMethod(RSValue.getSymbol);
// }
// }
export class SqTimeDurationValue extends SqAbstractValue {
tag = Tag.TimeDuration as const;
@ -178,7 +178,7 @@ const tagToClass = {
[Tag.Array]: SqArrayValue,
[Tag.ArrayString]: SqArrayStringValue,
[Tag.Bool]: SqBoolValue,
[Tag.Call]: SqCallValue,
// [Tag.Call]: SqCallValue,
[Tag.Date]: SqDateValue,
[Tag.Declaration]: SqDeclarationValue,
[Tag.Distribution]: SqDistributionValue,
@ -187,7 +187,7 @@ const tagToClass = {
[Tag.Number]: SqNumberValue,
[Tag.Record]: SqRecordValue,
[Tag.String]: SqStringValue,
[Tag.Symbol]: SqSymbolValue,
// [Tag.Symbol]: SqSymbolValue,
[Tag.TimeDuration]: SqTimeDurationValue,
[Tag.Type]: SqTypeValue,
[Tag.TypeIdentifier]: SqTypeIdentifierValue,
@ -200,7 +200,7 @@ export type SqValue =
| SqArrayValue
| SqArrayStringValue
| SqBoolValue
| SqCallValue
// | SqCallValue
| SqDateValue
| SqDeclarationValue
| SqDistributionValue
@ -209,7 +209,7 @@ export type SqValue =
| SqNumberValue
| SqRecordValue
| SqStringValue
| SqSymbolValue
// | SqSymbolValue
| SqTimeDurationValue
| SqTypeValue
| SqTypeIdentifierValue

View File

@ -1,4 +1,4 @@
import { environment } from "../rescript/ForTS/ForTS_ReducerProject.gen";
import { environment } from "../rescript/ForTS/ForTS__Types.gen";
import { SqProject } from "./SqProject";
import { SqValue, SqValueTag } from "./SqValue";
export { SqValueLocation } from "./SqValueLocation";

View File

@ -1,4 +1,4 @@
@genType type reducerProject = ReducerProject_T.t //re-export
@genType type reducerProject = ReducerProject_T.project //re-export
type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
@ -8,7 +8,7 @@ type squiggleValue_Module = ForTS_SquiggleValue_Module.squiggleValue_Module //us
type environment = ForTS_Distribution_Environment.environment //use
module T = ReducerProject_T
module Private = ReducerProject.Private
module Private = ReducerProject
/*
PUBLIC FUNCTIONS
@ -35,35 +35,35 @@ A project has a public field tag with a constant value "reducerProject"
project = {tag: "reducerProject"}
*/
@genType
let createProject = (): reducerProject => Private.createProject()->T.Private.castFromInternalProject
let createProject = (): reducerProject => Private.createProject()
/*
Answer all the source ids of all the sources in the project.
*/
@genType
let getSourceIds = (project: reducerProject): array<string> =>
project->T.Private.castToInternalProject->Private.getSourceIds
project->Private.getSourceIds
/*
Sets the source for a given source Id.
*/
@genType
let setSource = (project: reducerProject, sourceId: string, value: string): unit =>
project->T.Private.castToInternalProject->Private.setSource(sourceId, value)
project->Private.setSource(sourceId, value)
/*
Gets the source for a given source id.
*/
@genType
let getSource = (project: reducerProject, sourceId: string): option<string> =>
project->T.Private.castToInternalProject->Private.getSource(sourceId)
project->Private.getSource(sourceId)
/*
Touches the source for a given source id. This and dependent, sources are set to be re-evaluated.
*/
@genType
let touchSource = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.touchSource(sourceId)
project->Private.touchSource(sourceId)
/*
Cleans the compilation artifacts for a given source ID. The results stay untouched, so compilation won't be run again.
@ -72,14 +72,14 @@ Normally, you would never need the compilation artifacts again as the results wi
*/
@genType
let clean = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.clean(sourceId)
project->Private.clean(sourceId)
/*
Cleans all the compilation artifacts in all of the project
*/
@genType
let cleanAll = (project: reducerProject): unit =>
project->T.Private.castToInternalProject->Private.cleanAll
project->Private.cleanAll
/*
Cleans results. Compilation stays untouched to be able to re-run the source.
@ -87,14 +87,14 @@ You would not do this if you were not trying to debug the source code.
*/
@genType
let cleanResults = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.cleanResults(sourceId)
project->Private.cleanResults(sourceId)
/*
Cleans all results. Compilations remains untouched to rerun the source.
*/
@genType
let cleanAllResults = (project: reducerProject): unit =>
project->T.Private.castToInternalProject->Private.cleanAllResults
project->Private.cleanAllResults
/*
To set the includes one first has to call "parseIncludes". The parsed includes or the parser error is returned.
@ -103,19 +103,19 @@ To set the includes one first has to call "parseIncludes". The parsed includes o
let getIncludes = (project: reducerProject, sourceId: string): result<
array<string>,
reducerErrorValue,
> => project->T.Private.castToInternalProject->Private.getIncludes(sourceId)
> => project->Private.getIncludes(sourceId)
/* Other sources contributing to the global namespace of this source. */
@genType
let getPastChain = (project: reducerProject, sourceId: string): array<string> =>
project->T.Private.castToInternalProject->Private.getPastChain(sourceId)
project->Private.getPastChain(sourceId)
/*
Answers the source codes after which this source code is continuing
*/
@genType
let getContinues = (project: reducerProject, sourceId: string): array<string> =>
project->T.Private.castToInternalProject->Private.getContinues(sourceId)
project->Private.getContinues(sourceId)
/*
"continues" acts like hidden includes in the source.
@ -124,35 +124,35 @@ let getContinues = (project: reducerProject, sourceId: string): array<string> =>
*/
@genType
let setContinues = (project: reducerProject, sourceId: string, continues: array<string>): unit =>
project->T.Private.castToInternalProject->Private.setContinues(sourceId, continues)
project->Private.setContinues(sourceId, continues)
/*
This source depends on the array of sources returned.
*/
@genType
let getDependencies = (project: reducerProject, sourceId: string): array<string> =>
project->T.Private.castToInternalProject->Private.getDependencies(sourceId)
project->Private.getDependencies(sourceId)
/*
The sources returned are dependent on this
*/
@genType
let getDependents = (project: reducerProject, sourceId: string): array<string> =>
project->T.Private.castToInternalProject->Private.getDependents(sourceId)
project->Private.getDependents(sourceId)
/*
Get the run order for the sources in the project.
*/
@genType
let getRunOrder = (project: reducerProject): array<string> =>
project->T.Private.castToInternalProject->Private.getRunOrder
project->Private.getRunOrder
/*
Get the run order to get the results of this specific source
*/
@genType
let getRunOrderFor = (project: reducerProject, sourceId: string) =>
project->T.Private.castToInternalProject->Private.getRunOrderFor(sourceId)
project->Private.getRunOrderFor(sourceId)
/*
Parse includes so that you can load them before running.
@ -162,7 +162,7 @@ It is your responsibility to load the includes before running.
@genType
let parseIncludes = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.parseIncludes(sourceId)
project->Private.parseIncludes(sourceId)
/*
Parse the source code if it is not done already.
@ -171,28 +171,28 @@ You would need this function if you want to see the parse tree without running t
*/
@genType
let rawParse = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.rawParse(sourceId)
project->Private.rawParse(sourceId)
/*
Runs a specific source code if it is not done already. The code is parsed if it is not already done. It runs the dependencies if it is not already done.
*/
@genType
let run = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.run(sourceId)
project->Private.run(sourceId)
/*
Runs all of the sources in a project. Their results and bindings will be available
*/
@genType
let runAll = (project: reducerProject): unit =>
project->T.Private.castToInternalProject->Private.runAll
project->Private.runAll
/*
Get the bindings after running this source fil. The bindings are local to the source
*/
@genType
let getBindings = (project: reducerProject, sourceId: string): squiggleValue_Module =>
project->T.Private.castToInternalProject->Private.getBindings(sourceId)
project->Private.getBindings(sourceId)
/*
Get the result after running this source file or the project
@ -201,7 +201,7 @@ Get the result after running this source file or the project
let getResult = (project: reducerProject, sourceId: string): result<
squiggleValue,
reducerErrorValue,
> => project->T.Private.castToInternalProject->Private.getResult(sourceId)
> => project->Private.getResult(sourceId)
/*
This is a convenience function to get the result of a single source without creating a project.
@ -216,7 +216,7 @@ let evaluate = (sourceCode: string): (
@genType
let setEnvironment = (project: reducerProject, environment: environment): unit =>
project->T.Private.castToInternalProject->Private.setEnvironment(environment)
project->Private.setEnvironment(environment)
/*
Foreign function interface is intentionally demolished.

View File

@ -1,10 +1,10 @@
@genType type squiggleValue = ReducerInterface_InternalExpressionValue.t //re-export
@genType type squiggleValue = Reducer_T.value //re-export
type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
@genType type squiggleValue_Array = ReducerInterface_InternalExpressionValue.squiggleArray //re-export recursive type
@genType type squiggleValue_Module = ReducerInterface_InternalExpressionValue.nameSpace //re-export recursive type
@genType type squiggleValue_Record = ReducerInterface_InternalExpressionValue.map //re-export recursive type
@genType type squiggleValue_Type = ReducerInterface_InternalExpressionValue.map //re-export recursive type
@genType type squiggleValue_Array = Reducer_T.arrayValue //re-export recursive type
@genType type squiggleValue_Module = Reducer_T.nameSpace //re-export recursive type
@genType type squiggleValue_Record = Reducer_T.map //re-export recursive type
@genType type squiggleValue_Type = Reducer_T.map //re-export recursive type
type squiggleValue_Declaration = ForTS_SquiggleValue_Declaration.squiggleValue_Declaration //use
type squiggleValue_Distribution = ForTS_SquiggleValue_Distribution.squiggleValue_Distribution //use
type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //use
@ -20,8 +20,8 @@ external svtArrayString_: string = "ArrayString"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtBool_: string = "Bool"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtCall_: string = "Call"
// @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
// external svtCall_: string = "Call"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtDate_: string = "Date"
@ -47,8 +47,8 @@ external svtRecord_: string = "Record"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtString_: string = "String"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtSymbol_: string = "Symbol"
// @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
// external svtSymbol_: string = "Symbol"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtTimeDuration_: string = "TimeDuration"
@ -73,7 +73,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
| IEvArray(_) => svtArray_->castEnum
| IEvArrayString(_) => svtArrayString_->castEnum
| IEvBool(_) => svtBool_->castEnum
| IEvCall(_) => svtCall_->castEnum //Impossible
// | IEvCall(_) => svtCall_->castEnum //Impossible
| IEvDate(_) => svtDate_->castEnum
| IEvDeclaration(_) => svtDeclaration_->castEnum
| IEvDistribution(_) => svtDistribution_->castEnum
@ -82,7 +82,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
| IEvNumber(_) => svtNumber_->castEnum
| IEvRecord(_) => svtRecord_->castEnum
| IEvString(_) => svtString_->castEnum
| IEvSymbol(_) => svtSymbol_->castEnum
// | IEvSymbol(_) => svtSymbol_->castEnum
| IEvTimeDuration(_) => svtTimeDuration_->castEnum
| IEvType(_) => svtType_->castEnum
| IEvTypeIdentifier(_) => svtTypeIdentifier_->castEnum
@ -121,12 +121,12 @@ let getBool = (variant: squiggleValue): option<bool> =>
| _ => None
}
@genType
let getCall = (variant: squiggleValue): option<string> =>
switch variant {
| IEvCall(value) => value->Some
| _ => None
}
// @genType
// let getCall = (variant: squiggleValue): option<string> =>
// switch variant {
// | IEvCall(value) => value->Some
// | _ => None
// }
@genType
let getDate = (variant: squiggleValue): option<Js.Date.t> =>
@ -184,12 +184,12 @@ let getString = (variant: squiggleValue): option<string> =>
| _ => None
}
@genType
let getSymbol = (variant: squiggleValue): option<string> =>
switch variant {
| IEvSymbol(value) => value->Some
| _ => None
}
// @genType
// let getSymbol = (variant: squiggleValue): option<string> =>
// switch variant {
// | IEvSymbol(value) => value->Some
// | _ => None
// }
@genType
let getTimeDuration = (variant: squiggleValue): option<float> =>

View File

@ -1,4 +1,4 @@
@genType type squiggleValue_Declaration = ReducerInterface_InternalExpressionValue.lambdaDeclaration //re-export
@genType type squiggleValue_Declaration = Reducer_T.lambdaDeclaration //re-export
@genType
let toString = (v: squiggleValue_Declaration): string =>

View File

@ -1,4 +1,4 @@
@genType type squiggleValue_Lambda = ReducerInterface_InternalExpressionValue.lambdaValue //re-export
@genType type squiggleValue_Lambda = Reducer_T.lambdaValue //re-export
@genType
let toString = (v: squiggleValue_Lambda): string =>

View File

@ -3,7 +3,7 @@ type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
@genType
let getKeyValuePairs = (v: squiggleValue_Module): array<(string, squiggleValue)> =>
ReducerInterface_InternalExpressionValue.nameSpaceToKeyValuePairs(v)
v->Reducer_Bindings.toKeyValuePairs
@genType
let toString = (v: squiggleValue_Module): string =>
@ -13,4 +13,4 @@ let toString = (v: squiggleValue_Module): string =>
let toSquiggleValue = (v: squiggleValue_Module): squiggleValue => IEvBindings(v)
@genType
let get = Reducer_Bindings.get
let get = (v: squiggleValue_Module, k: string): option<squiggleValue> => Reducer_Bindings.get(v, k)

View File

@ -2,7 +2,7 @@ export enum squiggleValueTag {
Array = "Array",
ArrayString = "ArrayString",
Bool = "Bool",
Call = "Call",
// Call = "Call",
Date = "Date",
Declaration = "Declaration",
Distribution = "Distribution",
@ -11,7 +11,7 @@ export enum squiggleValueTag {
Number = "Number",
Record = "Record",
String = "String",
Symbol = "Symbol",
// Symbol = "Symbol",
TimeDuration = "TimeDuration",
Type = "Type",
TypeIdentifier = "TypeIdentifier",

View File

@ -1,6 +1,4 @@
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
type internalExpressionValue = ReducerInterface_InternalExpressionValue.t
type internalExpressionValue = Reducer_T.value
type internalExpressionValueType = ReducerInterface_InternalExpressionValue.internalExpressionValueType
/*
@ -32,7 +30,7 @@ type rec frValue =
| FRValueArray(array<frValue>)
| FRValueDistOrNumber(frValueDistOrNumber)
| FRValueRecord(frValueRecord)
| FRValueLambda(ReducerInterface_InternalExpressionValue.lambdaValue)
| FRValueLambda(Reducer_T.lambdaValue)
| FRValueString(string)
| FRValueVariant(string)
| FRValueAny(frValue)
@ -48,8 +46,8 @@ type fnDefinition = {
run: (
array<internalExpressionValue>,
array<frValue>,
ProjectAccessorsT.t,
ProjectReducerFnT.t,
Reducer_T.environment,
Reducer_T.reducerFn,
) => result<internalExpressionValue, string>,
}
@ -384,12 +382,12 @@ module FnDefinition = {
let run = (
t: t,
args: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
) => {
let argValues = FRType.matchWithExpressionValueArray(t.inputs, args)
switch argValues {
| Some(values) => t.run(args, values, accessors, reducer)
| Some(values) => t.run(args, values, env, reducer)
| None => Error("Incorrect Types")
}
}
@ -495,8 +493,8 @@ module Registry = {
~registry: registry,
~fnName: string,
~args: array<internalExpressionValue>,
~accessors: ProjectAccessorsT.t,
~reducer: ProjectReducerFnT.t,
~env: Reducer_T.environment,
~reducer: Reducer_T.reducerFn,
) => {
let relevantFunctions = Js.Dict.get(registry.fnNameDict, fnName) |> E.O.default([])
let modified = {functions: relevantFunctions, fnNameDict: registry.fnNameDict}
@ -514,7 +512,7 @@ module Registry = {
switch Matcher.Registry.findMatches(modified, fnName, args) {
| Matcher.Match.FullMatch(match) =>
match->matchToDef->E.O2.fmap(FnDefinition.run(_, args, accessors, reducer))
match->matchToDef->E.O2.fmap(FnDefinition.run(_, args, env, reducer))
| SameNameDifferentArguments(m) => Some(Error(showNameMatchDefinitions(m)))
| _ => None
}
@ -523,10 +521,10 @@ module Registry = {
let dispatch = (
registry,
(fnName, args): ReducerInterface_InternalExpressionValue.functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
) => {
_matchAndRun(~registry, ~fnName, ~args, ~accessors, ~reducer)->E.O2.fmap(
_matchAndRun(~registry, ~fnName, ~args, ~env, ~reducer)->E.O2.fmap(
E.R2.errMap(_, s => Reducer_ErrorValue.RETodo(s)),
)
}

View File

@ -6,11 +6,11 @@ module Wrappers = {
let symbolic = r => DistributionTypes.Symbolic(r)
let pointSet = r => DistributionTypes.PointSet(r)
let sampleSet = r => DistributionTypes.SampleSet(r)
let evDistribution = r => ReducerInterface_InternalExpressionValue.IEvDistribution(r)
let evNumber = r => ReducerInterface_InternalExpressionValue.IEvNumber(r)
let evArray = r => ReducerInterface_InternalExpressionValue.IEvArray(r)
let evRecord = r => ReducerInterface_InternalExpressionValue.IEvRecord(r)
let evString = r => ReducerInterface_InternalExpressionValue.IEvString(r)
let evDistribution = r => Reducer_T.IEvDistribution(r)
let evNumber = r => Reducer_T.IEvNumber(r)
let evArray = r => Reducer_T.IEvArray(r)
let evRecord = r => Reducer_T.IEvRecord(r)
let evString = r => Reducer_T.IEvString(r)
let symbolicEvDistribution = r => r->DistributionTypes.Symbolic->evDistribution
let evArrayOfEvNumber = xs => xs->Belt.Array.map(evNumber)->evArray
}

View File

@ -69,12 +69,12 @@ module Integration = {
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
aLambda,
list{pointAsInternalExpression},
[pointAsInternalExpression],
environment,
reducer,
reducer
)
let result = switch resultAsInternalExpression {
| IEvNumber(x) => Ok(x)
| Reducer_T.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",
@ -132,7 +132,7 @@ module Integration = {
| (Ok(yMin), Ok(yMax)) => {
let result =
(yMin +. yMax) *. weightForAnOuterPoint +. innerPointsSum *. weightForAnInnerPoint
let wrappedResult = result->ReducerInterface_InternalExpressionValue.IEvNumber->Ok
let wrappedResult = result->Reducer_T.IEvNumber->Ok
wrappedResult
}
| (Error(b), _) => Error(b)
@ -273,7 +273,7 @@ module DiminishingReturns = {
funds,
approximateIncrement,
environment,
reducer,
reducer
) => {
switch (
E.A.length(lambdas) > 1,
@ -303,12 +303,12 @@ module DiminishingReturns = {
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
lambda,
list{pointAsInternalExpression},
[pointAsInternalExpression],
environment,
reducer,
reducer
)
switch resultAsInternalExpression {
| IEvNumber(x) => Ok(x)
| Reducer_T.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",
@ -401,7 +401,7 @@ module DiminishingReturns = {
| [IEvArray(innerlambdas), IEvNumber(funds), IEvNumber(approximateIncrement)] => {
let individuallyWrappedLambdas = E.A.fmap(innerLambda => {
switch innerLambda {
| ReducerInterface_InternalExpressionValue.IEvLambda(lambda) => Ok(lambda)
| Reducer_T.IEvLambda(lambda) => Ok(lambda)
| _ =>
Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. A member of the array wasn't a function",

View File

@ -4,7 +4,7 @@ open FunctionRegistry_Helpers
let nameSpace = "Dict"
module Internals = {
type t = ReducerInterface_InternalExpressionValue.map
type t = Reducer_T.map
let keys = (a: t): internalExpressionValue => IEvArray(
Belt.Map.String.keysToArray(a)->E.A2.fmap(Wrappers.evString),

View File

@ -21,8 +21,8 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeDistOrNumber, FRTypeDistOrNumber],
~run=(_, inputs, accessors, _) =>
inputs->Prepare.ToValueTuple.twoDistOrNumber->process(~fn, ~env=accessors.environment),
~run=(_, inputs, env, _) =>
inputs->Prepare.ToValueTuple.twoDistOrNumber->process(~fn, ~env=env),
(),
)
}
@ -31,10 +31,10 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeRecord([("p5", FRTypeDistOrNumber), ("p95", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) =>
~run=(_, inputs, env, _) =>
inputs
->Prepare.ToValueTuple.Record.twoDistOrNumber
->process(~fn, ~env=accessors.environment),
->process(~fn, ~env=env),
(),
)
}
@ -43,10 +43,10 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeRecord([("mean", FRTypeDistOrNumber), ("stdev", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) =>
~run=(_, inputs, env, _) =>
inputs
->Prepare.ToValueTuple.Record.twoDistOrNumber
->process(~fn, ~env=accessors.environment),
->process(~fn, ~env=env),
(),
)
}
@ -62,8 +62,8 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeDistOrNumber],
~run=(_, inputs, accessors, _) =>
inputs->Prepare.ToValueTuple.oneDistOrNumber->process(~fn, ~env=accessors.environment),
~run=(_, inputs, env, _) =>
inputs->Prepare.ToValueTuple.oneDistOrNumber->process(~fn, ~env=env),
(),
)
}

View File

@ -18,7 +18,7 @@ module Declaration = {
inputs
->E.A2.fmap(getMinMax)
->E.A.R.firstErrorOrOpen
->E.R2.fmap(args => ReducerInterface_InternalExpressionValue.IEvDeclaration(
->E.R2.fmap(args => Reducer_T.IEvDeclaration(
Declaration.make(lambda, args),
))
}

View File

@ -1,6 +1,3 @@
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
open FunctionRegistry_Core
open FunctionRegistry_Helpers
@ -29,16 +26,16 @@ module Internals = {
let map = (
array: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
eLambdaValue,
reducer: ProjectReducerFnT.t,
): ReducerInterface_InternalExpressionValue.t => {
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn
): internalExpressionValue => {
let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => {
let newElem = Reducer_Expression_Lambda.doLambdaCall(
eLambdaValue,
list{elem},
(accessors: ProjectAccessorsT.t),
(reducer: ProjectReducerFnT.t),
[elem],
env,
reducer
)
list{newElem, ...acc}
})
@ -49,11 +46,11 @@ module Internals = {
aValueArray,
initialValue,
aLambdaValue,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn
) => {
aValueArray->E.A.reduce(initialValue, (acc, elem) =>
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, [acc, elem], env, reducer)
)
}
@ -61,26 +58,26 @@ module Internals = {
aValueArray,
initialValue,
aLambdaValue,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn
) => {
aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) =>
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, [acc, elem], env, reducer)
)
}
let filter = (
aValueArray,
aLambdaValue,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn
) => {
let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => {
let newElem = Reducer_Expression_Lambda.doLambdaCall(
aLambdaValue,
list{elem},
accessors,
reducer,
[elem],
env,
reducer
)
switch newElem {
| IEvBool(true) => list{elem, ...acc}
@ -201,10 +198,10 @@ let library = [
FnDefinition.make(
~name="map",
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
~run=(inputs, _, env, reducer) =>
switch inputs {
| [IEvArray(array), IEvLambda(lambda)] =>
Ok(Internals.map(array, accessors, lambda, reducer))
Ok(Internals.map(array, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),
@ -221,10 +218,10 @@ let library = [
FnDefinition.make(
~name="reduce",
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
~run=(inputs, _, env, reducer) =>
switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer))
Ok(Internals.reduce(array, initialValue, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),
@ -241,10 +238,10 @@ let library = [
FnDefinition.make(
~name="reduceReverse",
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
~run=(inputs, _, env, reducer) =>
switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer))
Ok(Internals.reduceReverse(array, initialValue, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),
@ -261,10 +258,10 @@ let library = [
FnDefinition.make(
~name="filter",
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
~run=(inputs, _, env, reducer) =>
switch inputs {
| [IEvArray(array), IEvLambda(lambda)] =>
Ok(Internals.filter(array, lambda, accessors, reducer))
Ok(Internals.filter(array, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),

View File

@ -17,7 +17,7 @@ let inputsTodist = (inputs: array<FunctionRegistry_Core.frValue>, makeDist) => {
let expressionValue =
xyCoords
->E.R.bind(r => r->XYShape.T.makeFromZipped->E.R2.errMap(XYShape.Error.toString))
->E.R2.fmap(r => ReducerInterface_InternalExpressionValue.IEvDistribution(
->E.R2.fmap(r => Reducer_T.IEvDistribution(
PointSet(makeDist(r)),
))
expressionValue
@ -27,7 +27,7 @@ module Internal = {
type t = PointSetDist.t
let toType = (r): result<
ReducerInterface_InternalExpressionValue.t,
Reducer_T.value,
Reducer_ErrorValue.errorValue,
> =>
switch r {
@ -35,14 +35,14 @@ module Internal = {
| Error(err) => Error(REOperationError(err))
}
let doLambdaCall = (aLambdaValue, list, environment, reducer) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
| IEvNumber(f) => Ok(f)
let doLambdaCall = (aLambdaValue, list, env, reducer) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, env, reducer) {
| Reducer_T.IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
}
let mapY = (pointSetDist: t, aLambdaValue, env, reducer) => {
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, env, reducer)
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], env, reducer)
PointSetDist.T.mapYResult(~fn, pointSetDist)->toType
}
}
@ -58,13 +58,13 @@ let library = [
FnDefinition.make(
~name="fromDist",
~inputs=[FRTypeDist],
~run=(_, inputs, accessors, _) =>
~run=(_, inputs, env, _) =>
switch inputs {
| [FRValueDist(dist)] =>
GenericDist.toPointSet(
dist,
~xyPointLength=accessors.environment.xyPointLength,
~sampleCount=accessors.environment.sampleCount,
~xyPointLength=env.xyPointLength,
~sampleCount=env.sampleCount,
(),
)
->E.R2.fmap(Wrappers.pointSet)

View File

@ -1,5 +1,3 @@
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
open FunctionRegistry_Core
open FunctionRegistry_Helpers
@ -12,16 +10,16 @@ module Internal = {
let doLambdaCall = (
aLambdaValue,
list,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, env, reducer) {
| IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
}
let toType = (r): result<
ReducerInterface_InternalExpressionValue.t,
Reducer_T.value,
Reducer_ErrorValue.errorValue,
> =>
switch r {
@ -30,26 +28,26 @@ module Internal = {
}
//TODO: I don't know why this seems to need at least one input
let fromFn = (aLambdaValue, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => {
let sampleCount = accessors.environment.sampleCount
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, accessors, reducer)
let fromFn = (aLambdaValue, environment: Reducer_T.environment, reducer: Reducer_T.reducerFn) => {
let sampleCount = environment.sampleCount
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], environment, reducer)
Belt_Array.makeBy(sampleCount, r => fn(r->Js.Int.toFloat))->E.A.R.firstErrorOrOpen
}
let map1 = (sampleSetDist: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, accessors, reducer)
let map1 = (sampleSetDist: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], environment, reducer)
SampleSetDist.samplesMap(~fn, sampleSetDist)->toType
}
let map2 = (t1: t, t2: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
let map2 = (t1: t, t2: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
let fn = (a, b) =>
doLambdaCall(aLambdaValue, list{IEvNumber(a), IEvNumber(b)}, accessors, reducer)
doLambdaCall(aLambdaValue, [IEvNumber(a), IEvNumber(b)], environment, reducer)
SampleSetDist.map2(~fn, ~t1, ~t2)->toType
}
let map3 = (t1: t, t2: t, t3: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
let map3 = (t1: t, t2: t, t3: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
let fn = (a, b, c) =>
doLambdaCall(aLambdaValue, list{IEvNumber(a), IEvNumber(b), IEvNumber(c)}, accessors, reducer)
doLambdaCall(aLambdaValue, [IEvNumber(a), IEvNumber(b), IEvNumber(c)], environment, reducer)
SampleSetDist.map3(~fn, ~t1, ~t2, ~t3)->toType
}
@ -67,7 +65,7 @@ module Internal = {
let mapN = (
aValueArray: array<internalExpressionValue>,
aLambdaValue,
accessors: ProjectAccessorsT.t,
environment: Reducer_T.environment,
reducer,
) => {
switch parseSampleSetArray(aValueArray) {
@ -75,8 +73,8 @@ module Internal = {
let fn = a =>
doLambdaCall(
aLambdaValue,
list{IEvArray(E.A.fmap(x => Wrappers.evNumber(x), a))},
accessors,
[IEvArray(E.A.fmap(x => Wrappers.evNumber(x), a))],
environment,
reducer,
)
SampleSetDist.mapN(~fn, ~t1)->toType
@ -96,10 +94,10 @@ let libaryBase = [
FnDefinition.make(
~name="fromDist",
~inputs=[FRTypeDist],
~run=(_, inputs, accessors: ProjectAccessorsT.t, _) =>
~run=(_, inputs, environment, _) =>
switch inputs {
| [FRValueDist(dist)] =>
GenericDist.toSampleSetDist(dist, accessors.environment.sampleCount)
GenericDist.toSampleSetDist(dist, environment.sampleCount)
->E.R2.fmap(Wrappers.sampleSet)
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(DistributionTypes.Error.toString)
@ -163,10 +161,10 @@ let libaryBase = [
FnDefinition.make(
~name="fromFn",
~inputs=[FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
~run=(inputs, _, environment, reducer) =>
switch inputs {
| [IEvLambda(lambda)] =>
switch Internal.fromFn(lambda, accessors, reducer) {
switch Internal.fromFn(lambda, environment, reducer) {
| Ok(r) => Ok(r->Wrappers.sampleSet->Wrappers.evDistribution)
| Error(e) => Error(Operation.Error.toString(e))
}
@ -187,10 +185,10 @@ let libaryBase = [
FnDefinition.make(
~name="map",
~inputs=[FRTypeDist, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
~run=(inputs, _, environment, reducer) =>
switch inputs {
| [IEvDistribution(SampleSet(dist)), IEvLambda(lambda)] =>
Internal.map1(dist, lambda, accessors, reducer)->E.R2.errMap(_ => "")
Internal.map1(dist, lambda, environment, reducer)->E.R2.errMap(_ => "")
| _ => Error(impossibleError)
},
(),
@ -210,14 +208,14 @@ let libaryBase = [
FnDefinition.make(
~name="map2",
~inputs=[FRTypeDist, FRTypeDist, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => {
~run=(inputs, _, environment, reducer) => {
switch inputs {
| [
IEvDistribution(SampleSet(dist1)),
IEvDistribution(SampleSet(dist2)),
IEvLambda(lambda),
] =>
Internal.map2(dist1, dist2, lambda, accessors, reducer)->E.R2.errMap(_ => "")
Internal.map2(dist1, dist2, lambda, environment, reducer)->E.R2.errMap(_ => "")
| _ => Error(impossibleError)
}
},
@ -238,7 +236,7 @@ let libaryBase = [
FnDefinition.make(
~name="map3",
~inputs=[FRTypeDist, FRTypeDist, FRTypeDist, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
~run=(inputs, _, environment, reducer) =>
switch inputs {
| [
IEvDistribution(SampleSet(dist1)),
@ -246,7 +244,7 @@ let libaryBase = [
IEvDistribution(SampleSet(dist3)),
IEvLambda(lambda),
] =>
Internal.map3(dist1, dist2, dist3, lambda, accessors, reducer)->E.R2.errMap(_ => "")
Internal.map3(dist1, dist2, dist3, lambda, environment, reducer)->E.R2.errMap(_ => "")
| _ => Error(impossibleError)
},
(),
@ -266,10 +264,10 @@ let libaryBase = [
FnDefinition.make(
~name="mapN",
~inputs=[FRTypeArray(FRTypeDist), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
~run=(inputs, _, environment, reducer) =>
switch inputs {
| [IEvArray(dists), IEvLambda(lambda)] =>
Internal.mapN(dists, lambda, accessors, reducer)->E.R2.errMap(_e => {
Internal.mapN(dists, lambda, environment, reducer)->E.R2.errMap(_e => {
"AHHH doesn't work"
})
| _ => Error(impossibleError)

View File

@ -30,16 +30,16 @@ let library = [
("prior", FRTypeDist),
]),
],
~run=(_, inputs, accessors, _) => {
~run=(_, inputs, environment, _) => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.threeArgs(inputs) {
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueDist(d)), FRValueDist(prior)]) =>
runScoring(estimate, Score_Dist(d), Some(prior), accessors.environment)
runScoring(estimate, Score_Dist(d), Some(prior), environment)
| Ok([
FRValueDist(estimate),
FRValueDistOrNumber(FRValueNumber(d)),
FRValueDist(prior),
]) =>
runScoring(estimate, Score_Scalar(d), Some(prior), accessors.environment)
runScoring(estimate, Score_Scalar(d), Some(prior), environment)
| Error(e) => Error(e)
| _ => Error(FunctionRegistry_Helpers.impossibleError)
}
@ -49,12 +49,12 @@ let library = [
FnDefinition.make(
~name="logScore",
~inputs=[FRTypeRecord([("estimate", FRTypeDist), ("answer", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) => {
~run=(_, inputs, environment, _) => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs(inputs) {
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueDist(d))]) =>
runScoring(estimate, Score_Dist(d), None, accessors.environment)
runScoring(estimate, Score_Dist(d), None, environment)
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueNumber(d))]) =>
runScoring(estimate, Score_Scalar(d), None, accessors.environment)
runScoring(estimate, Score_Scalar(d), None, environment)
| Error(e) => Error(e)
| _ => Error(FunctionRegistry_Helpers.impossibleError)
}
@ -74,10 +74,10 @@ let library = [
FnDefinition.make(
~name="klDivergence",
~inputs=[FRTypeDist, FRTypeDist],
~run=(_, inputs, accessors, _) => {
~run=(_, inputs, environment, _) => {
switch inputs {
| [FRValueDist(estimate), FRValueDist(d)] =>
runScoring(estimate, Score_Dist(d), None, accessors.environment)
runScoring(estimate, Score_Dist(d), None, environment)
| _ => Error(FunctionRegistry_Helpers.impossibleError)
}
},

View File

@ -2,16 +2,86 @@
// Other module operations such as import export will be preprocessed jobs
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue
open ReducerInterface_InternalExpressionValue
module T = Reducer_T
let expressionValueToString = toString
type t = Reducer_T.nameSpace
type internalExpressionValue = Reducer_T.value
type t = ReducerInterface_InternalExpressionValue.nameSpace
let rec get = (nameSpace: t, id: string) => {
let T.NameSpace(container, parent) = nameSpace
let typeAliasesKey = "_typeAliases_"
let typeReferencesKey = "_typeReferences_"
switch container->Belt.MutableMap.String.get(id) {
| Some(v) => Some(v)
| None => switch parent {
| Some(p) => get(p, id)
| None => None
}
}
}
let getWithDefault = (nameSpace: t, id: string, default) =>
switch get(nameSpace, id) {
| Some(v) => Some(v)
| None => default
}
let toString = ReducerInterface_InternalExpressionValue.toStringNameSpace
let makeEmptyMap = () => Belt.MutableMap.String.make()
let set = (nameSpace: t, id: string, value): t => {
let T.NameSpace(container, _) = nameSpace
Belt.MutableMap.String.set(container, id, value)
nameSpace
}
let extend = (nameSpace: t) => T.NameSpace(
makeEmptyMap(),
nameSpace->Some
)
let toKeyValuePairs = (T.NameSpace(container, _): t): array<(string, internalExpressionValue)> => {
container->Belt.MutableMap.String.toArray
}
let makeEmptyBindings = (): t => T.NameSpace(makeEmptyMap(), None)
let toExpressionValue = (nameSpace: t): internalExpressionValue => T.IEvBindings(nameSpace)
let fromExpressionValue = (aValue: internalExpressionValue): t =>
switch aValue {
| IEvBindings(nameSpace) => nameSpace
| _ => makeEmptyBindings()
}
let fromArray = a => T.NameSpace(Belt.MutableMap.String.fromArray(a), None)
let mergeFrom = (T.NameSpace(container, _): t, T.NameSpace(newContainer, parent): t): t => {
NameSpace(
newContainer->Belt.MutableMap.String.reduce(container, (container, key, value) => {
if key != "__result__" {
Belt.MutableMap.String.set(container, key, value)
}
container
}),
parent
)
}
let chainTo = (nameSpace: t, previousNameSpaces: array<t>) => {
previousNameSpaces->Belt.Array.reduce(nameSpace, (topNameSpace, prevNameSpace) =>
mergeFrom(prevNameSpace, topNameSpace)
)
}
let removeResult = (nameSpace: t): t => {
let T.NameSpace(container, _) = nameSpace
container->Belt.MutableMap.String.remove("__result__")
nameSpace
}
// let typeAliasesKey = "_typeAliases_"
// let typeReferencesKey = "_typeReferences_"
// let getType = (NameSpace(container): t, id: string) => {
// Belt.Map.String.get(container, typeAliasesKey)->Belt.Option.flatMap(aliases =>
@ -31,27 +101,6 @@ let typeReferencesKey = "_typeReferences_"
// )
// }
let getWithDefault = (NameSpace(container): t, id: string, default) =>
switch Belt.Map.String.get(container, id) {
| Some(v) => v
| None => default
}
let get = (nameSpace: t, id: string) => {
let NameSpace(container, parent) = nameSpace
switch container->Belt.MutableMap.String.get(key) {
| Some(v) => Some(v)
| None => switch parent {
| Some(p) => nameSpaceGet(p, key)
| None => None
}
}
}
let emptyMap: map = Belt.Map.String.empty
// let setTypeAlias = (NameSpace(container): t, id: string, value): t => {
// let rValue = Belt.Map.String.getWithDefault(container, typeAliasesKey, IEvRecord(emptyMap))
// let r = switch rValue {
@ -72,126 +121,74 @@ let emptyMap: map = Belt.Map.String.empty
// NameSpace(Belt.Map.String.set(container, typeReferencesKey, r2))
// }
let set = (NameSpace(container): t, id: string, value): t => NameSpace(
Belt.Map.String.set(container, id, value),
)
// let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => {
// let keys = Belt.Map.String.keysToArray(otherContainer)
// NameSpace(
// Belt.Map.String.keep(container, (key, _value) => {
// let removeThis = Js.Array2.includes(keys, key)
// !removeThis
// }),
// )
// }
let emptyModule: t = NameSpace(emptyMap)
let emptyBindings = emptyModule
let emptyNameSpace = emptyModule
// external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
let toExpressionValue = (nameSpace: t): internalExpressionValue => IEvBindings(nameSpace)
let fromExpressionValue = (aValue: internalExpressionValue): t =>
switch aValue {
| IEvBindings(nameSpace) => nameSpace
| _ => emptyModule
}
// let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
// IEvLambda({
// parameters: [],
// context: emptyModule,
// body: FFI(ffiFn)->castExpressionToInternalCode,
// })
// }
let fromArray = a => NameSpace(Belt.Map.String.fromArray(a))
// let functionNotFoundError = (call: functionCall) =>
// REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
let mergeFrom = (NameSpace(container): t, NameSpace(newContainer): t): t => {
NameSpace(
newContainer->Belt.Map.String.reduce(container, (container, key, value) =>
Belt.Map.String.set(container, key, value)
),
)
}
// let functionNotFoundErrorFFIFn = (functionName: string): ExpressionT.ffiFn => {
// (args: array<internalExpressionValue>, _environment: environment): result<
// internalExpressionValue,
// errorValue,
// > => {
// let call = (functionName, args)
// functionNotFoundError(call)
// }
// }
let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => {
let keys = Belt.Map.String.keysToArray(otherContainer)
NameSpace(
Belt.Map.String.keep(container, (key, _value) => {
let removeThis = Js.Array2.includes(keys, key)
!removeThis
}),
)
}
// let convertOptionToFfiFnReturningResult = (
// myFunctionName: string,
// myFunction: ExpressionT.optionFfiFnReturningResult,
// ): ExpressionT.ffiFn => {
// (args: array<InternalExpressionValue.t>, environment) => {
// myFunction(args, environment)->Belt.Option.getWithDefault(
// functionNotFoundErrorFFIFn(myFunctionName)(args, environment),
// )
// }
// }
external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
IEvLambda({
parameters: [],
context: emptyModule,
body: FFI(ffiFn)->castExpressionToInternalCode,
})
}
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 convertOptionToFfiFnReturningResult = (
myFunctionName: string,
myFunction: ExpressionT.optionFfiFnReturningResult,
): ExpressionT.ffiFn => {
(args: array<InternalExpressionValue.t>, environment) => {
myFunction(args, environment)->Belt.Option.getWithDefault(
functionNotFoundErrorFFIFn(myFunctionName)(args, environment),
)
}
}
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))
}
}
// 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
let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => {
NameSpace(Belt.Map.String.set(container, identifier, ev))
}
// let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => {
// NameSpace(Belt.Map.String.set(container, identifier, ev))
// }
let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
nameSpace->define(identifier, IEvNumber(value))
// let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
// nameSpace->define(identifier, IEvNumber(value))
let defineString = (nameSpace: t, identifier: string, value: string): t =>
nameSpace->define(identifier, IEvString(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 defineBool = (nameSpace: t, identifier: string, value: bool): t =>
// nameSpace->define(identifier, IEvBool(value))
let defineModule = (nameSpace: t, identifier: string, value: t): t =>
nameSpace->define(identifier, toExpressionValue(value))
let defineFunction = (nameSpace: t, identifier: string, value: ExpressionT.optionFfiFn): t => {
nameSpace->define(identifier, convertOptionToFfiFn(identifier, value)->eLambdaFFIValue)
}
let defineFunctionReturningResult = (
nameSpace: t,
identifier: string,
value: ExpressionT.optionFfiFnReturningResult,
): t => {
nameSpace->define(
identifier,
convertOptionToFfiFnReturningResult(identifier, value)->eLambdaFFIValue,
)
}
let emptyStdLib: t = emptyModule->defineBool("_standardLibrary", true)
let chainTo = (nameSpace: t, previousNameSpaces: array<t>) => {
previousNameSpaces->Belt.Array.reduce(nameSpace, (topNameSpace, prevNameSpace) =>
mergeFrom(prevNameSpace, topNameSpace)
)
}
let removeResult = (NameSpace(container): t): t => {
container->Belt.Map.String.remove("__result__")->NameSpace
}
// let defineModule = (nameSpace: t, identifier: string, value: t): t =>
// nameSpace->define(identifier, toExpressionValue(value))

View File

@ -0,0 +1,14 @@
type t = Reducer_T.context
let createContext = (stdLib: Reducer_T.nameSpace, environment: Reducer_T.environment): t => {
{
bindings: stdLib->Reducer_Bindings.extend,
environment,
}
}
let createDefaultContext = (): t =>
createContext(
ReducerInterface_StdLib.internalStdLib,
ReducerInterface_InternalExpressionValue.defaultEnvironment
)

View File

@ -1,2 +0,0 @@
module Builtin = Reducer_Dispatch_BuiltIn
module BuiltinMacros = Reducer_Dispatch_BuiltInMacros

View File

@ -1,16 +1,14 @@
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module Continuation = ReducerInterface_Value_Continuation
module ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary
module Lambda = Reducer_Expression_Lambda
module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module Result = Belt.Result
module TypeBuilder = Reducer_Type_TypeBuilder
open ReducerInterface_InternalExpressionValue
module IEV = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue
/*
@ -24,42 +22,42 @@ open Reducer_ErrorValue
exception TestRescriptException
let callInternal = (
call: functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
call: IEV.functionCall,
_: Reducer_T.environment,
_: Reducer_T.reducerFn,
): result<'b, errorValue> => {
let callMathJs = (call: functionCall): result<'b, errorValue> =>
let callMathJs = (call: IEV.functionCall): result<'b, errorValue> =>
switch call {
| ("javascriptraise", [msg]) => Js.Exn.raiseError(toString(msg)) // For Tests
| ("javascriptraise", [msg]) => Js.Exn.raiseError(IEV.toString(msg)) // For Tests
| ("rescriptraise", _) => raise(TestRescriptException) // For Tests
| call => call->toStringFunctionCall->MathJs.Eval.eval
| call => call->IEV.toStringFunctionCall->MathJs.Eval.eval
}
let constructRecord = arrayOfPairs => {
Belt.Array.map(arrayOfPairs, pairValue =>
switch pairValue {
| IEvArray([IEvString(key), valueValue]) => (key, valueValue)
| _ => ("wrong key type", pairValue->toStringWithType->IEvString)
| Reducer_T.IEvArray([IEvString(key), valueValue]) => (key, valueValue)
| _ => ("wrong key type", pairValue->IEV.toStringWithType->IEvString)
}
)
->Belt.Map.String.fromArray
->IEvRecord
->Reducer_T.IEvRecord
->Ok
}
let arrayAtIndex = (aValueArray: array<internalExpressionValue>, fIndex: float) =>
let arrayAtIndex = (aValueArray: array<Reducer_T.value>, fIndex: float) =>
switch Belt.Array.get(aValueArray, Belt.Int.fromFloat(fIndex)) {
| Some(value) => value->Ok
| None => REArrayIndexNotFound("Array index not found", Belt.Int.fromFloat(fIndex))->Error
}
let moduleAtIndex = (nameSpace: nameSpace, sIndex) =>
let moduleAtIndex = (nameSpace: Reducer_T.nameSpace, sIndex) =>
switch Bindings.get(nameSpace, sIndex) {
| Some(value) => value->Ok
| None => RERecordPropertyNotFound("Bindings property not found", sIndex)->Error
}
let recordAtIndex = (dict: Belt.Map.String.t<internalExpressionValue>, sIndex) =>
let recordAtIndex = (dict: Belt.Map.String.t<Reducer_T.value>, sIndex) =>
switch Belt.Map.String.get(dict, sIndex) {
| Some(value) => value->Ok
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
@ -68,26 +66,26 @@ let callInternal = (
let doAddArray = (originalA, b) => {
let a = originalA->Js.Array2.copy
let _ = Js.Array2.pushMany(a, b)
a->IEvArray->Ok
a->Reducer_T.IEvArray->Ok
}
let doAddString = (a, b) => {
let answer = Js.String2.concat(a, b)
answer->IEvString->Ok
answer->Reducer_T.IEvString->Ok
}
let inspect = (value: internalExpressionValue) => {
Js.log(value->toString)
let inspect = (value: Reducer_T.value) => {
Js.log(value->IEV.toString)
value->Ok
}
let inspectLabel = (value: internalExpressionValue, label: string) => {
Js.log(`${label}: ${value->toString}`)
let inspectLabel = (value: Reducer_T.value, label: string) => {
Js.log(`${label}: ${value->IEV.toString}`)
value->Ok
}
let doSetBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) => {
Bindings.set(bindings, symbol, value)->IEvBindings->Ok
}
// let doSetBindings = (bindings: Reducer_T.nameSpace, symbol: string, value: Reducer_T.value) => {
// Bindings.set(bindings, symbol, value)->IEvBindings->Ok
// }
// let doSetTypeAliasBindings = (
// bindings: nameSpace,
@ -98,50 +96,15 @@ let callInternal = (
// let doSetTypeOfBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) =>
// Bindings.setTypeOf(bindings, symbol, value)->IEvBindings->Ok
let doExportBindings = (bindings: nameSpace) => bindings->Bindings.toExpressionValue->Ok
// let doExportBindings = (bindings: nameSpace) => bindings->Bindings.toExpressionValue->Ok
let doIdentity = (value: internalExpressionValue) => value->Ok
// let doIdentity = (value: Reducer_T.value) => value->Ok
let doDumpBindings = (continuation: nameSpace, value: internalExpressionValue) => {
// let _ = Continuation.inspect(continuation, "doDumpBindings")
accessors.states.continuation = continuation->Bindings.set("__result__", value)
value->Ok
}
module SampleMap = {
let doLambdaCall = (aLambdaValue, list) =>
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
| IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
}
let toType = r =>
switch r {
| Ok(r) => Ok(IEvDistribution(SampleSet(r)))
| Error(r) => Error(REDistributionError(SampleSetError(r)))
}
let parseSampleSetArray = (arr: array<internalExpressionValue>): option<
array<SampleSetDist.t>,
> => {
let parseSampleSet = (value: internalExpressionValue): option<SampleSetDist.t> =>
switch value {
| IEvDistribution(SampleSet(dist)) => Some(dist)
| _ => None
}
E.A.O.openIfAllSome(E.A.fmap(parseSampleSet, arr))
}
let _mapN = (aValueArray: array<internalExpressionValue>, aLambdaValue) => {
switch parseSampleSetArray(aValueArray) {
| Some(t1) =>
let fn = a => doLambdaCall(aLambdaValue, list{IEvArray(E.A.fmap(x => IEvNumber(x), a))})
SampleSetDist.mapN(~fn, ~t1)->toType
| None =>
Error(REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString))
}
}
}
// let doDumpBindings = (continuation: Reducer_T.nameSpace, value: Reducer_T.value) => {
// // let _ = Continuation.inspect(continuation, "doDumpBindings")
// accessors.states.continuation = continuation->Bindings.set("__result__", value)
// value->Ok
// }
switch call {
| ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
@ -149,15 +112,15 @@ let callInternal = (
| ("$_atIndex_$", [IEvRecord(dict), IEvString(sIndex)]) => recordAtIndex(dict, sIndex)
| ("$_constructArray_$", args) => IEvArray(args)->Ok
| ("$_constructRecord_$", [IEvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs)
| ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace)
| ("$_exportBindings_$", [evValue]) => doIdentity(evValue)
| ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
doSetBindings(nameSpace, symbol, value)
// | ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace)
// | ("$_exportBindings_$", [evValue]) => doIdentity(evValue)
// | ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
// doSetBindings(nameSpace, symbol, value)
// | ("$_setTypeAliasBindings_$", [IEvBindings(nameSpace), IEvTypeIdentifier(symbol), value]) =>
// doSetTypeAliasBindings(nameSpace, symbol, value)
// | ("$_setTypeOfBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
// doSetTypeOfBindings(nameSpace, symbol, value)
| ("$_dumpBindings_$", [IEvBindings(nameSpace), _, evValue]) => doDumpBindings(nameSpace, evValue)
// | ("$_dumpBindings_$", [IEvBindings(nameSpace), _, evValue]) => doDumpBindings(nameSpace, evValue)
// | ("$_typeModifier_memberOf_$", [IEvTypeIdentifier(typeIdentifier), IEvArray(arr)]) =>
// TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
// | ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) =>
@ -191,31 +154,31 @@ let callInternal = (
| (_, [IEvString(_), IEvString(_)]) =>
callMathJs(call)
| call =>
Error(REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)) // Report full type signature as error
Error(REFunctionNotFound(call->IEV.functionCallToCallSignature->IEV.functionCallSignatureToString)) // Report full type signature as error
}
}
/*
Reducer uses Result monad while reducing expressions
*/
let dispatch = (
call: functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): internalExpressionValue =>
call: IEV.functionCall,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn
): Reducer_T.value =>
try {
let (fn, args) = call
if fn->Js.String2.startsWith("$") {
switch callInternal((fn, args), accessors, reducer) {
switch callInternal((fn, args), env, reducer) {
| Ok(v) => v
| Error(e) => raise(ErrorException(e))
}
} else {
// There is a bug that prevents string match in patterns
// So we have to recreate a copy of the string
switch ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) {
| Ok(v) => v
| Error(e) => raise(ErrorException(e))
}
switch ExternalLibrary.dispatch((Js.String.make(fn), args), env, reducer, callInternal) {
| Ok(v) => v
| Error(e) => raise(ErrorException(e))
}
}
} catch {
| ErrorException(e) => raise(ErrorException(e))

View File

@ -1,190 +1,189 @@
/*
Macros are like functions but instead of taking values as parameters,
they take expressions as parameters and return a new expression.
Macros are used to define language building blocks. They are like Lisp macros.
*/
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module ErrorValue = Reducer_ErrorValue
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module ExpressionWithContext = Reducer_ExpressionWithContext
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
// /*
// Macros are like functions but instead of taking values as parameters,
// they take expressions as parameters and return a new expression.
// Macros are used to define language building blocks. They are like Lisp macros.
// */
// module BindingsReplacer = Reducer_Expression_BindingsReplacer
// module ErrorValue = Reducer_ErrorValue
// module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
// module ExpressionT = Reducer_Expression_T
// module ExpressionWithContext = Reducer_ExpressionWithContext
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
open Reducer_Expression_ExpressionBuilder
// open Reducer_Expression_ExpressionBuilder
exception ErrorException = ErrorValue.ErrorException
type expression = ExpressionT.expression
type expressionWithContext = ExpressionWithContext.expressionWithContext
// exception ErrorException = ErrorValue.ErrorException
// type expression = ExpressionT.expression
// type expressionWithContext = ExpressionWithContext.expressionWithContext
let dispatchMacroCall = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): expressionWithContext => {
let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
// let dispatchMacroCall = (
// macroExpression: expression,
// bindings: ExpressionT.bindings,
// accessors: ProjectAccessorsT.t,
// reduceExpression: ProjectReducerFnT.t,
// ): expressionWithContext => {
// let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
// let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
// let newBindings = Reducer_Bindings.fromExpressionValue(nameSpaceValue)
let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
// let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
}
// ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
// }
let correspondingSetBindingsFn = (fnName: string): string =>
switch fnName {
| "$_let_$" => "$_setBindings_$"
| "$_typeOf_$" => "$_setTypeOfBindings_$"
| "$_typeAlias_$" => "$_setTypeAliasBindings_$"
| "$_endOfOuterBlock_$" => "$_dumpBindings_$"
| _ => ""
}
// let correspondingSetBindingsFn = (fnName: string): string =>
// switch fnName {
// | "$_let_$" => "$_setBindings_$"
// | "$_typeOf_$" => "$_setTypeOfBindings_$"
// | "$_typeAlias_$" => "$_setTypeAliasBindings_$"
// | "$_endOfOuterBlock_$" => "$_dumpBindings_$"
// | _ => ""
// }
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), ExpressionT.EValue(IEvSymbol(symbolExpr)), statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName)
if setBindingsFn !== "" {
useExpressionToSetBindings(bindingExpr, accessors, statement, (
newBindingsExpr,
boundStatement,
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr->IEvSymbol->ExpressionT.EValue, boundStatement}))
} else {
raise(defaultStatement)
}
}
| _ => raise(defaultStatement)
}
}
// let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
// let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException
// switch statement {
// | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), ExpressionT.EValue(IEvSymbol(symbolExpr)), statement}) => {
// let setBindingsFn = correspondingSetBindingsFn(callName)
// if setBindingsFn !== "" {
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
// newBindingsExpr,
// boundStatement,
// ) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr->IEvSymbol->ExpressionT.EValue, boundStatement}))
// } else {
// raise(defaultStatement)
// }
// }
// | _ => raise(defaultStatement)
// }
// }
let doBindExpression = (
bindingExpr: expression,
statement: expression,
accessors,
): expressionWithContext => {
let defaultStatement = () =>
useExpressionToSetBindings(bindingExpr, accessors, statement, (
_newBindingsExpr,
boundStatement,
) => boundStatement)
// let doBindExpression = (
// bindingExpr: expression,
// statement: expression,
// accessors,
// ): expressionWithContext => {
// let defaultStatement = () =>
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
// _newBindingsExpr,
// boundStatement,
// ) => boundStatement)
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName)
if setBindingsFn !== "" {
useExpressionToSetBindings(bindingExpr, accessors, statement, (
newBindingsExpr,
boundStatement,
) =>
eFunction(
"$_exportBindings_$",
list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})}, // expression returning bindings
)
)
} else {
defaultStatement()
}
}
| _ => defaultStatement()
}
}
// switch statement {
// | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
// let setBindingsFn = correspondingSetBindingsFn(callName)
// if setBindingsFn !== "" {
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
// newBindingsExpr,
// boundStatement,
// ) =>
// eFunction(
// "$_exportBindings_$",
// list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})}, // expression returning bindings
// )
// )
// } else {
// defaultStatement()
// }
// }
// | _ => defaultStatement()
// }
// }
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) =>
if index == 0 {
if index == maxIndex {
eBindExpressionDefault(statement)
} else {
eBindStatementDefault(statement)
}
} else if index == maxIndex {
eBindExpression(acc, statement)
} else {
eBindStatement(acc, statement)
}
, eSymbol("undefined block"))
ExpressionWithContext.noContext(newStatement)
}
// 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) =>
// if index == 0 {
// if index == maxIndex {
// eBindExpressionDefault(statement)
// } else {
// eBindStatementDefault(statement)
// }
// } else if index == maxIndex {
// eBindExpression(acc, statement)
// } else {
// eBindStatement(acc, statement)
// }
// , eSymbol("undefined block"))
// ExpressionWithContext.noContext(newStatement)
// }
let doLambdaDefinition = (
bindings: ExpressionT.bindings,
parameters: array<string>,
lambdaDefinition: ExpressionT.expression,
) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
// let doLambdaDefinition = (
// bindings: ExpressionT.bindings,
// parameters: array<string>,
// lambdaDefinition: ExpressionT.expression,
// ) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
let doTernary = (
condition: expression,
ifTrue: expression,
ifFalse: expression,
bindings: ExpressionT.bindings,
accessors,
): expressionWithContext => {
let blockCondition = ExpressionBuilder.eBlock(list{condition})
let conditionValue = reduceExpression(blockCondition, bindings, accessors)
// let doTernary = (
// condition: expression,
// ifTrue: expression,
// ifFalse: expression,
// bindings: ExpressionT.bindings,
// accessors,
// ): expressionWithContext => {
// let blockCondition = ExpressionBuilder.eBlock(list{condition})
// 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", "")))
}
}
// 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,
): expressionWithContext =>
switch aList {
| list{
ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
bindingExpr: ExpressionT.expression,
statement,
} =>
doBindStatement(bindingExpr, statement, accessors)
| list{ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), statement} =>
// bindings of the context are used when there is no binding expression
doBindStatement(eModule(bindings), statement, accessors)
| list{
ExpressionT.EValue(IEvCall("$$_bindExpression_$$")),
bindingExpr: ExpressionT.expression,
expression,
} =>
doBindExpression(bindingExpr, expression, accessors)
| list{ExpressionT.EValue(IEvCall("$$_bindExpression_$$")), expression} =>
// bindings of the context are used when there is no binding expression
doBindExpression(eModule(bindings), expression, accessors)
| list{ExpressionT.EValue(IEvCall("$$_block_$$")), ...exprs} =>
doBlock(exprs, bindings, accessors)
| list{
ExpressionT.EValue(IEvCall("$$_lambda_$$")),
ExpressionT.EValue(IEvArrayString(parameters)),
lambdaDefinition,
} =>
doLambdaDefinition(bindings, parameters, lambdaDefinition)
| list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
doTernary(condition, ifTrue, ifFalse, bindings, accessors)
| _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
}
// let expandExpressionList = (
// aList,
// bindings: ExpressionT.bindings,
// accessors,
// ): expressionWithContext =>
// switch aList {
// | list{
// ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
// bindingExpr: ExpressionT.expression,
// statement,
// } =>
// doBindStatement(bindingExpr, statement, accessors)
// | list{ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), statement} =>
// // bindings of the context are used when there is no binding expression
// doBindStatement(eModule(bindings), statement, accessors)
// | list{
// ExpressionT.EValue(IEvCall("$$_bindExpression_$$")),
// bindingExpr: ExpressionT.expression,
// expression,
// } =>
// doBindExpression(bindingExpr, expression, accessors)
// | list{ExpressionT.EValue(IEvCall("$$_bindExpression_$$")), expression} =>
// // bindings of the context are used when there is no binding expression
// doBindExpression(eModule(bindings), expression, accessors)
// | list{ExpressionT.EValue(IEvCall("$$_block_$$")), ...exprs} =>
// doBlock(exprs, bindings, accessors)
// | list{
// ExpressionT.EValue(IEvCall("$$_lambda_$$")),
// ExpressionT.EValue(IEvArrayString(parameters)),
// lambdaDefinition,
// } =>
// doLambdaDefinition(bindings, parameters, lambdaDefinition)
// | list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
// doTernary(condition, ifTrue, ifFalse, bindings, accessors)
// | _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
// }
switch macroExpression {
| EList(aList) => expandExpressionList(aList, bindings, accessors)
| _ => ExpressionWithContext.noContext(macroExpression)
}
}
// switch macroExpression {
// | EList(aList) => expandExpressionList(aList, bindings, accessors)
// | _ => ExpressionWithContext.noContext(macroExpression)
// }
// }

View File

@ -1,23 +1,23 @@
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module T = Reducer_Dispatch_T
module TypeChecker = Reducer_Type_TypeChecker
open ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module T = Reducer_Dispatch_T
// module TypeChecker = Reducer_Type_TypeChecker
// open ReducerInterface_InternalExpressionValue
type errorValue = Reducer_ErrorValue.errorValue
// type errorValue = Reducer_ErrorValue.errorValue
let makeFromTypes = jumpTable => {
let dispatchChainPiece: T.dispatchChainPiece = (
(fnName, fnArgs): functionCall,
accessors: ProjectAccessorsT.t,
) => {
let jumpTableEntry = jumpTable->Js.Array2.find(elem => {
let (candidName, candidType, _) = elem
candidName == fnName && TypeChecker.checkITypeArgumentsBool(candidType, fnArgs)
})
switch jumpTableEntry {
| Some((_, _, bridgeFn)) => bridgeFn(fnArgs, accessors)->Some
| _ => None
}
}
dispatchChainPiece
}
// let makeFromTypes = jumpTable => {
// let dispatchChainPiece: T.dispatchChainPiece = (
// (fnName, fnArgs): functionCall,
// accessors: ProjectAccessorsT.t,
// ) => {
// let jumpTableEntry = jumpTable->Js.Array2.find(elem => {
// let (candidName, candidType, _) = elem
// candidName == fnName && TypeChecker.checkITypeArgumentsBool(candidType, fnArgs)
// })
// switch jumpTableEntry {
// | Some((_, _, bridgeFn)) => bridgeFn(fnArgs, accessors)->Some
// | _ => None
// }
// }
// dispatchChainPiece
// }

View File

@ -1,22 +1,21 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionT = Reducer_Expression_T
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ExpressionT = Reducer_Expression_T
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// Each piece of the dispatch chain computes the result or returns None so that the chain can continue
type dispatchChainPiece = (
InternalExpressionValue.functionCall,
ProjectAccessorsT.t,
) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
// // Each piece of the dispatch chain computes the result or returns None so that the chain can continue
// type dispatchChainPiece = (
// InternalExpressionValue.functionCall,
// ProjectAccessorsT.t,
// ) => option<result<Reducer_T.value, Reducer_ErrorValue.errorValue>>
type dispatchChainPieceWithReducer = (
InternalExpressionValue.functionCall,
ProjectAccessorsT.t,
ProjectReducerFnT.t,
) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
// type dispatchChainPieceWithReducer = (
// InternalExpressionValue.functionCall,
// ProjectAccessorsT.t,
// Reducer_T.reducerFn,
// ) => option<result<Reducer_T.value, Reducer_ErrorValue.errorValue>>
// This is a switch statement case implementation: get the arguments and compute the result
type genericIEvFunction = (
array<InternalExpressionValue.t>,
ProjectAccessorsT.t,
) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>
// // This is a switch statement case implementation: get the arguments and compute the result
// type genericIEvFunction = (
// array<Reducer_T.value>,
// ProjectAccessorsT.t,
// ) => result<Reducer_T.value, Reducer_ErrorValue.errorValue>

View File

@ -1,119 +1,100 @@
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module BuiltIn = Reducer_Dispatch_BuiltIn
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module Extra = Reducer_Extra
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Lambda = Reducer_Expression_Lambda
module Macro = Reducer_Expression_Macro
module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module Result = Belt.Result
module T = Reducer_Expression_T
module T = Reducer_T
type errorValue = Reducer_ErrorValue.errorValue
type t = T.t
exception ErrorException = Reducer_ErrorValue.ErrorException
/*
Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus)
Recursively evaluate the expression
*/
let rec evaluate = (
expression: t,
bindings: T.bindings,
accessors: ProjectAccessorsT.t,
): InternalExpressionValue.t => {
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
// Js.log(`reduce: ${T.toString(expression)}`)
let rec evaluate: T.reducerFn = (
expression,
context
) => {
Js.log(`reduce: ${expression->Reducer_Expression_T.toString}`)
switch expression {
| T.Eblock(statements) => {
statements->Js.Array2.reduce(statement => evaluate(statement, bindings, accessors))
| T.EBlock(statements) => {
let innerContext = {...context, bindings: context.bindings->Bindings.extend}
statements->Js.Array2.reduce(
(acc, statement) => statement->evaluate(innerContext),
T.IEvVoid
)
}
| T.ESymbol(name) => bindings->nameSpaceGet(name)
| T.EValue(value) => value
| T.EProgram(statements) => {
Js.log(`bindings: ${context.bindings->Reducer_Bindings.toString}`)
let res = statements->Js.Array2.reduce(
(acc, statement) => statement->evaluate(context),
T.IEvVoid
)
Js.log(`bindings after: ${context.bindings->Reducer_Bindings.toString}`)
res
}
| T.EArray(elements) =>
elements->Js.Array2.map(element => evaluate(element, context))->T.IEvArray
| T.ERecord(map) =>
RETodo("TODO")->ErrorException->raise
| T.EAssign(left, right) => {
let result = right->evaluate(context)
let _ = context.bindings->Bindings.set(left, result)
T.IEvVoid
}
| T.ESymbol(name) =>
switch context.bindings->Bindings.get(name) {
| Some(v) => v
| None => Reducer_ErrorValue.RESymbolNotFound(name)->ErrorException->raise
}
| T.EValue(value) =>
value
| T.ETernary(predicate, trueCase, falseCase) => {
let predicateResult = evaluate(predicate, bindings, accessors)
let predicateResult = predicate->evaluate(context)
switch predicateResult {
| InternalExpressionValue.IEvBool(false) =>
evaluate(false, bindings, accessors)
| InternalExpressionValue.IEvBool(true) =>
evaluate(trueCase, bindings, accessors)
| T.IEvBool(value) =>
(value ? trueCase : falseCase)->evaluate(context)
| _ => REExpectedType("Boolean", "")->ErrorException->raise
}
}
| T.ELambda(parameteres, expr) => {
BInternalExpressionValue.IEvLambda({
parameters: parameters,
context: context,
body: NotFFI(expr)->BBindings.castExpressionToInternalCode,
})->T.EValue
}
| T.ELambda(parameters, body) =>
Lambda.makeLambda(parameters, context.bindings, body)->T.IEvLambda
| T.ECall(fn, args) => {
let func = evaluate(fn, bindings, accessors)
"TODO"
// Lambda.doLambdaCall(), etc.
}
}
}
/*
After reducing each level of expression(Lisp AST), we have a value list to evaluate
*/
and reduceValueList = (
valueList: list<InternalExpressionValue.t>,
accessors: ProjectAccessorsT.t,
): InternalExpressionValue.t =>
switch valueList {
| list{IEvCall(fName), ...args} => {
let checkedArgs = switch fName {
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args
| _ => args->Lambda.checkIfReduced
let lambda = fn->evaluate(context)
let argValues = Js.Array2.map(args, arg => arg->evaluate(context))
switch lambda {
| T.IEvLambda(lambda) =>
Lambda.doLambdaCall(lambda, argValues, context.environment, evaluate)
| _ => REExpectedType("Lambda", "")->ErrorException->raise
}
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
accessors,
reduceExpressionInProject,
)
}
| list{IEvLambda(_)} =>
// TODO: remove on solving issue#558
valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
| list{IEvLambda(lambdaCall), ...args} =>
args
->Lambda.checkIfReduced
->Lambda.doLambdaCall(lambdaCall, _, accessors, reduceExpressionInProject)
| _ => valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
}
let reduceExpressionInProject = evaluate
let reduceReturningBindings = (
expression: t,
continuation: T.bindings,
accessors: ProjectAccessorsT.t,
): (InternalExpressionValue.t, T.bindings) => {
let states = accessors.states
let result = reduceExpressionInProject(expression, continuation, accessors)
(result, states.continuation)
}
module BackCompatible = {
// Those methods are used to support the existing tests
// If they are used outside limited testing context, error location reporting will fail
let parse = (peggyCode: string): result<t, errorValue> =>
let parse = (peggyCode: string): result<Reducer_T.expression, errorValue> =>
peggyCode->Reducer_Peggy_Parse.parse->Result.map(Reducer_Peggy_ToExpression.fromNode)
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => {
let accessors = ProjectAccessorsT.identityAccessors
let evaluate = (expression: Reducer_T.expression): result<Reducer_T.value, errorValue> => {
let context = Reducer_Context.createDefaultContext()
try {
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
expression->evaluate(context)->Ok
} catch {
| ErrorException(e) => Error(e)
| _ => raise(ErrorException(RETodo("internal exception")))
}
}
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>
let evaluateString = (peggyCode: string): result<Reducer_T.value, errorValue> =>
parse(peggyCode)->Result.flatMap(evaluate)
}

View File

@ -1,53 +1,50 @@
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module ErrorValue = Reducer_ErrorValue
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module Result = Belt.Result
// module Bindings = Reducer_Bindings
// module ErrorValue = Reducer_ErrorValue
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module Result = Belt.Result
type bindings = ExpressionT.bindings
type context = bindings
type environment = InternalExpressionValue.environment
type errorValue = Reducer_ErrorValue.errorValue
type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t
// type bindings = Reducer_T.nameSpace
// type context = bindings
// type environment = InternalExpressionValue.environment
// type errorValue = Reducer_ErrorValue.errorValue
// type expression = ExpressionT.expression
type expressionWithContext =
| ExpressionWithContext(expression, context)
| ExpressionNoContext(expression)
// type expressionWithContext =
// | ExpressionWithContext(expression, context)
// | ExpressionNoContext(expression)
let callReducer = (
expressionWithContext: expressionWithContext,
bindings: bindings,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): internalExpressionValue => {
switch expressionWithContext {
| ExpressionNoContext(expr) =>
// Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
reducer(expr, bindings, accessors)
| ExpressionWithContext(expr, context) =>
// Js.log(`callReducer: context ${Bindings.toString(context)} expr ${ExpressionT.toString(expr)}`)
reducer(expr, context, accessors)
}
}
// let callReducer = (
// expressionWithContext: expressionWithContext,
// bindings: bindings,
// accessors: ProjectAccessorsT.t,
// reducer: Reducer_T.reducerFn,
// ): Reducer_T.value => {
// switch expressionWithContext {
// | ExpressionNoContext(expr) =>
// // Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
// reducer(expr, bindings, accessors)
// | ExpressionWithContext(expr, context) =>
// // Js.log(`callReducer: context ${Bindings.toString(context)} expr ${ExpressionT.toString(expr)}`)
// reducer(expr, context, accessors)
// }
// }
let withContext = (expression, context) => ExpressionWithContext(expression, context)
let noContext = expression => ExpressionNoContext(expression)
// let withContext = (expression, context) => ExpressionWithContext(expression, context)
// let noContext = expression => ExpressionNoContext(expression)
let toString = expressionWithContext =>
switch expressionWithContext {
| ExpressionNoContext(expr) => ExpressionT.toString(expr)
| ExpressionWithContext(expr, context) =>
`${ExpressionT.toString(expr)} context: ${context
->Bindings.toExpressionValue
->InternalExpressionValue.toString}`
}
// let toString = expressionWithContext =>
// switch expressionWithContext {
// | ExpressionNoContext(expr) => ExpressionT.toString(expr)
// | ExpressionWithContext(expr, context) =>
// `${ExpressionT.toString(expr)} context: ${context
// ->Bindings.toExpressionValue
// ->InternalExpressionValue.toString}`
// }
let toStringResult = rExpressionWithContext =>
switch rExpressionWithContext {
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
| Error(errorValue) => ErrorValue.errorToString(errorValue)
}
// let toStringResult = rExpressionWithContext =>
// switch rExpressionWithContext {
// | Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
// | Error(errorValue) => ErrorValue.errorToString(errorValue)
// }

View File

@ -1,49 +1,49 @@
module ErrorValue = Reducer_ErrorValue
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Bindings = Reducer_Bindings
// module ErrorValue = Reducer_ErrorValue
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module Bindings = Reducer_Bindings
type errorValue = Reducer_ErrorValue.errorValue
type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t
// type errorValue = Reducer_ErrorValue.errorValue
// type expression = ExpressionT.expression
// 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): expression =>
switch expression {
| ExpressionT.EValue(value) => 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
| false => replaceSymbolsOnExpressionList(bindings, list)
}
| _ => replaceSymbolsOnExpressionList(bindings, list)
}
}
// let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression =>
// switch expression {
// | ExpressionT.EValue(value) => 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
// | false => replaceSymbolsOnExpressionList(bindings, list)
// }
// | _ => replaceSymbolsOnExpressionList(bindings, list)
// }
// }
and replaceSymbolsOnExpressionList = (bindings, list) => {
let racc =
list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
replaceSymbols(bindings, each)->Belt.List.add(acc, _)
)
ExpressionT.EList(racc)
}
and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
switch evValue {
| IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)
| IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
| _ => evValue
}
and checkIfCallable = (evValue: internalExpressionValue) =>
switch evValue {
| IEvCall(_) | IEvLambda(_) => evValue
| _ =>
raise(
ErrorValue.ErrorException(
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)),
),
)
}
// and replaceSymbolsOnExpressionList = (bindings, list) => {
// let racc =
// list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
// replaceSymbols(bindings, each)->Belt.List.add(acc, _)
// )
// ExpressionT.EList(racc)
// }
// and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
// switch evValue {
// | IEvSymbol(symbol) => Reducer_Bindings.getWithDefault(bindings, symbol, evValue)
// | IEvCall(symbol) => Reducer_Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
// | _ => evValue
// }
// and checkIfCallable = (evValue: internalExpressionValue) =>
// switch evValue {
// | IEvCall(_) | IEvLambda(_) => evValue
// | _ =>
// raise(
// ErrorValue.ErrorException(
// ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)),
// ),
// )
// }

View File

@ -1,43 +1,32 @@
module BBindingsReplacer = Reducer_Expression_BindingsReplacer
module BErrorValue = Reducer_ErrorValue
module T = Reducer_Expression_T
module BInternalExpressionValue = ReducerInterface_InternalExpressionValue
module BBindings = Reducer_Bindings
module T = Reducer_T
type errorValue = BErrorValue.errorValue
type expression = T.expression
type expressionOrFFI = T.expressionOrFFI
type ffiFn = T.ffiFn
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
type expression = Reducer_T.expression
let eArray = anArray => anArray->BInternalExpressionValue.IEvArray->T.EValue
let eArray = (anArray: array<T.expression>) => anArray->T.EArray
let eArrayString = anArray => anArray->BInternalExpressionValue.IEvArrayString->T.EValue
let eArrayString = anArray => anArray->T.IEvArrayString->T.EValue
let eBindings = (anArray: array<(string, BInternalExpressionValue.t)>) =>
anArray->BBindings.fromArray->BBindings.toExpressionValue->T.EValue
let eBindings = (anArray: array<(string, T.value)>) =>
anArray->Reducer_Bindings.fromArray->Reducer_Bindings.toExpressionValue->T.EValue
let eBool = aBool => aBool->BInternalExpressionValue.IEvBool->T.EValue
let eBool = aBool => aBool->T.IEvBool->T.EValue
let eCall = (name: string): expression =>
name->BInternalExpressionValue.IEvCall->T.EValue
let eFunction = (fName: string, lispArgs: list<expression>): expression => {
let fn = fName->eCall
list{fn, ...lispArgs}->T.EList
}
let eCall = (fn: expression, args: array<expression>): expression =>
T.ECall(fn, args)
let eLambda = (
parameters: array<string>,
expr: expression,
) => {
T.ELambda(parameters, expr)
) => T.ELambda(parameters, expr)
let eNumber = aNumber => aNumber->BInternalExpressionValue.IEvNumber->T.EValue
let eNumber = aNumber => aNumber->T.IEvNumber->T.EValue
let eRecord = aMap => aMap->BInternalExpressionValue.IEvRecord->T.EValue
let eRecord = aMap => aMap->T.IEvRecord->T.EValue
let eString = aString => aString->BInternalExpressionValue.IEvString->T.EValue
let eString = aString => aString->T.IEvString->T.EValue
let eSymbol = (name: string): expression =>
T.ESymbol(name)
@ -45,8 +34,11 @@ let eSymbol = (name: string): expression =>
let eBlock = (exprs: array<expression>): expression =>
T.EBlock(exprs)
let eModule = (nameSpace: BInternalExpressionValue.nameSpace): expression =>
nameSpace->BInternalExpressionValue.IEvBindings->T.EValue
let eProgram = (exprs: array<expression>): expression =>
T.EProgram(exprs)
let eModule = (nameSpace: T.nameSpace): expression =>
nameSpace->T.IEvBindings->T.EValue
let eLetStatement = (symbol: string, valueExpression: expression): expression =>
T.EAssign(symbol, valueExpression)
@ -55,9 +47,9 @@ let eTernary = (predicate: expression, trueCase: expression, falseCase: expressi
T.ETernary(predicate, trueCase, falseCase)
let eIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvSymbol->T.EValue
name->T.ESymbol
let eTypeIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvTypeIdentifier->T.EValue
// let eTypeIdentifier = (name: string): expression =>
// name->T.IEvTypeIdentifier->T.EValue
let eVoid: expression = BInternalExpressionValue.IEvVoid->T.EValue
let eVoid: expression = T.IEvVoid->T.EValue

View File

@ -1,99 +1,53 @@
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module ErrorValue = Reducer_ErrorValue
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module Result = Belt.Result
type expression = ExpressionT.expression
type expressionOrFFI = ExpressionT.expressionOrFFI
type internalExpressionValue = ReducerInterface_InternalExpressionValue.t
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
external castInternalCodeToExpression: internalCode => expressionOrFFI = "%identity"
let checkArity = (
lambdaValue: ExpressionValue.lambdaValue,
args: list<internalExpressionValue>,
) => {
let reallyCheck = {
let argsLength = Belt.List.length(args)
let parametersLength = Js.Array2.length(lambdaValue.parameters)
if argsLength !== parametersLength {
raise(ErrorValue.ErrorException(ErrorValue.REArityError(None, parametersLength, argsLength)))
} else {
args
}
}
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
switch exprOrFFI {
| NotFFI(_) => reallyCheck
| FFI(_) => args
}
}
let checkIfReduced = (args: list<internalExpressionValue>) =>
args->Belt.List.reduceReverse(list{}, (acc, arg) =>
switch arg {
| IEvSymbol(symbol) => raise(ErrorValue.ErrorException(ErrorValue.RESymbolNotFound(symbol)))
| _ => list{arg, ...acc}
}
)
let caseNotFFI = (
lambdaValue: ExpressionValue.lambdaValue,
expr,
args,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => {
let parameterList = lambdaValue.parameters->Belt.List.fromArray
let zippedParameterList = parameterList->Belt.List.zip(args)
let bindings = Belt.List.reduce(zippedParameterList, lambdaValue.context, (
acc,
(variable, variableValue),
) => acc->Bindings.set(variable, variableValue))
let newExpression = ExpressionBuilder.eBlock(list{expr})
reducer(newExpression, bindings, accessors)
}
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
switch ffiFn(args->Belt.List.toArray, accessors.environment) {
| Ok(value) => value
| Error(value) => raise(ErrorValue.ErrorException(value))
}
}
let applyParametersToLambda = (
lambdaValue: ExpressionValue.lambdaValue,
args,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): 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 = (
lambdaValue: ExpressionValue.lambdaValue,
lambdaValue: Reducer_T.lambdaValue,
args,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => applyParametersToLambda(lambdaValue, args, accessors, reducer)
let foreignFunctionInterface = (
lambdaValue: ExpressionValue.lambdaValue,
argArray: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): internalExpressionValue => {
let args = argArray->Belt.List.fromArray
applyParametersToLambda(lambdaValue, args, accessors, reducer)
environment: Reducer_T.environment,
reducer: Reducer_T.reducerFn
): Reducer_T.value => {
lambdaValue.body(args, environment, reducer)
}
let makeLambda = (
parameters: array<string>,
bindings: Reducer_T.nameSpace,
body: Reducer_T.expression,
): Reducer_T.lambdaValue => {
// TODO - clone bindings to avoid later redefinitions affecting lambdas?
// Note: with this implementation, FFI lambdas (created by other methods than calling `makeLambda`) are allowed to violate the rules, pollute the bindings, etc.
// Not sure yet if that's a bug or a feature.
let lambda = (
arguments: array<Reducer_T.value>,
environment: Reducer_T.environment,
reducer: Reducer_T.reducerFn
) => {
let argsLength = arguments->Js.Array2.length
let parametersLength = parameters->Js.Array2.length
if argsLength !== parametersLength {
ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.ErrorException->raise
}
let localBindings = bindings->Reducer_Bindings.extend
parameters->Js.Array2.forEachi(
(parameter, index) => {
let _ = localBindings->Reducer_Bindings.set(parameter, arguments[index])
}
)
reducer(body, { bindings: localBindings, environment })
}
LNoFFI({
context: bindings,
body: lambda,
parameters,
})
}
let makeFFILambda = () => raise(Not_found)

View File

@ -1,26 +1,26 @@
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionWithContext = Reducer_ExpressionWithContext
module Result = Belt.Result
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ExpressionWithContext = Reducer_ExpressionWithContext
// module Result = Belt.Result
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
type environment = InternalExpressionValue.environment
type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t
type expressionWithContext = ExpressionWithContext.expressionWithContext
// type environment = InternalExpressionValue.environment
// type expression = ExpressionT.expression
// type internalExpressionValue = InternalExpressionValue.t
// type expressionWithContext = ExpressionWithContext.expressionWithContext
let doMacroCall = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): internalExpressionValue =>
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression,
bindings,
(accessors: ProjectAccessorsT.t),
(reduceExpression: ProjectReducerFnT.t),
)->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
// let doMacroCall = (
// macroExpression: expression,
// bindings: ExpressionT.bindings,
// accessors: ProjectAccessorsT.t,
// reduceExpression: ProjectReducerFnT.t,
// ): internalExpressionValue =>
// Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
// macroExpression,
// bindings,
// (accessors: ProjectAccessorsT.t),
// (reduceExpression: ProjectReducerFnT.t),
// )->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
// let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")

View File

@ -9,44 +9,38 @@
module Extra = Reducer_Extra
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type internalExpressionValue = InternalExpressionValue.t
type environment = ReducerInterface_InternalExpressionValue.environment
type internalExpressionValue = Reducer_T.value
type environment = Reducer_T.environment
type rec expression =
| EBlock(array<expression>)
| ESymbol(string)
| ETernary(expression, expression, expression)
| EAssign(string, expression)
| ECall(expression, array<expression>)
| ELambda(array<string>, expression)
| EValue(internalExpressionValue)
and bindings = InternalExpressionValue.nameSpace
type expression = Reducer_T.expression
type t = expression
type reducerFn = (
expression,
bindings,
environment,
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue>
type context = Reducer_T.context
type reducerFn = Reducer_T.reducerFn
let commaJoin = values => values->Reducer_Extra_Array.intersperse(", ")->Js.String.concatMany("")
/*
Converts the expression to String
*/
let rec toString = expression => "TODO"
// switch expression {
// | EList(list{EValue(IEvCall("$$_block_$$")), ...statements}) =>
// `{${Belt.List.map(statements, aValue => toString(aValue))
// ->Extra.List.intersperse("; ")
// ->Belt.List.toArray
// ->Js.String.concatMany("")}}`
// | EList(aList) =>
// `(${Belt.List.map(aList, aValue => toString(aValue))
// ->Extra.List.intersperse(" ")
// ->Belt.List.toArray
// ->Js.String.concatMany("")})`
// | EValue(aValue) => InternalExpressionValue.toString(aValue)
// }
let rec toString = (expression: expression) =>
switch expression {
| EBlock(statements) =>
`{${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}}`
| EProgram(statements) =>
`<${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}>`
| EArray(aList) =>
`[${Js.Array2.map(aList, aValue => toString(aValue))->commaJoin}]`
| ERecord(map) => "TODO"
| ESymbol(name) => name
| ETernary(predicate, trueCase, falseCase) => `${predicate->toString} ? (${trueCase->toString}) : (${falseCase->toString})`
| EAssign(name, value) => `${name} = ${value->toString}`
| ECall(fn, args) => `(${fn->toString})(${args->Js.Array2.map(toString)->commaJoin})`
| ELambda(parameters, body) => `{|${parameters->commaJoin}| ${body->toString}}`
| EValue(aValue) => InternalExpressionValue.toString(aValue)
}
let toStringResult = codeResult =>
switch codeResult {

View File

@ -9,25 +9,27 @@ start
zeroOMoreArgumentsBlockOrExpression = innerBlockOrExpression / lambda
// { return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
// {return [h.nodeVoid()];}
outerBlock
= statements:array_statements finalExpression: (statementSeparator @expression)?
{ if (finalExpression != null)
{
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
statements.push(newFinalExpression);
}
else
{
var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]);
statements.push(newFinalStatement);
}
return h.nodeBlock(statements) }
/ finalExpression: expression
{
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
return h.nodeBlock([newFinalExpression])}
{ if (finalExpression) statements.push(finalExpression)
return h.nodeProgram(statements) }
// / '{' _nl finalExpression: expression _nl '}'
// { return h.nodeBlock([finalExpression]) }
// { if (finalExpression != null)
// {
// var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
// statements.push(newFinalExpression);
// }
// else
// {
// var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]);
// statements.push(newFinalStatement);
// }
// return h.nodeBlock(statements) }
// / finalExpression: expression
// {
// var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
// return h.nodeBlock([newFinalExpression])}
innerBlockOrExpression
= quotedInnerBlock
@ -36,7 +38,7 @@ innerBlockOrExpression
quotedInnerBlock
= '{' _nl statements:array_statements finalExpression: (statementSeparator @expression) _nl '}'
{ statements.push(finalExpression)
{ if (finalExpression) statements.push(finalExpression)
return h.nodeBlock(statements) }
/ '{' _nl finalExpression: expression _nl '}'
{ return h.nodeBlock([finalExpression]) }
@ -50,7 +52,7 @@ array_statements
statement
= letStatement
/ defunStatement
/ typeStatement
// / typeStatement
/ voidStatement
voidStatement
@ -337,80 +339,80 @@ statementSeparator 'statement separator'
newLine "newline"
= [\n\r]
// Types
// // Types
noArguments = ('(' _nl ')' )?
// noArguments = ('(' _nl ')' )?
typeIdentifier 'type identifier'
= ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
// typeIdentifier 'type identifier'
// = ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
typeConstructorIdentifier 'type constructor identifier'
= ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
// typeConstructorIdentifier 'type constructor identifier'
// = ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
typeExpression = typePostModifierExpression
// typeExpression = typePostModifierExpression
typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
{
return tail.reduce((result, element) => {
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head)
}
// typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
// {
// return tail.reduce((result, element) => {
// return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
// }, head)
// }
typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
{ return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); }
// typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
// { return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); }
typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
{ return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); }
// typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
// { return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); }
typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
{
return tail.reduce((result, element) => {
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head)
}
// typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
// {
// return tail.reduce((result, element) => {
// return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
// }, head)
// }
typeModifier
= modifier:identifier _ '(' _nl args:array_elements _nl ')'
{ return {modifier: modifier, args: args}; }
/ modifier:identifier _ noArguments
{ return {modifier: modifier, args: []}; }
// typeModifier
// = modifier:identifier _ '(' _nl args:array_elements _nl ')'
// { return {modifier: modifier, args: args}; }
// / modifier:identifier _ noArguments
// { return {modifier: modifier, args: []}; }
basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
// basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
typeArray = '[' _nl elem:typeExpression _nl ']'
{return h.makeFunctionCall('$_typeArray_$', [elem])}
// typeArray = '[' _nl elem:typeExpression _nl ']'
// {return h.makeFunctionCall('$_typeArray_$', [elem])}
typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
{ return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])}
// typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
// { return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])}
array_typeTupleArguments
= head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; }
// array_typeTupleArguments
// = head:typeExpression tail:(_ ',' _nl @typeExpression)*
// { return [head, ...tail]; }
typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
{ return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); }
// typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
// { return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); }
array_typeRecordArguments
= head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
{ return [head, ...tail]; }
// array_typeRecordArguments
// = head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
// { return [head, ...tail]; }
typeKeyValuePair
= key:identifier _ ':' _nl value:typeExpression
{ return h.nodeKeyValue(key, value)}
// typeKeyValuePair
// = key:identifier _ ':' _nl value:typeExpression
// { return h.nodeKeyValue(key, value)}
typeConstructor
= constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); }
/ constructor:typeConstructorIdentifier _ noArguments
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); }
// typeConstructor
// = constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
// { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); }
// / constructor:typeConstructorIdentifier _ noArguments
// { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); }
array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; }
// array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
// { return [head, ...tail]; }
typeStatement = typeAliasStatement / typeOfStatement
typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
{ return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
{ return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
// typeStatement = typeAliasStatement / typeOfStatement
// typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
// { return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
// typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
// { return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}
// typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}

View File

@ -20,6 +20,7 @@ let parse = (expr: string): result<node, errorValue> =>
}
type nodeBlock = {...node, "statements": array<node>}
type nodeProgram = {...node, "statements": array<node>}
type nodeBoolean = {...node, "value": bool}
type nodeCall = {...node, "fn": node, "args": array<node>}
type nodeFloat = {...node, "value": float}
@ -31,11 +32,12 @@ type nodeLetStatement = {...node, "variable": nodeIdentifier, "value": node}
type nodeModuleIdentifier = {...node, "value": string}
type nodeString = {...node, "value": string}
type nodeTernary = {...node, "condition": node, "trueExpression": node, "falseExpression": node}
type nodeTypeIdentifier = {...node, "value": string}
// type nodeTypeIdentifier = {...node, "value": string}
type nodeVoid = node
type peggyNode =
| PgNodeBlock(nodeBlock)
| PgNodeProgram(nodeBlock)
| PgNodeBoolean(nodeBoolean)
| PgNodeFloat(nodeFloat)
| PgNodeCall(nodeCall)
@ -47,10 +49,11 @@ type peggyNode =
| PgNodeModuleIdentifier(nodeModuleIdentifier)
| PgNodeString(nodeString)
| PgNodeTernary(nodeTernary)
| PgNodeTypeIdentifier(nodeTypeIdentifier)
// | PgNodeTypeIdentifier(nodeTypeIdentifier)
| PgNodeVoid(nodeVoid)
external castNodeBlock: node => nodeBlock = "%identity"
external castNodeProgram: node => nodeProgram = "%identity"
external castNodeBoolean: node => nodeBoolean = "%identity"
external castNodeCall: node => nodeCall = "%identity"
external castNodeFloat: node => nodeFloat = "%identity"
@ -62,13 +65,14 @@ external castNodeLetStatement: node => nodeLetStatement = "%identity"
external castNodeModuleIdentifier: node => nodeModuleIdentifier = "%identity"
external castNodeString: node => nodeString = "%identity"
external castNodeTernary: node => nodeTernary = "%identity"
external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
// external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
external castNodeVoid: node => nodeVoid = "%identity"
exception UnsupportedPeggyNodeType(string) // This should never happen; programming error
let castNodeType = (node: node) =>
switch node["type"] {
| "Block" => node->castNodeBlock->PgNodeBlock
| "Program" => node->castNodeBlock->PgNodeProgram
| "Boolean" => node->castNodeBoolean->PgNodeBoolean
| "Call" => node->castNodeCall->PgNodeCall
| "Float" => node->castNodeFloat->PgNodeFloat
@ -80,7 +84,7 @@ let castNodeType = (node: node) =>
| "ModuleIdentifier" => node->castNodeModuleIdentifier->PgNodeModuleIdentifier
| "String" => node->castNodeString->PgNodeString
| "Ternary" => node->castNodeTernary->PgNodeTernary
| "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
// | "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
| "Void" => node->castNodeVoid->PgNodeVoid
| _ => raise(UnsupportedPeggyNodeType(node["type"]))
}
@ -93,7 +97,9 @@ let rec pgToString = (peggyNode: peggyNode): string => {
nodes->Js.Array2.map(toString)->Extra.Array.intersperse(separator)->Js.String.concatMany("")
switch peggyNode {
| PgNodeBlock(node) => "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}"
| PgNodeBlock(node)
| PgNodeProgram(node)
=> "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}"
| PgNodeBoolean(node) => node["value"]->Js.String.make
| PgNodeCall(node) => "(" ++ node["fn"]->toString ++ " " ++ node["args"]->nodesToStringUsingSeparator(" ") ++ ")"
| PgNodeFloat(node) => node["value"]->Js.String.make
@ -113,7 +119,7 @@ let rec pgToString = (peggyNode: peggyNode): string => {
toString(node["trueExpression"]) ++
" " ++
toString(node["falseExpression"]) ++ ")"
| PgNodeTypeIdentifier(node) => `#${node["value"]}`
// | PgNodeTypeIdentifier(node) => `#${node["value"]}`
| PgNodeVoid(_node) => "()"
}
}

View File

@ -2,12 +2,15 @@ module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module Parse = Reducer_Peggy_Parse
type expression = ExpressionT.expression
type expression = Reducer_T.expression
let rec fromNode = (node: Parse.node): expression => {
let caseBlock = nodeBlock =>
ExpressionBuilder.eBlock(nodeBlock["statements"]->Js.Array2.map(fromNode))
let caseProgram = nodeProgram =>
ExpressionBuilder.eProgram(nodeProgram["statements"]->Js.Array2.map(fromNode))
let caseLambda = (nodeLambda: Parse.nodeLambda): expression => {
let args =
nodeLambda["args"]
@ -19,14 +22,14 @@ let rec fromNode = (node: Parse.node): expression => {
switch Parse.castNodeType(node) {
| PgNodeBlock(nodeBlock) => caseBlock(nodeBlock)
| PgNodeProgram(nodeProgram) => caseProgram(nodeProgram)
| PgNodeBoolean(nodeBoolean) => ExpressionBuilder.eBool(nodeBoolean["value"])
| PgNodeExpression(nodeExpression) =>
ExpressionT.EList(nodeExpression["nodes"]->Js.Array2.map(fromNode))
| PgNodeCall(nodeCall) => ExpressionBuilder.eCall(fromNode(nodeCall["fn"]), nodeCall["args"]->Js.Array2.map(fromNode))
| PgNodeFloat(nodeFloat) => ExpressionBuilder.eNumber(nodeFloat["value"])
| PgNodeIdentifier(nodeIdentifier) => ExpressionBuilder.eSymbol(nodeIdentifier["value"])
| PgNodeInteger(nodeInteger) => ExpressionBuilder.eNumber(Belt.Int.toFloat(nodeInteger["value"]))
| PgNodeKeyValue(nodeKeyValue) =>
ExpressionT.EList(list{fromNode(nodeKeyValue["key"]), fromNode(nodeKeyValue["value"])})
ExpressionBuilder.eArray([fromNode(nodeKeyValue["key"]), fromNode(nodeKeyValue["value"])])
| PgNodeLambda(nodeLambda) => caseLambda(nodeLambda)
| PgNodeLetStatement(nodeLetStatement) =>
ExpressionBuilder.eLetStatement(
@ -42,8 +45,8 @@ let rec fromNode = (node: Parse.node): expression => {
fromNode(nodeTernary["trueExpression"]),
fromNode(nodeTernary["falseExpression"])
)
| PgNodeTypeIdentifier(nodeTypeIdentifier) =>
ExpressionBuilder.eTypeIdentifier(nodeTypeIdentifier["value"])
// | PgNodeTypeIdentifier(nodeTypeIdentifier) =>
// ExpressionBuilder.eTypeIdentifier(nodeTypeIdentifier["value"])
| PgNodeVoid(_) => ExpressionBuilder.eVoid
}
}

View File

@ -40,6 +40,11 @@ type NodeBlock = {
statements: AnyPeggyNode[];
};
type NodeProgram = {
type: "Program";
statements: AnyPeggyNode[];
};
type NodeCall = {
type: "Call";
fn: AnyPeggyNode;
@ -99,6 +104,7 @@ type NodeBoolean = {
export type AnyPeggyNode =
| NodeBlock
| NodeProgram
| NodeCall
| NodeFloat
| NodeInteger
@ -111,7 +117,11 @@ export type AnyPeggyNode =
| NodeBoolean;
export function makeFunctionCall(fn: string, args: AnyPeggyNode[]) {
return nodeCall(nodeIdentifier(fn), args);
if (fn === "$$_applyAll_$$") {
return nodeCall(args[0], args.splice(1));
} else {
return nodeCall(nodeIdentifier(fn), args);
}
}
export function constructArray(elems: AnyPeggyNode[]) {
@ -124,6 +134,9 @@ export function constructRecord(elems: AnyPeggyNode[]) {
export function nodeBlock(statements: AnyPeggyNode[]): NodeBlock {
return { type: "Block", statements };
}
export function nodeProgram(statements: AnyPeggyNode[]): NodeProgram {
return { type: "Program", statements };
}
export function nodeBoolean(value: boolean): NodeBoolean {
return { type: "Boolean", value };
}

View File

@ -0,0 +1,53 @@
type environment = GenericDist.env
@genType.opaque
type rec value =
| IEvArray(arrayValue)
| IEvArrayString(array<string>)
| IEvBool(bool)
// | IEvCall(string) // External function call
| IEvDate(Js.Date.t)
| IEvDeclaration(lambdaDeclaration)
| IEvDistribution(DistributionTypes.genericDist)
| IEvLambda(lambdaValue)
| IEvBindings(nameSpace)
| IEvNumber(float)
| IEvRecord(map)
| IEvString(string)
// | IEvSymbol(string)
| IEvTimeDuration(float)
| IEvType(map)
| IEvTypeIdentifier(string)
| IEvVoid
@genType.opaque and arrayValue = array<value>
@genType.opaque and map = Belt.Map.String.t<value>
@genType.opaque and nameSpace = NameSpace(Belt.MutableMap.String.t<value>, option<nameSpace>)
@genType.opaque
and lambdaValue =
| LNoFFI({
parameters: array<string>,
context: nameSpace,
body: (array<value>, environment, reducerFn) => value,
})
| LFFI({
body: (array<value>, environment, reducerFn) => value,
})
@genType.opaque and lambdaDeclaration = Declaration.declaration<lambdaValue>
and expression =
| EBlock(array<expression>)
| EProgram(array<expression>) // programs are similar to blocks, but don't create an inner scope. there can be only one program at the top level of the expression.
| EArray(array<expression>)
| ERecord(Belt.Map.String.t<expression>)
| ESymbol(string)
| ETernary(expression, expression, expression)
| EAssign(string, expression)
| ECall(expression, array<expression>)
| ELambda(array<string>, expression)
| EValue(value)
and context = {
bindings: nameSpace,
environment: environment,
}
and reducerFn = (expression, context) => value

View File

@ -1,42 +1,41 @@
module Bindings = Reducer_Bindings
module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module T = Reducer_Type_T
// module Bindings = Reducer_Bindings
// module ErrorValue = Reducer_ErrorValue
// module Expression = Reducer_Expression
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module T = Reducer_Type_T
let ievFromTypeExpression = (
typeExpressionSourceCode: string,
reducerFn: ProjectReducerFnT.t,
): result<InternalExpressionValue.t, ErrorValue.t> => {
let sIndex = "compiled"
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
let accessors = ProjectAccessorsT.identityAccessors
let result = reducerFn(expr, Bindings.emptyBindings, accessors)
let nameSpace = accessors.states.continuation
// let ievFromTypeExpression = (
// typeExpressionSourceCode: string,
// reducerFn: Reducer_T.reducerFn,
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
// let sIndex = "compiled"
// let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
// Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
// let accessors = ProjectAccessorsT.identityAccessors
// let result = reducerFn(expr, Bindings.emptyBindings, accessors)
// let nameSpace = accessors.states.continuation
switch Bindings.getType(nameSpace, sIndex) {
| Some(value) => value->Ok
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
}
})
}
// switch Bindings.getType(nameSpace, sIndex) {
// | Some(value) => value->Ok
// | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
// }
// })
// }
let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: ProjectReducerFnT.t): result<
T.t,
ErrorValue.t,
> => {
ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue)
}
// let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: Reducer_T.reducerFn): result<
// T.t,
// ErrorValue.t,
// > => {
// ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue)
// }
let fromTypeExpressionExn = (
typeExpressionSourceCode: string,
reducerFn: ProjectReducerFnT.t,
): T.t =>
switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
| Ok(value) => value
| _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
}
// let fromTypeExpressionExn = (
// typeExpressionSourceCode: string,
// reducerFn: Reducer_T.reducerFn,
// ): T.t =>
// switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
// | Ok(value) => value
// | _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
// }

View File

@ -1,119 +1,119 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open InternalExpressionValue
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// open InternalExpressionValue
type rec iType =
| ItTypeIdentifier(string)
| ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>})
| ItTypeOr({typeOr: array<iType>})
| ItTypeFunction({inputs: array<iType>, output: iType})
| ItTypeArray({element: iType})
| ItTypeTuple({elements: array<iType>})
| ItTypeRecord({properties: Belt.Map.String.t<iType>})
// type rec iType =
// | ItTypeIdentifier(string)
// | ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>})
// | ItTypeOr({typeOr: array<iType>})
// | ItTypeFunction({inputs: array<iType>, output: iType})
// | ItTypeArray({element: iType})
// | ItTypeTuple({elements: array<iType>})
// | ItTypeRecord({properties: Belt.Map.String.t<iType>})
type t = iType
type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
// type t = iType
// type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
let rec toString = (t: t): string => {
switch t {
| ItTypeIdentifier(s) => s
| ItModifiedType({modifiedType, contracts}) =>
`${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) =>
Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
)}`
| ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
| ItTypeFunction({inputs, output}) =>
`(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
| ItTypeArray({element}) => `[${toString(element)}]`
| ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
| ItTypeRecord({properties}) =>
`{${properties
->Belt.Map.String.toArray
->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
->Js.Array2.joinWith(", ")}}`
}
}
// let rec toString = (t: t): string => {
// switch t {
// | ItTypeIdentifier(s) => s
// | ItModifiedType({modifiedType, contracts}) =>
// `${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) =>
// Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
// )}`
// | ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
// | ItTypeFunction({inputs, output}) =>
// `(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
// | ItTypeArray({element}) => `[${toString(element)}]`
// | ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
// | ItTypeRecord({properties}) =>
// `{${properties
// ->Belt.Map.String.toArray
// ->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
// ->Js.Array2.joinWith(", ")}}`
// }
// }
let toStringResult = (rt: result<t, ErrorValue.t>) =>
switch rt {
| Ok(t) => toString(t)
| Error(e) => ErrorValue.errorToString(e)
}
// let toStringResult = (rt: result<t, ErrorValue.t>) =>
// switch rt {
// | Ok(t) => toString(t)
// | Error(e) => ErrorValue.errorToString(e)
// }
let rec fromTypeMap = typeMap => {
let default = IEvString("")
let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeTag",
default,
)
let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeIdentifier",
default,
)
let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeOr",
default,
)
let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"inputs",
default,
)
let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"output",
default,
)
let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"element",
default,
)
let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"elements",
default,
)
let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"properties",
default,
)
// let rec fromTypeMap = typeMap => {
// let default = IEvString("")
// let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "typeTag",
// default,
// )
// let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "typeIdentifier",
// default,
// )
// let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "typeOr",
// default,
// )
// let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "inputs",
// default,
// )
// let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "output",
// default,
// )
// let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "element",
// default,
// )
// let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "elements",
// default,
// )
// let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
// typeMap,
// "properties",
// default,
// )
let contracts =
typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
// let contracts =
// typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
let makeIt = switch evTypeTag {
| IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
| IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
| IEvString("typeFunction") =>
ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
| IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
| IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
| IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
}
// let makeIt = switch evTypeTag {
// | IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
// | IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
// | IEvString("typeFunction") =>
// ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
// | IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
// | IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
// | IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
// }
Belt.Map.String.isEmpty(contracts)
? makeIt
: ItModifiedType({modifiedType: makeIt, contracts: contracts})
}
// Belt.Map.String.isEmpty(contracts)
// ? makeIt
// : ItModifiedType({modifiedType: makeIt, contracts: contracts})
// }
and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
switch ievValue {
| IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
| IEvType(typeMap) => fromTypeMap(typeMap)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
}
and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
switch ievArray {
| IEvArray(array) => array->Belt.Array.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
}
and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
switch ievRecord {
| IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
}
// and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
// switch ievValue {
// | IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
// | IEvType(typeMap) => fromTypeMap(typeMap)
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
// }
// and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
// switch ievArray {
// | IEvArray(array) => array->Belt.Array.map(fromIEvValue)
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
// }
// and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
// switch ievRecord {
// | IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
// }

View File

@ -1,80 +1,80 @@
open ReducerInterface_InternalExpressionValue
// open ReducerInterface_InternalExpressionValue
let typeModifier_memberOf = (aType, anArray) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
}
// let typeModifier_memberOf = (aType, anArray) => {
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeIdentifier")),
// ("typeIdentifier", aType),
// ])
// newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
// }
let typeModifier_memberOf_update = (aRecord, anArray) => {
aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
}
// let typeModifier_memberOf_update = (aRecord, anArray) => {
// aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
// }
let typeModifier_min = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
}
// let typeModifier_min = (aType, value) => {
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeIdentifier")),
// ("typeIdentifier", aType),
// ])
// newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
// }
let typeModifier_min_update = (aRecord, value) => {
aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
}
// let typeModifier_min_update = (aRecord, value) => {
// aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
// }
let typeModifier_max = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
}
// let typeModifier_max = (aType, value) => {
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeIdentifier")),
// ("typeIdentifier", aType),
// ])
// newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
// }
let typeModifier_max_update = (aRecord, value) =>
aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
// let typeModifier_max_update = (aRecord, value) =>
// aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
let typeModifier_opaque_update = aRecord =>
aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
// let typeModifier_opaque_update = aRecord =>
// aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
let typeOr = evArray => {
let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
newRecord->IEvType->Ok
}
// let typeOr = evArray => {
// let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
// newRecord->IEvType->Ok
// }
let typeFunction = anArray => {
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeFunction")),
("inputs", IEvArray(inputs)),
("output", output),
])
newRecord->IEvType->Ok
}
// let typeFunction = anArray => {
// let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
// let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeFunction")),
// ("inputs", IEvArray(inputs)),
// ("output", output),
// ])
// newRecord->IEvType->Ok
// }
let typeArray = element => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeArray")),
("element", element),
])
newRecord->IEvType->Ok
}
// let typeArray = element => {
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeArray")),
// ("element", element),
// ])
// newRecord->IEvType->Ok
// }
let typeTuple = anArray => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeTuple")),
("elements", IEvArray(anArray)),
])
newRecord->IEvType->Ok
}
// let typeTuple = anArray => {
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeTuple")),
// ("elements", IEvArray(anArray)),
// ])
// newRecord->IEvType->Ok
// }
let typeRecord = propertyMap => {
let newProperties = propertyMap->IEvRecord
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeRecord")),
("properties", newProperties),
])
newRecord->IEvType->Ok
}
// let typeRecord = propertyMap => {
// let newProperties = propertyMap->IEvRecord
// let newRecord = Belt.Map.String.fromArray([
// ("typeTag", IEvString("typeRecord")),
// ("properties", newProperties),
// ])
// newRecord->IEvType->Ok
// }

View File

@ -1,182 +1,181 @@
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module T = Reducer_Type_T
module TypeContracts = Reducer_Type_Contracts
open InternalExpressionValue
// module ExpressionT = Reducer_Expression_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module T = Reducer_Type_T
// module TypeContracts = Reducer_Type_Contracts
// open InternalExpressionValue
let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
let caseTypeIdentifier = (anUpperTypeName, aValue) => {
let aTypeName = anUpperTypeName->Js.String2.toLowerCase
switch aTypeName {
| "any" => Ok(true)
| _ => {
let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
switch aTypeName == valueTypeName {
| true => Ok(true)
| false => T.TypeMismatch(anIType, aValue)->Error
}
}
}
}
// let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
// let caseTypeIdentifier = (anUpperTypeName, aValue) => {
// let aTypeName = anUpperTypeName->Js.String2.toLowerCase
// switch aTypeName {
// | "any" => Ok(true)
// | _ => {
// let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
// switch aTypeName == valueTypeName {
// | true => Ok(true)
// | false => T.TypeMismatch(anIType, aValue)->Error
// }
// }
// }
// }
let caseRecord = (anIType, propertyMap: Belt.Map.String.t<T.iType>, evValue) =>
switch evValue {
| IEvRecord(aRecord) =>
if (
Js.Array2.length(propertyMap->Belt.Map.String.keysToArray) ==
Js.Array2.length(aRecord->Belt.Map.String.keysToArray)
) {
Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
Belt.Result.flatMap(acc, _ =>
switch Belt.Map.String.get(aRecord, property) {
| Some(propertyValue) => isITypeOf(propertyType, propertyValue)
| None => T.TypeMismatch(anIType, evValue)->Error
}
)
})
} else {
T.TypeMismatch(anIType, evValue)->Error
}
// let caseRecord = (anIType, propertyMap: Belt.Map.String.t<T.iType>, evValue) =>
// switch evValue {
// | IEvRecord(aRecord) =>
// if (
// Js.Array2.length(propertyMap->Belt.Map.String.keysToArray) ==
// Js.Array2.length(aRecord->Belt.Map.String.keysToArray)
// ) {
// Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
// Belt.Result.flatMap(acc, _ =>
// switch Belt.Map.String.get(aRecord, property) {
// | Some(propertyValue) => isITypeOf(propertyType, propertyValue)
// | None => T.TypeMismatch(anIType, evValue)->Error
// }
// )
// })
// } else {
// T.TypeMismatch(anIType, evValue)->Error
// }
| _ => T.TypeMismatch(anIType, evValue)->Error
}
// | _ => T.TypeMismatch(anIType, evValue)->Error
// }
let caseArray = (anIType, elementType, evValue) =>
switch evValue {
| IEvArray(anArray) =>
Belt.Array.reduce(anArray, Ok(true), (acc, element) =>
Belt.Result.flatMap(acc, _ =>
switch isITypeOf(elementType, element) {
| Ok(_) => Ok(true)
| Error(error) => error->Error
}
)
)
| _ => T.TypeMismatch(anIType, evValue)->Error
}
// let caseArray = (anIType, elementType, evValue) =>
// switch evValue {
// | IEvArray(anArray) =>
// Belt.Array.reduce(anArray, Ok(true), (acc, element) =>
// Belt.Result.flatMap(acc, _ =>
// switch isITypeOf(elementType, element) {
// | Ok(_) => Ok(true)
// | Error(error) => error->Error
// }
// )
// )
// | _ => T.TypeMismatch(anIType, evValue)->Error
// }
let caseTuple = (anIType, elementTypes, evValue) =>
switch evValue {
| IEvArray(anArray) =>
if Js.Array2.length(elementTypes) == Js.Array2.length(anArray) {
let zipped = Belt.Array.zip(elementTypes, anArray)
Belt.Array.reduce(zipped, Ok(true), (acc, (elementType, element)) =>
switch acc {
| Ok(_) =>
switch isITypeOf(elementType, element) {
| Ok(_) => acc
| Error(error) => Error(error)
}
| _ => acc
}
)
} else {
T.TypeMismatch(anIType, evValue)->Error
}
| _ => T.TypeMismatch(anIType, evValue)->Error
}
// let caseTuple = (anIType, elementTypes, evValue) =>
// switch evValue {
// | IEvArray(anArray) =>
// if Js.Array2.length(elementTypes) == Js.Array2.length(anArray) {
// let zipped = Belt.Array.zip(elementTypes, anArray)
// Belt.Array.reduce(zipped, Ok(true), (acc, (elementType, element)) =>
// switch acc {
// | Ok(_) =>
// switch isITypeOf(elementType, element) {
// | Ok(_) => acc
// | Error(error) => Error(error)
// }
// | _ => acc
// }
// )
// } else {
// T.TypeMismatch(anIType, evValue)->Error
// }
// | _ => T.TypeMismatch(anIType, evValue)->Error
// }
let caseOr = (anIType, anITypeArray, evValue) =>
switch Belt.Array.reduce(anITypeArray, Ok(false), (acc, anIType) =>
Belt.Result.flatMap(acc, _ =>
switch acc {
| Ok(false) =>
switch isITypeOf(anIType, evValue) {
| Ok(_) => Ok(true)
| Error(_) => acc
}
| _ => acc
}
)
) {
| Ok(true) => Ok(true)
| Ok(false) => T.TypeMismatch(anIType, evValue)->Error
| Error(error) => Error(error)
}
// let caseOr = (anIType, anITypeArray, evValue) =>
// switch Belt.Array.reduce(anITypeArray, Ok(false), (acc, anIType) =>
// Belt.Result.flatMap(acc, _ =>
// switch acc {
// | Ok(false) =>
// switch isITypeOf(anIType, evValue) {
// | Ok(_) => Ok(true)
// | Error(_) => acc
// }
// | _ => acc
// }
// )
// ) {
// | Ok(true) => Ok(true)
// | Ok(false) => T.TypeMismatch(anIType, evValue)->Error
// | Error(error) => Error(error)
// }
let caseModifiedType = (
anIType: T.iType,
modifiedType: T.iType,
contracts: Belt.Map.String.t<InternalExpressionValue.t>,
aValue: InternalExpressionValue.t,
) => {
isITypeOf(modifiedType, aValue)->Belt.Result.flatMap(_result => {
if TypeContracts.checkModifiers(contracts, aValue) {
Ok(true)
} else {
T.TypeMismatch(anIType, aValue)->Error
}
})
}
// let caseModifiedType = (
// anIType: T.iType,
// modifiedType: T.iType,
// contracts: Belt.Map.String.t<InternalExpressionValue.t>,
// aValue: InternalExpressionValue.t,
// ) => {
// isITypeOf(modifiedType, aValue)->Belt.Result.flatMap(_result => {
// if TypeContracts.checkModifiers(contracts, aValue) {
// Ok(true)
// } else {
// T.TypeMismatch(anIType, aValue)->Error
// }
// })
// }
switch anIType {
| ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
| ItModifiedType({modifiedType, contracts}) =>
caseModifiedType(anIType, modifiedType, contracts, aValue) //{modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>}
| ItTypeOr({typeOr}) => caseOr(anIType, typeOr, aValue)
| ItTypeFunction(_) =>
raise(
Reducer_Exception.ImpossibleException(
"Reducer_TypeChecker-functions are without a type at the moment",
),
)
| ItTypeArray({element}) => caseArray(anIType, element, aValue)
| ItTypeTuple({elements}) => caseTuple(anIType, elements, aValue)
| ItTypeRecord({properties}) => caseRecord(anIType, properties, aValue)
}
}
// switch anIType {
// | ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
// | ItModifiedType({modifiedType, contracts}) =>
// caseModifiedType(anIType, modifiedType, contracts, aValue) //{modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>}
// | ItTypeOr({typeOr}) => caseOr(anIType, typeOr, aValue)
// | ItTypeFunction(_) =>
// raise(
// Reducer_Exception.ImpossibleException(
// "Reducer_TypeChecker-functions are without a type at the moment",
// ),
// )
// | ItTypeArray({element}) => caseArray(anIType, element, aValue)
// | ItTypeTuple({elements}) => caseTuple(anIType, elements, aValue)
// | ItTypeRecord({properties}) => caseRecord(anIType, properties, aValue)
// }
// }
let isTypeOf = (
typeExpressionSourceCode: string,
aValue: InternalExpressionValue.t,
reducerFn: ProjectReducerFnT.t,
): result<InternalExpressionValue.t, ErrorValue.t> => {
switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
| Ok(anIType) =>
switch isITypeOf(anIType, aValue) {
| Ok(_) => Ok(aValue)
| Error(T.TypeMismatch(anIType, evValue)) =>
Error(
ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
)
}
| Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
}
}
// let isTypeOf = (
// typeExpressionSourceCode: string,
// aValue: InternalExpressionValue.t,
// reducerFn: Reducer_T.reducerFn,
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
// switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
// | Ok(anIType) =>
// switch isITypeOf(anIType, aValue) {
// | Ok(_) => Ok(aValue)
// | Error(T.TypeMismatch(anIType, evValue)) =>
// Error(
// ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
// )
// }
// | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
// }
// }
let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue.t>): result<
bool,
T.typeErrorValue,
> => {
switch anIType {
| T.ItTypeFunction({inputs}) => isITypeOf(T.ItTypeTuple({elements: inputs}), args->IEvArray)
| _ => T.TypeMismatch(anIType, args->IEvArray)->Error
}
}
// let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue.t>): result<
// bool,
// T.typeErrorValue,
// > => {
// switch anIType {
// | T.ItTypeFunction({inputs}) => isITypeOf(T.ItTypeTuple({elements: inputs}), args->IEvArray)
// | _ => T.TypeMismatch(anIType, args->IEvArray)->Error
// }
// }
let checkITypeArgumentsBool = (anIType: T.iType, args: array<InternalExpressionValue.t>): bool => {
switch checkITypeArguments(anIType, args) {
| Ok(_) => true
| _ => false
}
}
// let checkITypeArgumentsBool = (anIType: T.iType, args: array<InternalExpressionValue.t>): bool => {
// switch checkITypeArguments(anIType, args) {
// | Ok(_) => true
// | _ => false
// }
// }
let checkArguments = (
typeExpressionSourceCode: string,
args: array<InternalExpressionValue.t>,
reducerFn: ProjectReducerFnT.t,
): result<InternalExpressionValue.t, ErrorValue.t> => {
switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
| Ok(anIType) =>
switch checkITypeArguments(anIType, args) {
| Ok(_) => Ok(args->IEvArray)
| Error(T.TypeMismatch(anIType, evValue)) =>
Error(
ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
)
}
| Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
}
}
// let checkArguments = (
// typeExpressionSourceCode: string,
// args: array<InternalExpressionValue.t>,
// reducerFn: ReducerT.reducerFn,
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
// switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
// | Ok(anIType) =>
// switch checkITypeArguments(anIType, args) {
// | Ok(_) => Ok(args->IEvArray)
// | Error(T.TypeMismatch(anIType, evValue)) =>
// Error(
// ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
// )
// }
// | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
// }
// }

View File

@ -1,27 +1,26 @@
module IEV = ReducerInterface_InternalExpressionValue
type internalExpressionValue = IEV.t
module T = Reducer_T
let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
result<internalExpressionValue, QuriSquiggleLang.Reducer_ErrorValue.errorValue>,
let dispatch = (call: ReducerInterface_InternalExpressionValue.functionCall, _: GenericDist.env): option<
result<T.value, Reducer_ErrorValue.errorValue>,
> => {
switch call {
| ("toString", [IEvDate(t)]) => IEV.IEvString(DateTime.Date.toString(t))->Ok->Some
| ("toString", [IEvDate(t)]) => T.IEvString(DateTime.Date.toString(t))->Ok->Some
| ("makeDateFromYear", [IEvNumber(year)]) =>
switch DateTime.Date.makeFromYear(year) {
| Ok(t) => IEV.IEvDate(t)->Ok->Some
| Ok(t) => T.IEvDate(t)->Ok->Some
| Error(e) => Reducer_ErrorValue.RETodo(e)->Error->Some
}
| ("dateFromNumber", [IEvNumber(f)]) => IEV.IEvDate(DateTime.Date.fromFloat(f))->Ok->Some
| ("toNumber", [IEvDate(f)]) => IEV.IEvNumber(DateTime.Date.toFloat(f))->Ok->Some
| ("dateFromNumber", [IEvNumber(f)]) => T.IEvDate(DateTime.Date.fromFloat(f))->Ok->Some
| ("toNumber", [IEvDate(f)]) => T.IEvNumber(DateTime.Date.toFloat(f))->Ok->Some
| ("subtract", [IEvDate(d1), IEvDate(d2)]) =>
switch DateTime.Date.subtract(d1, d2) {
| Ok(d) => IEV.IEvTimeDuration(d)->Ok
| Ok(d) => T.IEvTimeDuration(d)->Ok
| Error(e) => Error(RETodo(e))
}->Some
| ("subtract", [IEvDate(d1), IEvTimeDuration(d2)]) =>
IEV.IEvDate(DateTime.Date.subtractDuration(d1, d2))->Ok->Some
T.IEvDate(DateTime.Date.subtractDuration(d1, d2))->Ok->Some
| ("add", [IEvDate(d1), IEvTimeDuration(d2)]) =>
IEV.IEvDate(DateTime.Date.addDuration(d1, d2))->Ok->Some
T.IEvDate(DateTime.Date.addDuration(d1, d2))->Ok->Some
| _ => None
}
}

View File

@ -1,36 +1,37 @@
module IEV = ReducerInterface_InternalExpressionValue
module T = Reducer_T
type internalExpressionValue = IEV.t
let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
result<internalExpressionValue, QuriSquiggleLang.Reducer_ErrorValue.errorValue>,
let dispatch = (call: IEV.functionCall, _: T.environment): option<
result<Reducer_T.value, Reducer_ErrorValue.errorValue>
> => {
switch call {
| ("toString", [IEvTimeDuration(t)]) => IEV.IEvString(DateTime.Duration.toString(t))->Ok->Some
| ("minutes", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
| ("toString", [IEvTimeDuration(t)]) => T.IEvString(DateTime.Duration.toString(t))->Ok->Some
| ("minutes", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
| ("fromUnit_minutes", [IEvNumber(f)]) =>
IEV.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
| ("hours", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
| ("hours", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
| ("fromUnit_hours", [IEvNumber(f)]) =>
IEV.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
| ("days", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
| ("days", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
| ("fromUnit_days", [IEvNumber(f)]) =>
IEV.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
| ("years", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
| ("years", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
| ("fromUnit_years", [IEvNumber(f)]) =>
IEV.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
| ("toHours", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toHours(f))->Ok->Some
| ("toMinutes", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toMinutes(f))->Ok->Some
| ("toDays", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toDays(f))->Ok->Some
| ("toYears", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toYears(f))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
| ("toHours", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toHours(f))->Ok->Some
| ("toMinutes", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toMinutes(f))->Ok->Some
| ("toDays", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toDays(f))->Ok->Some
| ("toYears", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toYears(f))->Ok->Some
| ("add", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) =>
IEV.IEvTimeDuration(DateTime.Duration.add(d1, d2))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.add(d1, d2))->Ok->Some
| ("subtract", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) =>
IEV.IEvTimeDuration(DateTime.Duration.subtract(d1, d2))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.subtract(d1, d2))->Ok->Some
| ("multiply", [IEvTimeDuration(d1), IEvNumber(d2)]) =>
IEV.IEvTimeDuration(DateTime.Duration.multiply(d1, d2))->Ok->Some
T.IEvTimeDuration(DateTime.Duration.multiply(d1, d2))->Ok->Some
| ("divide", [IEvTimeDuration(d1), IEvNumber(d2)]) =>
IEV.IEvTimeDuration(DateTime.Duration.divide(d1, d2))->Ok->Some
| ("divide", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) => IEV.IEvNumber(d1 /. d2)->Ok->Some
T.IEvTimeDuration(DateTime.Duration.divide(d1, d2))->Ok->Some
| ("divide", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) => T.IEvNumber(d1 /. d2)->Ok->Some
| _ => None
}
}

View File

@ -1,24 +1,21 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
type internalExpressionValue = InternalExpressionValue.t
/*
Map external calls of Reducer
*/
let dispatch = (
call: InternalExpressionValue.functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
environment: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
chain,
): result<internalExpressionValue, 'e> => {
): result<Reducer_T.value, 'e> => {
E.A.O.firstSomeFn([
() => ReducerInterface_GenericDistribution.dispatch(call, accessors.environment),
() => ReducerInterface_Date.dispatch(call, accessors.environment),
() => ReducerInterface_Duration.dispatch(call, accessors.environment),
() => ReducerInterface_Number.dispatch(call, accessors.environment),
() => FunctionRegistry_Library.dispatch(call, accessors, reducer),
])->E.O2.defaultFn(() => chain(call, accessors, reducer))
() => ReducerInterface_GenericDistribution.dispatch(call, environment),
() => ReducerInterface_Date.dispatch(call, environment),
() => ReducerInterface_Duration.dispatch(call, environment),
() => ReducerInterface_Number.dispatch(call, environment),
() => FunctionRegistry_Library.dispatch(call, environment, reducer),
])->E.O2.defaultFn(() => chain(call, environment, reducer))
}
/*
@ -26,7 +23,7 @@ If your dispatch is too big you can divide it into smaller dispatches and pass t
The final chain(call) invokes the builtin default functions of the interpreter.
Via chain(call), all MathJs operators and functions are available for string, number , boolean, array and record
Via chain(call), all MathJs operators and functions are available for string, number, boolean, array and record
.e.g + - / * > >= < <= == /= not and or sin cos log ln concat, etc.
// See https://mathjs.org/docs/expressions/syntax.html

View File

@ -297,12 +297,12 @@ let genericOutputToReducerValue = (o: DistributionOperation.outputType): result<
Reducer_ErrorValue.errorValue,
> =>
switch o {
| Dist(d) => Ok(ReducerInterface_InternalExpressionValue.IEvDistribution(d))
| Dist(d) => Ok(Reducer_T.IEvDistribution(d))
| Float(d) => Ok(IEvNumber(d))
| String(d) => Ok(IEvString(d))
| Bool(d) => Ok(IEvBool(d))
| FloatArray(d) =>
Ok(IEvArray(d |> E.A.fmap(r => ReducerInterface_InternalExpressionValue.IEvNumber(r))))
Ok(IEvArray(d |> E.A.fmap(r => Reducer_T.IEvNumber(r))))
| GenDistError(err) => Error(REDistributionError(err))
}

View File

@ -1,51 +1,26 @@
// deprecated, use Reducer_T instead
// (value methods should be moved to Reducer_Value.res)
module ErrorValue = Reducer_ErrorValue
module Extra_Array = Reducer_Extra_Array
type internalCode = Object
type environment = GenericDist.env
module T = Reducer_T
let defaultEnvironment: environment = DistributionOperation.defaultEnv
@genType.opaque
type rec t =
| IEvArray(array<t>) // FIXME: Convert to MapInt
| IEvArrayString(array<string>)
| IEvBool(bool)
| IEvCall(string) // External function call
| IEvDate(Js.Date.t)
| IEvDeclaration(lambdaDeclaration)
| IEvDistribution(DistributionTypes.genericDist)
| IEvLambda(lambdaValue)
| IEvBindings(nameSpace)
| IEvNumber(float)
| IEvRecord(map)
| IEvString(string)
| IEvSymbol(string)
| IEvTimeDuration(float)
| IEvType(map)
| IEvTypeIdentifier(string)
| IEvVoid
@genType.opaque and squiggleArray = array<t>
@genType.opaque and map = Belt.Map.String.t<t>
@genType.opaque and nameSpace = NameSpace(Belt.MutableMap.String.t<t>, option<nameSpace>)
@genType.opaque
and lambdaValue = {
parameters: array<string>,
context: nameSpace,
body: internalCode,
}
@genType.opaque and lambdaDeclaration = Declaration.declaration<lambdaValue>
type t = Reducer_T.value
type internalExpressionValue = t
type functionCall = (string, array<t>)
let rec toString = aValue =>
let rec toString = (aValue: T.value) =>
switch aValue {
| IEvArray(anArray) => toStringArray(anArray)
| IEvArrayString(anArray) => toStringArrayString(anArray)
| IEvBindings(m) => toStringBindings(m)
| IEvBool(aBool) => toStringBool(aBool)
| IEvCall(fName) => toStringCall(fName)
// | IEvCall(fName) => toStringCall(fName)
| IEvDate(date) => toStringDate(date)
| IEvDeclaration(d) => toStringDeclaration(d)
| IEvDistribution(dist) => toStringDistribution(dist)
@ -53,7 +28,7 @@ let rec toString = aValue =>
| IEvNumber(aNumber) => toStringNumber(aNumber)
| IEvRecord(aMap) => aMap->toStringRecord
| IEvString(aString) => toStringString(aString)
| IEvSymbol(aString) => toStringSymbol(aString)
// | IEvSymbol(aString) => toStringSymbol(aString)
| IEvTimeDuration(t) => toStringTimeDuration(t)
| IEvType(aMap) => toStringType(aMap)
| IEvTypeIdentifier(id) => toStringTypeIdentifier(id)
@ -73,9 +48,12 @@ and toStringCall = fName => `:${fName}`
and toStringDate = date => DateTime.Date.toString(date)
and toStringDeclaration = d => Declaration.toString(d, r => toString(IEvLambda(r)))
and toStringDistribution = dist => GenericDist.toString(dist)
and toStringLambda = lambdaValue =>
`lambda(${Js.Array2.toString(lambdaValue.parameters)}=>internal code)`
and toStringFunction = lambdaValue => `function(${Js.Array2.toString(lambdaValue.parameters)})`
and toStringLambda = (lambdaValue: T.lambdaValue) =>
switch lambdaValue {
| LNoFFI({ parameters }) => `lambda(${parameters->Js.Array2.toString}=>internal code)` // TODO - serialize code too?
| LFFI(_) => `standard function` // TODO - serialize name, etc?
}
and toStringFunction = (lambdaValue: T.lambdaValue) => `function(${Js.Array2.toString(lambdaValue.parameters)})`
and toStringNumber = aNumber => Js.String.make(aNumber)
and toStringRecord = aMap => aMap->toStringMap
and toStringString = aString => `'${aString}'`
@ -94,17 +72,25 @@ and toStringMap = aMap => {
`{${pairs}}`
}
and toStringNameSpace = nameSpace => {
let NameSpace(container, parent) = nameSpace
FIXME_CALL_PARENTS
container->toStringMap
let T.NameSpace(container, parent) = nameSpace
let pairs =
container
->Belt.MutableMap.String.toArray
->Js.Array2.map(((eachKey, eachValue)) => `${eachKey}: ${toString(eachValue)}`)
->Js.Array2.toString
switch parent {
| Some(p) => `{${pairs}} / ${toStringNameSpace(p)}`
| None => `{${pairs}}`
}
}
let toStringWithType = aValue =>
let toStringWithType = (aValue: T.value) =>
switch aValue {
| IEvArray(_) => `Array::${toString(aValue)}`
| IEvArrayString(_) => `ArrayString::${toString(aValue)}`
| IEvBool(_) => `Bool::${toString(aValue)}`
| IEvCall(_) => `Call::${toString(aValue)}`
// | IEvCall(_) => `Call::${toString(aValue)}`
| IEvDate(_) => `Date::${toString(aValue)}`
| IEvDeclaration(_) => `Declaration::${toString(aValue)}`
| IEvDistribution(_) => `Distribution::${toString(aValue)}`
@ -113,7 +99,7 @@ let toStringWithType = aValue =>
| IEvNumber(_) => `Number::${toString(aValue)}`
| IEvRecord(_) => `Record::${toString(aValue)}`
| IEvString(_) => `String::${toString(aValue)}`
| IEvSymbol(_) => `Symbol::${toString(aValue)}`
// | IEvSymbol(_) => `Symbol::${toString(aValue)}`
| IEvTimeDuration(_) => `Date::${toString(aValue)}`
| IEvType(_) => `Type::${toString(aValue)}`
| IEvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}`
@ -154,7 +140,7 @@ type internalExpressionValueType =
| EvtArray
| EvtArrayString
| EvtBool
| EvtCall
// | EvtCall
| EvtDate
| EvtDeclaration
| EvtDistribution
@ -163,7 +149,7 @@ type internalExpressionValueType =
| EvtNumber
| EvtRecord
| EvtString
| EvtSymbol
// | EvtSymbol
| EvtTimeDuration
| EvtType
| EvtTypeIdentifier
@ -173,12 +159,12 @@ type functionCallSignature = CallSignature(string, array<internalExpressionValue
type functionDefinitionSignature =
FunctionDefinitionSignature(functionCallSignature, internalExpressionValueType)
let valueToValueType = value =>
let valueToValueType = (value: T.value) =>
switch value {
| IEvArray(_) => EvtArray
| IEvArrayString(_) => EvtArrayString
| IEvBool(_) => EvtBool
| IEvCall(_) => EvtCall
// | IEvCall(_) => EvtCall
| IEvDate(_) => EvtDate
| IEvDeclaration(_) => EvtDeclaration
| IEvDistribution(_) => EvtDistribution
@ -187,7 +173,7 @@ let valueToValueType = value =>
| IEvNumber(_) => EvtNumber
| IEvRecord(_) => EvtRecord
| IEvString(_) => EvtString
| IEvSymbol(_) => EvtSymbol
// | IEvSymbol(_) => EvtSymbol
| IEvTimeDuration(_) => EvtTimeDuration
| IEvType(_) => EvtType
| IEvTypeIdentifier(_) => EvtTypeIdentifier
@ -204,7 +190,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
| EvtArray => `Array`
| EvtArrayString => `ArrayString`
| EvtBool => `Bool`
| EvtCall => `Call`
// | EvtCall => `Call`
| EvtDate => `Date`
| EvtDeclaration => `Declaration`
| EvtDistribution => `Distribution`
@ -213,7 +199,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
| EvtNumber => `Number`
| EvtRecord => `Record`
| EvtString => `String`
| EvtSymbol => `Symbol`
// | EvtSymbol => `Symbol`
| EvtTimeDuration => `Duration`
| EvtType => `Type`
| EvtTypeIdentifier => `TypeIdentifier`
@ -227,10 +213,4 @@ let functionCallSignatureToString = (functionCallSignature: functionCallSignatur
let arrayToValueArray = (arr: array<t>): array<t> => arr
let recordToKeyValuePairs = (record: map): array<(string, t)> => record->Belt.Map.String.toArray
let nameSpaceToKeyValuePairs = (nameSpace: nameSpace): array<(string, t)> => {
let NameSpace(container, parent) = nameSpace
FIXME_CALL_PARENTS
container->Belt.MutableMap.String.toArray
}
let recordToKeyValuePairs = (record: T.map): array<(string, t)> => record->Belt.Map.String.toArray

View File

@ -39,7 +39,7 @@ let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
| "fromUnit_P") as op,
[IEvNumber(f)],
) =>
op->ScientificUnit.getMultiplier->E.O2.fmap(multiplier => IEV.IEvNumber(f *. multiplier)->Ok)
op->ScientificUnit.getMultiplier->E.O2.fmap(multiplier => Reducer_T.IEvNumber(f *. multiplier)->Ok)
| _ => None
}
}

View File

@ -1,4 +1,4 @@
module Bindings = Reducer_Bindings
let internalStdLib: Bindings.t =
Bindings.emptyBindings->SquiggleLibrary_Math.makeBindings->SquiggleLibrary_Versions.makeBindings
let internalStdLib: Reducer_Bindings.t =
Reducer_Bindings.makeEmptyBindings()
->SquiggleLibrary_Math.makeBindings
->SquiggleLibrary_Versions.makeBindings

View File

@ -1,8 +1,8 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type t = InternalExpressionValue.nameSpace
type t = Reducer_T.nameSpace
let toValue = nameSpace => InternalExpressionValue.IEvBindings(nameSpace)
let toValue = nameSpace => Reducer_T.IEvBindings(nameSpace)
let toString = nameSpace => InternalExpressionValue.toString(toValue(nameSpace))
let toStringResult = rNameSpace =>
Belt.Result.map(rNameSpace, toValue(_))->InternalExpressionValue.toStringResult
@ -19,9 +19,3 @@ let inspectOption = (oNameSpace, label: string) =>
| Some(nameSpace) => inspect(nameSpace, label)
| None => Js.log(`${label}: None`)
}
let minus = (NameSpace(thisContainer): t, NameSpace(thatContainer): t) => {
InternalExpressionValue.NameSpace(
Belt.Map.String.removeMany(thisContainer, Belt.Map.String.keysToArray(thatContainer)),
)
}

View File

@ -4,263 +4,247 @@ module Bindings = Reducer_Bindings
module Continuation = ReducerInterface_Value_Continuation
module ErrorValue = Reducer_ErrorValue
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectItem = ReducerProject_ProjectItem
module T = ReducerProject_T
module Topology = ReducerProject_Topology
type t = T.t
module Private = {
type internalProject = T.Private.t
type t = T.Private.t
let getItem = T.getItem
let getSourceIds = T.getSourceIds
let getDependents = Topology.getDependents
let getDependencies = Topology.getDependencies
let getRunOrder = Topology.getRunOrder
let getRunOrderFor = Topology.getRunOrderFor
let getSourceIds = T.Private.getSourceIds
let getItem = T.Private.getItem
let getDependents = Topology.getDependents
let getDependencies = Topology.getDependencies
let getRunOrder = Topology.getRunOrder
let getRunOrderFor = Topology.getRunOrderFor
let createProject = () => {
let project: t = {
items: Belt.MutableMap.String.make(),
stdLib: ReducerInterface_StdLib.internalStdLib,
environment: InternalExpressionValue.defaultEnvironment,
previousRunOrder: [],
}
project
}
let createProject = () => {
let project: t = {
"iAmProject": true,
"items": Belt.Map.String.empty,
"stdLib": ReducerInterface_StdLib.internalStdLib,
"environment": InternalExpressionValue.defaultEnvironment,
"previousRunOrder": [],
}
project
// will not be necessary when ProjectItem becomes mutable
let setItem = (project: t, sourceId: string, item: ProjectItem.t): unit => {
let _ = Belt.MutableMap.String.set(project.items, sourceId, item)
}
let rec touchSource_ = (project: t, sourceId: string): unit => {
let item = project->getItem(sourceId)
let newItem = ProjectItem.touchSource(item)
project->setItem(sourceId, newItem)
}
and touchDependents = (project: t, sourceId: string): unit => {
let _ = getDependents(project, sourceId)->Belt.Array.forEach(_, touchSource_(project, _))
}
let touchSource = (project: t, sourceId: string): unit => {
touchSource_(project, sourceId)
touchDependents(project, sourceId)
}
let handleNewTopology = (project: t): unit => {
let previousRunOrder = project.previousRunOrder
let currentRunOrder = Topology.getRunOrder(project)
let diff = Topology.runOrderDiff(currentRunOrder, previousRunOrder)
Belt.Array.forEach(diff, touchSource(project, _))
project.previousRunOrder = currentRunOrder
}
let getSource = (project: t, sourceId: string): option<string> =>
Belt.MutableMap.String.get(project.items, sourceId)->Belt.Option.map(ProjectItem.getSource)
let setSource = (project: t, sourceId: string, value: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setSource(value)
project->setItem(sourceId, newItem)
touchDependents(project, sourceId)
}
let clean = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.clean
project->setItem(sourceId, newItem)
}
let cleanAll = (project: t): unit =>
project->getSourceIds->Belt.Array.forEach(sourceId => clean(project, sourceId))
let cleanResults = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.cleanResults
project->setItem(sourceId, newItem)
}
let cleanAllResults = (project: t): unit =>
project->getSourceIds->Belt.Array.forEach(sourceId => project->cleanResults(sourceId))
let getIncludes = (project: t, sourceId: string): ProjectItem.T.includesType =>
project->getItem(sourceId)->ProjectItem.getIncludes
let getPastChain = (project: t, sourceId: string): array<string> =>
project->getItem(sourceId)->ProjectItem.getPastChain
let getIncludesAsVariables = (
project: t,
sourceId: string,
): ProjectItem.T.importAsVariablesType =>
project->getItem(sourceId)->ProjectItem.getIncludesAsVariables
let getDirectIncludes = (project: t, sourceId: string): array<string> =>
project->getItem(sourceId)->ProjectItem.getDirectIncludes
let setContinues = (project: t, sourceId: string, continues: array<string>): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setContinues(continues)
project->setItem(sourceId, newItem)
handleNewTopology(project)
}
let getContinues = (project: t, sourceId: string): array<string> =>
ProjectItem.getContinues(project->getItem(sourceId))
let removeContinues = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.removeContinues
project->setItem(sourceId, newItem)
handleNewTopology(project)
}
let getContinuation = (project: t, sourceId: string): ProjectItem.T.continuationArgumentType =>
project->getItem(sourceId)->ProjectItem.getContinuation
let setContinuation = (
project: t,
sourceId: string,
continuation: ProjectItem.T.continuationArgumentType,
): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setContinuation(continuation)
project->setItem(sourceId, newItem)
}
let getResultOption = (project: t, sourceId: string): ProjectItem.T.resultType =>
project->getItem(sourceId)->ProjectItem.getResult
let getResult = (project: t, sourceId: string): ProjectItem.T.resultArgumentType =>
switch getResultOption(project, sourceId) {
| None => RENeedToRun->Error
| Some(result) => result
}
let rec touchSource_ = (project: t, sourceId: string): unit => {
let item = project->getItem(sourceId)
let newItem = ProjectItem.touchSource(item)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
and touchDependents = (project: t, sourceId: string): unit => {
let _ = getDependents(project, sourceId)->Belt.Array.forEach(_, touchSource_(project, _))
let setResult = (project: t, sourceId: string, value: ProjectItem.T.resultArgumentType): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setResult(value)
project->setItem(sourceId, newItem)
}
let parseIncludes = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.parseIncludes
project->setItem(sourceId, newItem)
handleNewTopology(project)
}
let rawParse = (project: t, sourceId): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.rawParse
project->setItem(sourceId, newItem)
}
let getStdLib = (project: t): Reducer_Bindings.t => project.stdLib
let setStdLib = (project: t, value: Reducer_Bindings.t): unit => {
project.stdLib = value
}
let getEnvironment = (project: t): InternalExpressionValue.environment => project.environment
let setEnvironment = (project: t, value: InternalExpressionValue.environment): unit => {
project.environment = value
}
let getBindings = (project: t, sourceId: string): ProjectItem.T.bindingsArgumentType => {
project->getContinuation(sourceId) // TODO - locals method for cleaning parent?
}
let getContinuationsBefore = (project: t, sourceId: string): array<
ProjectItem.T.continuation,
> => {
let pastNameSpaces = project->getPastChain(sourceId)->Js.Array2.map(getBindings(project, _))
let theLength = pastNameSpaces->Js.Array2.length
if theLength == 0 {
// `getContinuationBefore ${sourceId}: stdLib`->Js.log
[project->getStdLib]
} else {
// `getContinuationBefore ${sourceId}: ${lastOne} = ${InternalExpressionValue.toStringBindings(
// project->getBindings(lastOne),
// )}`->Js.log
pastNameSpaces
}
}
let touchSource = (project: t, sourceId: string): unit => {
touchSource_(project, sourceId)
touchDependents(project, sourceId)
}
let handleNewTopology = (project: t): unit => {
let previousRunOrder = project["previousRunOrder"]
let currentRunOrder = Topology.getRunOrder(project)
let diff = Topology.runOrderDiff(currentRunOrder, previousRunOrder)
Belt.Array.forEach(diff, touchSource(project, _))
T.Private.setFieldPreviousRunOrder(project, currentRunOrder)
}
let getSource = (project: t, sourceId: string): option<string> =>
Belt.Map.String.get(project["items"], sourceId)->Belt.Option.map(ProjectItem.getSource)
let setSource = (project: t, sourceId: string, value: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setSource(value)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
touchDependents(project, sourceId)
}
let clean = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.clean
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
let cleanAll = (project: t): unit =>
getSourceIds(project)->Belt.Array.forEach(sourceId => clean(project, sourceId))
let cleanResults = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.cleanResults
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
let cleanAllResults = (project: t): unit =>
getSourceIds(project)->Belt.Array.forEach(sourceId => cleanResults(project, sourceId))
let getIncludes = (project: t, sourceId: string): ProjectItem.T.includesType =>
project->getItem(sourceId)->ProjectItem.getIncludes
// let getDirectIncludes = (project: t, sourceId: string): array<string> =>
// project->getItem(sourceId)->ProjectItem.getDirectIncludes
let getPastChain = (project: t, sourceId: string): array<string> =>
project->getItem(sourceId)->ProjectItem.getPastChain
let getIncludesAsVariables = (
project: t,
sourceId: string,
): ProjectItem.T.importAsVariablesType =>
project->getItem(sourceId)->ProjectItem.getIncludesAsVariables
let getDirectIncludes = (project: t, sourceId: string): array<string> =>
project->getItem(sourceId)->ProjectItem.getDirectIncludes
let setContinues = (project: t, sourceId: string, continues: array<string>): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setContinues(continues)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
handleNewTopology(project)
}
let getContinues = (project: t, sourceId: string): array<string> =>
ProjectItem.getContinues(project->getItem(sourceId))
let removeContinues = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.removeContinues
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
handleNewTopology(project)
}
let getContinuation = (project: t, sourceId: string): ProjectItem.T.continuationArgumentType =>
project->getItem(sourceId)->ProjectItem.getContinuation
let setContinuation = (
project: t,
sourceId: string,
continuation: ProjectItem.T.continuationArgumentType,
): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setContinuation(continuation)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
let getResultOption = (project: t, sourceId: string): ProjectItem.T.resultType =>
project->getItem(sourceId)->ProjectItem.getResult
let getResult = (project: t, sourceId: string): ProjectItem.T.resultArgumentType =>
switch getResultOption(project, sourceId) {
| None => RENeedToRun->Error
| Some(result) => result
}
let setResult = (project: t, sourceId: string, value: ProjectItem.T.resultArgumentType): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.setResult(value)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
let parseIncludes = (project: t, sourceId: string): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.parseIncludes
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
handleNewTopology(project)
}
let rawParse = (project: t, sourceId): unit => {
let newItem = project->getItem(sourceId)->ProjectItem.rawParse
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
}
let getStdLib = (project: t): Reducer_Bindings.t => project["stdLib"]
let setStdLib = (project: t, value: Reducer_Bindings.t): unit =>
T.Private.setFieldStdLib(project, value)
let getEnvironment = (project: t): InternalExpressionValue.environment => project["environment"]
let setEnvironment = (project: t, value: InternalExpressionValue.environment): unit =>
T.Private.setFieldEnvironment(project, value)
let getBindings = (project: t, sourceId: string): ProjectItem.T.bindingsArgumentType => {
let those = project->getContinuation(sourceId)
let these = project->getStdLib
let ofUser = Continuation.minus(those, these)
ofUser
}
let buildProjectAccessors = (project: t): ProjectAccessorsT.t => {
states: {continuation: Bindings.emptyBindings},
stdLib: getStdLib(project),
environment: getEnvironment(project),
}
let getContinuationsBefore = (project: t, sourceId: string): array<
ProjectItem.T.continuation,
> => {
let pastNameSpaces = project->getPastChain(sourceId)->Belt.Array.map(getBindings(project, _))
let theLength = Belt.Array.length(pastNameSpaces)
if theLength == 0 {
// `getContinuationBefore ${sourceId}: stdLib`->Js.log
[project->getStdLib]
} else {
// `getContinuationBefore ${sourceId}: ${lastOne} = ${InternalExpressionValue.toStringBindings(
// project->getBindings(lastOne),
// )}`->Js.log
pastNameSpaces
}
}
let linkDependencies = (project: t, sourceId: string): ProjectItem.T.continuation => {
module NameSpace = Reducer_Bindings
let continuationsBefore = project->getContinuationsBefore(sourceId)
let nameSpace = NameSpace.emptyNameSpace->NameSpace.chainTo(continuationsBefore)
let includesAsVariables = project->getIncludesAsVariables(sourceId)
Belt.Array.reduce(includesAsVariables, nameSpace, (currentNameSpace, (variable, includeFile)) =>
Bindings.set(
currentNameSpace,
variable,
getBindings(project, includeFile)->InternalExpressionValue.IEvBindings,
)
let linkDependencies = (project: t, sourceId: string): ProjectItem.T.continuation => {
let continuationsBefore = project->getContinuationsBefore(sourceId)
let nameSpace = Reducer_Bindings.makeEmptyBindings()->Reducer_Bindings.chainTo(continuationsBefore)
let includesAsVariables = project->getIncludesAsVariables(sourceId)
Belt.Array.reduce(includesAsVariables, nameSpace, (currentNameSpace, (variable, includeFile)) =>
Bindings.set(
currentNameSpace,
variable,
getBindings(project, includeFile)->Reducer_T.IEvBindings,
)
}
)
}
let doLinkAndRun = (project: t, sourceId: string): unit => {
let accessors = buildProjectAccessors(project)
let states = accessors.states
let continuation = linkDependencies(project, sourceId)
let newItem = project->getItem(sourceId)->ProjectItem.run(continuation, accessors)
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
setContinuation(project, sourceId, states.continuation)
}
let doLinkAndRun = (project: t, sourceId: string): unit => {
let context = Reducer_Context.createContext(project->getStdLib, project->getEnvironment)
// FIXME: fill context with dependencies
// let continuation = linkDependencies(project, sourceId)
let newItem = project->getItem(sourceId)->ProjectItem.run(context)
Js.log("after run " ++ newItem.continuation->Reducer_Bindings.toString)
project->setItem(sourceId, newItem)
}
type runState = ProjectItem.T.resultArgumentType
type runState = ProjectItem.T.resultArgumentType
let tryRunWithResult = (
project: t,
sourceId: string,
rPrevResult: ProjectItem.T.resultArgumentType,
): ProjectItem.T.resultArgumentType => {
switch getResultOption(project, sourceId) {
| Some(result) => result // already ran
| None =>
switch rPrevResult {
| Error(error) => {
setResult(project, sourceId, Error(error))
Error(error)
}
| Ok(_prevResult) => {
doLinkAndRun(project, sourceId)
getResultOption(project, sourceId)->Belt.Option.getWithDefault(rPrevResult)
}
let tryRunWithResult = (
project: t,
sourceId: string,
rPrevResult: ProjectItem.T.resultArgumentType,
): ProjectItem.T.resultArgumentType => {
switch getResultOption(project, sourceId) {
| Some(result) => result // already ran
| None =>
switch rPrevResult {
| Error(error) => {
setResult(project, sourceId, Error(error))
Error(error)
}
| Ok(_prevResult) => {
doLinkAndRun(project, sourceId)
getResultOption(project, sourceId)->Belt.Option.getWithDefault(rPrevResult)
}
}
}
let runAll = (project: t): unit => {
let runOrder = Topology.getRunOrder(project)
let initialState = Ok(InternalExpressionValue.IEvVoid)
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
tryRunWithResult(project, currId, currState)
)
}
let run = (project: t, sourceId: string): unit => {
let runOrder = Topology.getRunOrderFor(project, sourceId)
let initialState = Ok(InternalExpressionValue.IEvVoid)
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
tryRunWithResult(project, currId, currState)
)
}
let evaluate = (sourceCode: string) => {
let project = createProject()
setSource(project, "main", sourceCode)
runAll(project)
let those = project->getContinuation("main")
let these = project->getStdLib
let ofUser = Continuation.minus(those, these)
(
getResultOption(project, "main")->Belt.Option.getWithDefault(
InternalExpressionValue.IEvVoid->Ok,
),
ofUser,
)
}
}
let runAll = (project: t): unit => {
let runOrder = Topology.getRunOrder(project)
let initialState = Ok(Reducer_T.IEvVoid)
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
tryRunWithResult(project, currId, currState)
)
}
let run = (project: t, sourceId: string): unit => {
let runOrder = Topology.getRunOrderFor(project, sourceId)
let initialState = Ok(Reducer_T.IEvVoid)
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
tryRunWithResult(project, currId, currState)
)
}
let evaluate = (sourceCode: string) => {
let project = createProject()
setSource(project, "main", sourceCode)
runAll(project)
(
getResultOption(project, "main")->Belt.Option.getWithDefault(
Reducer_T.IEvVoid->Ok,
),
project->getBindings("main")
)
}

View File

@ -1,40 +1,30 @@
module ProjectItemT = ReducerProject_ProjectItem_T
module Bindings = Reducer_Bindings
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
// module ProjectItemT = ReducerProject_ProjectItem_T
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type states = {mutable continuation: ProjectItemT.continuationArgumentType}
// type states = {mutable continuation: ProjectItemT.continuationArgumentType}
type projectAccessors = {
stdLib: Reducer_Bindings.t,
environment: ExpressionT.environment,
states: states,
}
// type projectAccessors = {
// stdLib: Reducer_Bindings.t,
// environment: Reducer_T.environment,
// states: states,
// }
type t = projectAccessors
// type t = projectAccessors
let identityAccessors: t = {
// We need the states at the end of the runtime.
// Accessors can be modified but states will stay as the same pointer
states: {
continuation: Bindings.emptyBindings,
},
stdLib: ReducerInterface_StdLib.internalStdLib,
environment: InternalExpressionValue.defaultEnvironment,
}
// let identityAccessors: t = {
// // We need the states at the end of the runtime.
// // Accessors can be modified but states will stay as the same pointer
// states: {
// continuation: Reducer_Bindings.emptyBindings,
// },
// stdLib: ReducerInterface_StdLib.internalStdLib,
// environment: InternalExpressionValue.defaultEnvironment,
// }
let identityAccessorsWithEnvironment = (environment): t => {
states: {
continuation: Bindings.emptyBindings,
},
stdLib: ReducerInterface_StdLib.internalStdLib,
environment: environment,
}
// to support change of environment in runtime
let setEnvironment = (this: t, environment: ExpressionT.environment): t => {
{
...this,
environment: environment,
}
}
// // to support change of environment in runtime
// let setEnvironment = (this: t, environment: Reducer_T.environment): t => {
// {
// ...this,
// environment: environment,
// }
// }

View File

@ -1,69 +1,60 @@
// TODO: Use actual types instead of aliases in public functions
// TODO: Use topological sorting to prevent unnecessary runs
module Bindings = Reducer_Bindings
module Continuation = ReducerInterface_Value_Continuation
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ReducerFnT = ReducerProject_ReducerFn_T
module T = ReducerProject_ProjectItem_T
type projectItem = T.projectItem
type t = T.t
let emptyItem = T.ProjectItem({
let emptyItem: projectItem = {
source: "",
rawParse: None,
expression: None,
continuation: Bindings.emptyBindings,
continuation: Reducer_Bindings.makeEmptyBindings(),
result: None,
continues: [],
includes: []->Ok,
directIncludes: [],
includeAsVariables: [],
})
}
// source -> rawParse -> includes -> expression -> continuation -> result
let getSource = (T.ProjectItem(r)): T.sourceType => r.source
let getRawParse = (T.ProjectItem(r)): T.rawParseType => r.rawParse
let getExpression = (T.ProjectItem(r)): T.expressionType => r.expression
let getContinuation = (T.ProjectItem(r)): T.continuationArgumentType => r.continuation
let getResult = (T.ProjectItem(r)): T.resultType => r.result
let getSource = (r: t): T.sourceType => r.source
let getRawParse = (r: t): T.rawParseType => r.rawParse
let getExpression = (r: t): T.expressionType => r.expression
let getContinuation = (r: t): T.continuationArgumentType => r.continuation
let getResult = (r: t): T.resultType => r.result
let getContinues = (T.ProjectItem(r)): T.continuesType => r.continues
let getIncludes = (T.ProjectItem(r)): T.includesType => r.includes
let getDirectIncludes = (T.ProjectItem(r)): array<string> => r.directIncludes
let getIncludesAsVariables = (T.ProjectItem(r)): T.importAsVariablesType => r.includeAsVariables
let getContinues = (r: t): T.continuesType => r.continues
let getIncludes = (r: t): T.includesType => r.includes
let getDirectIncludes = (r: t): array<string> => r.directIncludes
let getIncludesAsVariables = (r: t): T.importAsVariablesType => r.includeAsVariables
let touchSource = (this: t): t => {
let T.ProjectItem(r) = emptyItem
T.ProjectItem({
let r = emptyItem
{
...r,
source: getSource(this),
continues: getContinues(this),
includes: getIncludes(this),
includeAsVariables: getIncludesAsVariables(this),
directIncludes: getDirectIncludes(this),
})
}
}
let touchRawParse = (this: t): t => {
let T.ProjectItem(r) = emptyItem
T.ProjectItem({
...r,
{
...emptyItem,
source: getSource(this),
continues: getContinues(this),
includes: getIncludes(this),
includeAsVariables: getIncludesAsVariables(this),
directIncludes: getDirectIncludes(this),
rawParse: getRawParse(this),
})
}
}
let touchExpression = (this: t): t => {
let T.ProjectItem(r) = emptyItem
T.ProjectItem({
...r,
{
...this,
source: getSource(this),
continues: getContinues(this),
includes: getIncludes(this),
@ -71,46 +62,40 @@ let touchExpression = (this: t): t => {
directIncludes: getDirectIncludes(this),
rawParse: getRawParse(this),
expression: getExpression(this),
})
}
}
let resetIncludes = (T.ProjectItem(r): t): t => {
T.ProjectItem({
...r,
includes: []->Ok,
includeAsVariables: [],
directIncludes: [],
})
let resetIncludes = (r: t): t => {
...r,
includes: []->Ok,
includeAsVariables: [],
directIncludes: [],
}
let setSource = (T.ProjectItem(r): t, source: T.sourceArgumentType): t =>
T.ProjectItem({...r, source: source})->resetIncludes->touchSource
let setSource = (r: t, source: T.sourceArgumentType): t =>
{...r, source: source}->resetIncludes->touchSource
let setRawParse = (T.ProjectItem(r): t, rawParse: T.rawParseArgumentType): t =>
T.ProjectItem({...r, rawParse: Some(rawParse)})->touchRawParse
let setRawParse = (r: t, rawParse: T.rawParseArgumentType): t =>
{...r, rawParse: Some(rawParse)}->touchRawParse
let setExpression = (T.ProjectItem(r): t, expression: T.expressionArgumentType): t =>
T.ProjectItem({...r, expression: Some(expression)})->touchExpression
let setExpression = (r: t, expression: T.expressionArgumentType): t =>
{...r, expression: Some(expression)}->touchExpression
let setContinuation = (T.ProjectItem(r): t, continuation: T.continuationArgumentType): t => {
T.ProjectItem({...r, continuation: continuation})
}
let setContinuation = (r: t, continuation: T.continuationArgumentType): t =>
{...r, continuation: continuation}
let setResult = (T.ProjectItem(r): t, result: T.resultArgumentType): t => T.ProjectItem({
let setResult = (r: t, result: T.resultArgumentType): t => {
...r,
result: Some(result),
})
}
let cleanResults = touchExpression
let clean = (this: t): t => {
let T.ProjectItem(r) = emptyItem
T.ProjectItem({
...r,
source: getSource(this),
continuation: getContinuation(this),
result: getResult(this),
})
...this,
source: getSource(this),
continuation: getContinuation(this),
result: getResult(this),
}
let getImmediateDependencies = (this: t): T.includesType =>
@ -120,27 +105,27 @@ let getPastChain = (this: t): array<string> => {
Js.Array2.concat(getDirectIncludes(this), getContinues(this))
}
let setContinues = (T.ProjectItem(r): t, continues: array<string>): t =>
T.ProjectItem({...r, continues: continues})->touchSource
let removeContinues = (T.ProjectItem(r): t): t => T.ProjectItem({...r, continues: []})->touchSource
let setContinues = (this: t, continues: array<string>): t =>
{...this, continues: continues}->touchSource
let setIncludes = (T.ProjectItem(r): t, includes: T.includesType): t => T.ProjectItem({
...r,
let removeContinues = (this: t): t => {...this, continues: []}->touchSource
let setIncludes = (this: t, includes: T.includesType): t => {
...this,
includes: includes,
})
}
let setImportAsVariables = (
T.ProjectItem(r): t,
this: t,
includeAsVariables: T.importAsVariablesType,
): t => T.ProjectItem({...r, includeAsVariables: includeAsVariables})
): t => {...this, includeAsVariables: includeAsVariables}
let setDirectImports = (T.ProjectItem(r): t, directIncludes: array<string>): t => T.ProjectItem({
...r,
let setDirectImports = (this: t, directIncludes: array<string>): t => {
...this,
directIncludes: directIncludes,
})
}
let parseIncludes = (this: t): t => {
let T.ProjectItem(r) = this
let rRawImportAsVariables = getSource(this)->ReducerProject_ParseIncludes.parseIncludes
switch rRawImportAsVariables {
| Error(e) => resetIncludes(this)->setIncludes(Error(e))
@ -152,12 +137,12 @@ let parseIncludes = (this: t): t => {
rawImportAsVariables
->Belt.Array.keep(((variable, _file)) => variable == "")
->Belt.Array.map(((_variable, file)) => file)
T.ProjectItem({
...r,
{
...this,
includes: includes,
includeAsVariables: includeAsVariables,
directIncludes: directIncludes,
})
}
}
}
}
@ -172,45 +157,48 @@ let doBuildExpression = (this: t): T.expressionType =>
->Belt.Option.map(o => o->Belt.Result.map(r => r->Reducer_Peggy_ToExpression.fromNode))
let buildExpression = (this: t): t => {
let withRawParse: t = this->rawParse
switch withRawParse->getExpression {
| Some(_) => withRawParse
let this = this->rawParse
switch this->getExpression {
| Some(_) => this // cached
| None =>
withRawParse
this
->doBuildExpression
->Belt.Option.map(setExpression(withRawParse, _))
->E.O2.defaultFn(() => withRawParse)
->Belt.Option.map(setExpression(this, _))
->E.O2.defaultFn(() => this)
}
}
let doBuildResult = (
let failRun = (
this: t,
aContinuation: T.continuation,
accessors: ProjectAccessorsT.t,
): T.resultType =>
this
->getExpression
->Belt.Option.map(
Belt.Result.flatMap(_, expression =>
try {
Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
} catch {
| Reducer_ErrorValue.ErrorException(e) => e->Error
| _ => RETodo("unhandled rescript exception")->Error
}
),
)
e: Reducer_ErrorValue.errorValue
): t => this->setResult(e->Error)->setContinuation(Reducer_Bindings.makeEmptyBindings())
let buildResult = (this: t, aContinuation: T.continuation, accessors: ProjectAccessorsT.t): t => {
let withExpression: t = this->buildExpression
switch withExpression->getResult {
| Some(_) => withExpression
| None =>
withExpression
->doBuildResult(aContinuation, accessors)
->Belt.Option.map(setResult(withExpression, _))
->E.O2.defaultFn(() => withExpression)
let doRun = (
this: t,
context: Reducer_T.context
): t =>
switch this->getExpression {
| Some(expressionResult) => {
switch expressionResult {
| Ok(expression) => {
try {
let result = Reducer_Expression.evaluate(expression, context)
this->setResult(result->Ok)->setContinuation(context.bindings)
} catch {
| Reducer_ErrorValue.ErrorException(e) => this->failRun(e)
| _ => this->failRun(RETodo("unhandled rescript exception"))
}
}
| Error(e) => this->failRun(e)
}
}
| None => this->failRun(RETodo("attempt to run without expression"))
}
let run = (this: t, context: Reducer_T.context): t => {
let this = this->buildExpression
switch this->getResult {
| Some(_) => this
| None => this->doRun(context)
}
}
let run = buildResult

View File

@ -1,6 +1,5 @@
module Parse = Reducer_Peggy_Parse
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue
type sourceArgumentType = string
@ -9,13 +8,13 @@ type rawParseArgumentType = result<Parse.node, errorValue>
type rawParseType = option<rawParseArgumentType>
type expressionArgumentType = result<ExpressionT.t, errorValue>
type expressionType = option<expressionArgumentType>
type continuation = InternalExpressionValue.nameSpace
type continuationArgumentType = InternalExpressionValue.nameSpace
type continuation = Reducer_T.nameSpace
type continuationArgumentType = Reducer_T.nameSpace
type continuationType = option<continuationArgumentType>
type continuationResultType = option<result<continuationArgumentType, errorValue>>
type bindingsArgumentType = InternalExpressionValue.nameSpace
type bindingsArgumentType = Reducer_T.nameSpace
type bindingsType = option<bindingsArgumentType>
type resultArgumentType = result<InternalExpressionValue.t, errorValue>
type resultArgumentType = result<Reducer_T.value, errorValue>
type resultType = option<resultArgumentType>
type continuesArgumentType = array<string>
type continuesType = array<string>
@ -23,17 +22,16 @@ type includesArgumentType = string
type includesType = result<array<string>, errorValue>
type importAsVariablesType = array<(string, string)>
type projectItem =
| ProjectItem({
source: sourceType,
rawParse: rawParseType,
expression: expressionType,
continuation: continuationArgumentType,
result: resultType,
continues: continuesType,
includes: includesType, //For loader
includeAsVariables: importAsVariablesType, //For linker
directIncludes: array<string>,
}) //For linker
type projectItem = {
source: sourceType,
rawParse: rawParseType,
expression: expressionType,
continuation: continuationArgumentType,
result: resultType,
continues: continuesType,
includes: includesType, //For loader
includeAsVariables: importAsVariablesType, //For linker
directIncludes: array<string>,
}
type t = projectItem

View File

@ -1,5 +0,0 @@
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
type t = (ExpressionT.t, ExpressionT.bindings, ProjectAccessorsT.t) => InternalExpressionValue.t

View File

@ -1,37 +1,17 @@
module ProjectItem = ReducerProject_ProjectItem
module ExpressionT = Reducer_Expression_T
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
@genType.opaque
type project = {"iAmProject": bool}
//re-export
@genType
type project = {
items: Belt.MutableMap.String.t<ProjectItem.t>,
mutable stdLib: Reducer_Bindings.t,
mutable environment: ExpressionT.environment,
mutable previousRunOrder: array<string>,
}
type t = project
module Private = {
type internalProject = {
"iAmProject": bool,
"items": Belt.Map.String.t<ProjectItem.t>,
"stdLib": Reducer_Bindings.t,
"environment": ExpressionT.environment,
"previousRunOrder": array<string>,
}
type t = internalProject
// these functions are used in ReducerProject_Topology, so they are defined here to avoid circular dependencies
let getSourceIds = (project: t): array<string> => Belt.MutableMap.String.keysToArray(project.items)
@set
external setFieldItems: (t, Belt.Map.String.t<ProjectItem.t>) => unit = "items"
@set
external setFieldStdLib: (t, Reducer_Bindings.t) => unit = "stdLib"
@set
external setFieldEnvironment: (t, ExpressionT.environment) => unit = "environment"
@set
external setFieldPreviousRunOrder: (t, array<string>) => unit = "previousRunOrder"
external castFromInternalProject: t => project = "%identity"
external castToInternalProject: project => t = "%identity"
let getSourceIds = (this: t): array<string> => Belt.Map.String.keysToArray(this["items"])
let getItem = (this: t, sourceId: string) =>
Belt.Map.String.getWithDefault(this["items"], sourceId, ProjectItem.emptyItem)
}
let getItem = (project: t, sourceId: string) =>
Belt.MutableMap.String.getWithDefault(project.items, sourceId, ProjectItem.emptyItem)

View File

@ -1,12 +1,12 @@
module ProjectItem = ReducerProject_ProjectItem
module T = ReducerProject_T
type t = T.Private.t
type t = T.t
let getSourceIds = T.Private.getSourceIds
let getItem = T.Private.getItem
let getSourceIds = T.getSourceIds
let getItem = T.getItem
let getImmediateDependencies = (this: t, sourceId: string): ProjectItem.T.includesType =>
getItem(this, sourceId)->ProjectItem.getImmediateDependencies
this->getItem(sourceId)->ProjectItem.getImmediateDependencies
type topologicalSortState = (Belt.Map.String.t<bool>, list<string>)
let rec topologicalSortUtil = (
@ -31,7 +31,7 @@ let rec topologicalSortUtil = (
}
let getTopologicalSort = (this: t): array<string> => {
let (_visited, stack) = getSourceIds(this)->Belt.Array.reduce((Belt.Map.String.empty, list{}), (
let (_visited, stack) = this->getSourceIds->Belt.Array.reduce((Belt.Map.String.empty, list{}), (
(currVisited, currStack),
currId,
) =>

View File

@ -15,7 +15,7 @@ let availableNumbers: array<(string, float)> = [
let mathBindings: Bindings.t =
availableNumbers
->E.A2.fmap(((name, v)) => (name, ReducerInterface_InternalExpressionValue.IEvNumber(v)))
->E.A2.fmap(((name, v)) => (name, Reducer_T.IEvNumber(v)))
->Bindings.fromArray
let makeBindings = (previousBindings: Bindings.t): Bindings.t =>

View File

@ -1,9 +1,9 @@
module Bindings = Reducer_Bindings
let bindings: Bindings.t =
let bindings: Reducer_T.nameSpace =
[
("System.version", ReducerInterface_InternalExpressionValue.IEvString("0.4.0-dev")),
("System.version", Reducer_T.IEvString("0.4.0-dev")),
]->Bindings.fromArray
let makeBindings = (previousBindings: Bindings.t): Bindings.t =>
let makeBindings = (previousBindings: Reducer_T.nameSpace): Reducer_T.nameSpace =>
previousBindings->Bindings.mergeFrom(bindings)