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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -62,13 +62,13 @@ export class SqBoolValue extends SqAbstractValue {
} }
} }
export class SqCallValue extends SqAbstractValue { // export class SqCallValue extends SqAbstractValue {
tag = Tag.Call as const; // tag = Tag.Call as const;
get value() { // get value() {
return this.valueMethod(RSValue.getCall); // return this.valueMethod(RSValue.getCall);
} // }
} // }
export class SqDateValue extends SqAbstractValue { export class SqDateValue extends SqAbstractValue {
tag = Tag.Date as const; tag = Tag.Date as const;
@ -134,13 +134,13 @@ export class SqStringValue extends SqAbstractValue {
} }
} }
export class SqSymbolValue extends SqAbstractValue { // export class SqSymbolValue extends SqAbstractValue {
tag = Tag.Symbol as const; // tag = Tag.Symbol as const;
get value(): string { // get value(): string {
return this.valueMethod(RSValue.getSymbol); // return this.valueMethod(RSValue.getSymbol);
} // }
} // }
export class SqTimeDurationValue extends SqAbstractValue { export class SqTimeDurationValue extends SqAbstractValue {
tag = Tag.TimeDuration as const; tag = Tag.TimeDuration as const;
@ -178,7 +178,7 @@ const tagToClass = {
[Tag.Array]: SqArrayValue, [Tag.Array]: SqArrayValue,
[Tag.ArrayString]: SqArrayStringValue, [Tag.ArrayString]: SqArrayStringValue,
[Tag.Bool]: SqBoolValue, [Tag.Bool]: SqBoolValue,
[Tag.Call]: SqCallValue, // [Tag.Call]: SqCallValue,
[Tag.Date]: SqDateValue, [Tag.Date]: SqDateValue,
[Tag.Declaration]: SqDeclarationValue, [Tag.Declaration]: SqDeclarationValue,
[Tag.Distribution]: SqDistributionValue, [Tag.Distribution]: SqDistributionValue,
@ -187,7 +187,7 @@ const tagToClass = {
[Tag.Number]: SqNumberValue, [Tag.Number]: SqNumberValue,
[Tag.Record]: SqRecordValue, [Tag.Record]: SqRecordValue,
[Tag.String]: SqStringValue, [Tag.String]: SqStringValue,
[Tag.Symbol]: SqSymbolValue, // [Tag.Symbol]: SqSymbolValue,
[Tag.TimeDuration]: SqTimeDurationValue, [Tag.TimeDuration]: SqTimeDurationValue,
[Tag.Type]: SqTypeValue, [Tag.Type]: SqTypeValue,
[Tag.TypeIdentifier]: SqTypeIdentifierValue, [Tag.TypeIdentifier]: SqTypeIdentifierValue,
@ -200,7 +200,7 @@ export type SqValue =
| SqArrayValue | SqArrayValue
| SqArrayStringValue | SqArrayStringValue
| SqBoolValue | SqBoolValue
| SqCallValue // | SqCallValue
| SqDateValue | SqDateValue
| SqDeclarationValue | SqDeclarationValue
| SqDistributionValue | SqDistributionValue
@ -209,7 +209,7 @@ export type SqValue =
| SqNumberValue | SqNumberValue
| SqRecordValue | SqRecordValue
| SqStringValue | SqStringValue
| SqSymbolValue // | SqSymbolValue
| SqTimeDurationValue | SqTimeDurationValue
| SqTypeValue | SqTypeValue
| SqTypeIdentifierValue | 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 { SqProject } from "./SqProject";
import { SqValue, SqValueTag } from "./SqValue"; import { SqValue, SqValueTag } from "./SqValue";
export { SqValueLocation } from "./SqValueLocation"; 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 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 type environment = ForTS_Distribution_Environment.environment //use
module T = ReducerProject_T module T = ReducerProject_T
module Private = ReducerProject.Private module Private = ReducerProject
/* /*
PUBLIC FUNCTIONS PUBLIC FUNCTIONS
@ -35,35 +35,35 @@ A project has a public field tag with a constant value "reducerProject"
project = {tag: "reducerProject"} project = {tag: "reducerProject"}
*/ */
@genType @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. Answer all the source ids of all the sources in the project.
*/ */
@genType @genType
let getSourceIds = (project: reducerProject): array<string> => let getSourceIds = (project: reducerProject): array<string> =>
project->T.Private.castToInternalProject->Private.getSourceIds project->Private.getSourceIds
/* /*
Sets the source for a given source Id. Sets the source for a given source Id.
*/ */
@genType @genType
let setSource = (project: reducerProject, sourceId: string, value: string): unit => 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. Gets the source for a given source id.
*/ */
@genType @genType
let getSource = (project: reducerProject, sourceId: string): option<string> => 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. Touches the source for a given source id. This and dependent, sources are set to be re-evaluated.
*/ */
@genType @genType
let touchSource = (project: reducerProject, sourceId: string): unit => 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. 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 @genType
let clean = (project: reducerProject, sourceId: string): unit => 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 Cleans all the compilation artifacts in all of the project
*/ */
@genType @genType
let cleanAll = (project: reducerProject): unit => 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. 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 @genType
let cleanResults = (project: reducerProject, sourceId: string): unit => 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. Cleans all results. Compilations remains untouched to rerun the source.
*/ */
@genType @genType
let cleanAllResults = (project: reducerProject): unit => 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. 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< let getIncludes = (project: reducerProject, sourceId: string): result<
array<string>, array<string>,
reducerErrorValue, reducerErrorValue,
> => project->T.Private.castToInternalProject->Private.getIncludes(sourceId) > => project->Private.getIncludes(sourceId)
/* Other sources contributing to the global namespace of this source. */ /* Other sources contributing to the global namespace of this source. */
@genType @genType
let getPastChain = (project: reducerProject, sourceId: string): array<string> => 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 Answers the source codes after which this source code is continuing
*/ */
@genType @genType
let getContinues = (project: reducerProject, sourceId: string): array<string> => 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. "continues" acts like hidden includes in the source.
@ -124,35 +124,35 @@ let getContinues = (project: reducerProject, sourceId: string): array<string> =>
*/ */
@genType @genType
let setContinues = (project: reducerProject, sourceId: string, continues: array<string>): unit => 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. This source depends on the array of sources returned.
*/ */
@genType @genType
let getDependencies = (project: reducerProject, sourceId: string): array<string> => 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 The sources returned are dependent on this
*/ */
@genType @genType
let getDependents = (project: reducerProject, sourceId: string): array<string> => 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. Get the run order for the sources in the project.
*/ */
@genType @genType
let getRunOrder = (project: reducerProject): array<string> => 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 Get the run order to get the results of this specific source
*/ */
@genType @genType
let getRunOrderFor = (project: reducerProject, sourceId: string) => 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. 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 @genType
let parseIncludes = (project: reducerProject, sourceId: string): unit => 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. 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 @genType
let rawParse = (project: reducerProject, sourceId: string): unit => 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. 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 @genType
let run = (project: reducerProject, sourceId: string): unit => 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 Runs all of the sources in a project. Their results and bindings will be available
*/ */
@genType @genType
let runAll = (project: reducerProject): unit => 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 Get the bindings after running this source fil. The bindings are local to the source
*/ */
@genType @genType
let getBindings = (project: reducerProject, sourceId: string): squiggleValue_Module => 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 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< let getResult = (project: reducerProject, sourceId: string): result<
squiggleValue, squiggleValue,
reducerErrorValue, 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. 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 @genType
let setEnvironment = (project: reducerProject, environment: environment): unit => let setEnvironment = (project: reducerProject, environment: environment): unit =>
project->T.Private.castToInternalProject->Private.setEnvironment(environment) project->Private.setEnvironment(environment)
/* /*
Foreign function interface is intentionally demolished. 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 type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
@genType type squiggleValue_Array = ReducerInterface_InternalExpressionValue.squiggleArray //re-export recursive type @genType type squiggleValue_Array = Reducer_T.arrayValue //re-export recursive type
@genType type squiggleValue_Module = ReducerInterface_InternalExpressionValue.nameSpace //re-export recursive type @genType type squiggleValue_Module = Reducer_T.nameSpace //re-export recursive type
@genType type squiggleValue_Record = ReducerInterface_InternalExpressionValue.map //re-export recursive type @genType type squiggleValue_Record = Reducer_T.map //re-export recursive type
@genType type squiggleValue_Type = ReducerInterface_InternalExpressionValue.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_Declaration = ForTS_SquiggleValue_Declaration.squiggleValue_Declaration //use
type squiggleValue_Distribution = ForTS_SquiggleValue_Distribution.squiggleValue_Distribution //use type squiggleValue_Distribution = ForTS_SquiggleValue_Distribution.squiggleValue_Distribution //use
type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //use type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //use
@ -20,8 +20,8 @@ external svtArrayString_: string = "ArrayString"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtBool_: string = "Bool" external svtBool_: string = "Bool"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") // @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtCall_: string = "Call" // external svtCall_: string = "Call"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtDate_: string = "Date" external svtDate_: string = "Date"
@ -47,8 +47,8 @@ external svtRecord_: string = "Record"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtString_: string = "String" external svtString_: string = "String"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") // @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtSymbol_: string = "Symbol" // external svtSymbol_: string = "Symbol"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag") @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtTimeDuration_: string = "TimeDuration" external svtTimeDuration_: string = "TimeDuration"
@ -73,7 +73,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
| IEvArray(_) => svtArray_->castEnum | IEvArray(_) => svtArray_->castEnum
| IEvArrayString(_) => svtArrayString_->castEnum | IEvArrayString(_) => svtArrayString_->castEnum
| IEvBool(_) => svtBool_->castEnum | IEvBool(_) => svtBool_->castEnum
| IEvCall(_) => svtCall_->castEnum //Impossible // | IEvCall(_) => svtCall_->castEnum //Impossible
| IEvDate(_) => svtDate_->castEnum | IEvDate(_) => svtDate_->castEnum
| IEvDeclaration(_) => svtDeclaration_->castEnum | IEvDeclaration(_) => svtDeclaration_->castEnum
| IEvDistribution(_) => svtDistribution_->castEnum | IEvDistribution(_) => svtDistribution_->castEnum
@ -82,7 +82,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
| IEvNumber(_) => svtNumber_->castEnum | IEvNumber(_) => svtNumber_->castEnum
| IEvRecord(_) => svtRecord_->castEnum | IEvRecord(_) => svtRecord_->castEnum
| IEvString(_) => svtString_->castEnum | IEvString(_) => svtString_->castEnum
| IEvSymbol(_) => svtSymbol_->castEnum // | IEvSymbol(_) => svtSymbol_->castEnum
| IEvTimeDuration(_) => svtTimeDuration_->castEnum | IEvTimeDuration(_) => svtTimeDuration_->castEnum
| IEvType(_) => svtType_->castEnum | IEvType(_) => svtType_->castEnum
| IEvTypeIdentifier(_) => svtTypeIdentifier_->castEnum | IEvTypeIdentifier(_) => svtTypeIdentifier_->castEnum
@ -121,12 +121,12 @@ let getBool = (variant: squiggleValue): option<bool> =>
| _ => None | _ => None
} }
@genType // @genType
let getCall = (variant: squiggleValue): option<string> => // let getCall = (variant: squiggleValue): option<string> =>
switch variant { // switch variant {
| IEvCall(value) => value->Some // | IEvCall(value) => value->Some
| _ => None // | _ => None
} // }
@genType @genType
let getDate = (variant: squiggleValue): option<Js.Date.t> => let getDate = (variant: squiggleValue): option<Js.Date.t> =>
@ -184,12 +184,12 @@ let getString = (variant: squiggleValue): option<string> =>
| _ => None | _ => None
} }
@genType // @genType
let getSymbol = (variant: squiggleValue): option<string> => // let getSymbol = (variant: squiggleValue): option<string> =>
switch variant { // switch variant {
| IEvSymbol(value) => value->Some // | IEvSymbol(value) => value->Some
| _ => None // | _ => None
} // }
@genType @genType
let getTimeDuration = (variant: squiggleValue): option<float> => 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 @genType
let toString = (v: squiggleValue_Declaration): string => 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 @genType
let toString = (v: squiggleValue_Lambda): string => let toString = (v: squiggleValue_Lambda): string =>

View File

@ -3,7 +3,7 @@ type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
@genType @genType
let getKeyValuePairs = (v: squiggleValue_Module): array<(string, squiggleValue)> => let getKeyValuePairs = (v: squiggleValue_Module): array<(string, squiggleValue)> =>
ReducerInterface_InternalExpressionValue.nameSpaceToKeyValuePairs(v) v->Reducer_Bindings.toKeyValuePairs
@genType @genType
let toString = (v: squiggleValue_Module): string => let toString = (v: squiggleValue_Module): string =>
@ -13,4 +13,4 @@ let toString = (v: squiggleValue_Module): string =>
let toSquiggleValue = (v: squiggleValue_Module): squiggleValue => IEvBindings(v) let toSquiggleValue = (v: squiggleValue_Module): squiggleValue => IEvBindings(v)
@genType @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", Array = "Array",
ArrayString = "ArrayString", ArrayString = "ArrayString",
Bool = "Bool", Bool = "Bool",
Call = "Call", // Call = "Call",
Date = "Date", Date = "Date",
Declaration = "Declaration", Declaration = "Declaration",
Distribution = "Distribution", Distribution = "Distribution",
@ -11,7 +11,7 @@ export enum squiggleValueTag {
Number = "Number", Number = "Number",
Record = "Record", Record = "Record",
String = "String", String = "String",
Symbol = "Symbol", // Symbol = "Symbol",
TimeDuration = "TimeDuration", TimeDuration = "TimeDuration",
Type = "Type", Type = "Type",
TypeIdentifier = "TypeIdentifier", TypeIdentifier = "TypeIdentifier",

View File

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

View File

@ -6,11 +6,11 @@ module Wrappers = {
let symbolic = r => DistributionTypes.Symbolic(r) let symbolic = r => DistributionTypes.Symbolic(r)
let pointSet = r => DistributionTypes.PointSet(r) let pointSet = r => DistributionTypes.PointSet(r)
let sampleSet = r => DistributionTypes.SampleSet(r) let sampleSet = r => DistributionTypes.SampleSet(r)
let evDistribution = r => ReducerInterface_InternalExpressionValue.IEvDistribution(r) let evDistribution = r => Reducer_T.IEvDistribution(r)
let evNumber = r => ReducerInterface_InternalExpressionValue.IEvNumber(r) let evNumber = r => Reducer_T.IEvNumber(r)
let evArray = r => ReducerInterface_InternalExpressionValue.IEvArray(r) let evArray = r => Reducer_T.IEvArray(r)
let evRecord = r => ReducerInterface_InternalExpressionValue.IEvRecord(r) let evRecord = r => Reducer_T.IEvRecord(r)
let evString = r => ReducerInterface_InternalExpressionValue.IEvString(r) let evString = r => Reducer_T.IEvString(r)
let symbolicEvDistribution = r => r->DistributionTypes.Symbolic->evDistribution let symbolicEvDistribution = r => r->DistributionTypes.Symbolic->evDistribution
let evArrayOfEvNumber = xs => xs->Belt.Array.map(evNumber)->evArray 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 pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall( let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
aLambda, aLambda,
list{pointAsInternalExpression}, [pointAsInternalExpression],
environment, environment,
reducer, reducer
) )
let result = switch resultAsInternalExpression { let result = switch resultAsInternalExpression {
| IEvNumber(x) => Ok(x) | Reducer_T.IEvNumber(x) => Ok(x)
| _ => | _ =>
Error( Error(
"Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead", "Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
@ -132,7 +132,7 @@ module Integration = {
| (Ok(yMin), Ok(yMax)) => { | (Ok(yMin), Ok(yMax)) => {
let result = let result =
(yMin +. yMax) *. weightForAnOuterPoint +. innerPointsSum *. weightForAnInnerPoint (yMin +. yMax) *. weightForAnOuterPoint +. innerPointsSum *. weightForAnInnerPoint
let wrappedResult = result->ReducerInterface_InternalExpressionValue.IEvNumber->Ok let wrappedResult = result->Reducer_T.IEvNumber->Ok
wrappedResult wrappedResult
} }
| (Error(b), _) => Error(b) | (Error(b), _) => Error(b)
@ -273,7 +273,7 @@ module DiminishingReturns = {
funds, funds,
approximateIncrement, approximateIncrement,
environment, environment,
reducer, reducer
) => { ) => {
switch ( switch (
E.A.length(lambdas) > 1, E.A.length(lambdas) > 1,
@ -303,12 +303,12 @@ module DiminishingReturns = {
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point) let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall( let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
lambda, lambda,
list{pointAsInternalExpression}, [pointAsInternalExpression],
environment, environment,
reducer, reducer
) )
switch resultAsInternalExpression { switch resultAsInternalExpression {
| IEvNumber(x) => Ok(x) | Reducer_T.IEvNumber(x) => Ok(x)
| _ => | _ =>
Error( Error(
"Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead", "Error 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)] => { | [IEvArray(innerlambdas), IEvNumber(funds), IEvNumber(approximateIncrement)] => {
let individuallyWrappedLambdas = E.A.fmap(innerLambda => { let individuallyWrappedLambdas = E.A.fmap(innerLambda => {
switch innerLambda { switch innerLambda {
| ReducerInterface_InternalExpressionValue.IEvLambda(lambda) => Ok(lambda) | Reducer_T.IEvLambda(lambda) => Ok(lambda)
| _ => | _ =>
Error( Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. A member of the array wasn't a function", "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" let nameSpace = "Dict"
module Internals = { module Internals = {
type t = ReducerInterface_InternalExpressionValue.map type t = Reducer_T.map
let keys = (a: t): internalExpressionValue => IEvArray( let keys = (a: t): internalExpressionValue => IEvArray(
Belt.Map.String.keysToArray(a)->E.A2.fmap(Wrappers.evString), Belt.Map.String.keysToArray(a)->E.A2.fmap(Wrappers.evString),

View File

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

View File

@ -18,7 +18,7 @@ module Declaration = {
inputs inputs
->E.A2.fmap(getMinMax) ->E.A2.fmap(getMinMax)
->E.A.R.firstErrorOrOpen ->E.A.R.firstErrorOrOpen
->E.R2.fmap(args => ReducerInterface_InternalExpressionValue.IEvDeclaration( ->E.R2.fmap(args => Reducer_T.IEvDeclaration(
Declaration.make(lambda, args), 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_Core
open FunctionRegistry_Helpers open FunctionRegistry_Helpers
@ -29,16 +26,16 @@ module Internals = {
let map = ( let map = (
array: array<internalExpressionValue>, array: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
eLambdaValue, eLambdaValue,
reducer: ProjectReducerFnT.t, env: Reducer_T.environment,
): ReducerInterface_InternalExpressionValue.t => { reducer: Reducer_T.reducerFn
): internalExpressionValue => {
let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => { let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => {
let newElem = Reducer_Expression_Lambda.doLambdaCall( let newElem = Reducer_Expression_Lambda.doLambdaCall(
eLambdaValue, eLambdaValue,
list{elem}, [elem],
(accessors: ProjectAccessorsT.t), env,
(reducer: ProjectReducerFnT.t), reducer
) )
list{newElem, ...acc} list{newElem, ...acc}
}) })
@ -49,11 +46,11 @@ module Internals = {
aValueArray, aValueArray,
initialValue, initialValue,
aLambdaValue, aLambdaValue,
accessors: ProjectAccessorsT.t, env: Reducer_T.environment,
reducer: ProjectReducerFnT.t, reducer: Reducer_T.reducerFn
) => { ) => {
aValueArray->E.A.reduce(initialValue, (acc, elem) => 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, aValueArray,
initialValue, initialValue,
aLambdaValue, aLambdaValue,
accessors: ProjectAccessorsT.t, env: Reducer_T.environment,
reducer: ProjectReducerFnT.t, reducer: Reducer_T.reducerFn
) => { ) => {
aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) => 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 = ( let filter = (
aValueArray, aValueArray,
aLambdaValue, aLambdaValue,
accessors: ProjectAccessorsT.t, env: Reducer_T.environment,
reducer: ProjectReducerFnT.t, reducer: Reducer_T.reducerFn
) => { ) => {
let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => { let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => {
let newElem = Reducer_Expression_Lambda.doLambdaCall( let newElem = Reducer_Expression_Lambda.doLambdaCall(
aLambdaValue, aLambdaValue,
list{elem}, [elem],
accessors, env,
reducer, reducer
) )
switch newElem { switch newElem {
| IEvBool(true) => list{elem, ...acc} | IEvBool(true) => list{elem, ...acc}
@ -201,10 +198,10 @@ let library = [
FnDefinition.make( FnDefinition.make(
~name="map", ~name="map",
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda], ~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => ~run=(inputs, _, env, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), IEvLambda(lambda)] => | [IEvArray(array), IEvLambda(lambda)] =>
Ok(Internals.map(array, accessors, lambda, reducer)) Ok(Internals.map(array, lambda, env, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -221,10 +218,10 @@ let library = [
FnDefinition.make( FnDefinition.make(
~name="reduce", ~name="reduce",
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda], ~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => ~run=(inputs, _, env, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] => | [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer)) Ok(Internals.reduce(array, initialValue, lambda, env, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -241,10 +238,10 @@ let library = [
FnDefinition.make( FnDefinition.make(
~name="reduceReverse", ~name="reduceReverse",
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda], ~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => ~run=(inputs, _, env, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] => | [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer)) Ok(Internals.reduceReverse(array, initialValue, lambda, env, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -261,10 +258,10 @@ let library = [
FnDefinition.make( FnDefinition.make(
~name="filter", ~name="filter",
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda], ~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => ~run=(inputs, _, env, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), IEvLambda(lambda)] => | [IEvArray(array), IEvLambda(lambda)] =>
Ok(Internals.filter(array, lambda, accessors, reducer)) Ok(Internals.filter(array, lambda, env, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),

View File

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

View File

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

View File

@ -2,16 +2,86 @@
// Other module operations such as import export will be preprocessed jobs // Other module operations such as import export will be preprocessed jobs
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module T = Reducer_T
open Reducer_ErrorValue
open ReducerInterface_InternalExpressionValue
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_" switch container->Belt.MutableMap.String.get(id) {
let typeReferencesKey = "_typeReferences_" | 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) => { // let getType = (NameSpace(container): t, id: string) => {
// Belt.Map.String.get(container, typeAliasesKey)->Belt.Option.flatMap(aliases => // 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 setTypeAlias = (NameSpace(container): t, id: string, value): t => {
// let rValue = Belt.Map.String.getWithDefault(container, typeAliasesKey, IEvRecord(emptyMap)) // let rValue = Belt.Map.String.getWithDefault(container, typeAliasesKey, IEvRecord(emptyMap))
// let r = switch rValue { // let r = switch rValue {
@ -72,126 +121,74 @@ let emptyMap: map = Belt.Map.String.empty
// NameSpace(Belt.Map.String.set(container, typeReferencesKey, r2)) // NameSpace(Belt.Map.String.set(container, typeReferencesKey, r2))
// } // }
let set = (NameSpace(container): t, id: string, value): t => NameSpace( // let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => {
Belt.Map.String.set(container, id, value), // 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) // external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
let emptyBindings = emptyModule
let emptyNameSpace = emptyModule
let toExpressionValue = (nameSpace: t): internalExpressionValue => IEvBindings(nameSpace) // let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
let fromExpressionValue = (aValue: internalExpressionValue): t => // IEvLambda({
switch aValue { // parameters: [],
| IEvBindings(nameSpace) => nameSpace // context: emptyModule,
| _ => 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 => { // let functionNotFoundErrorFFIFn = (functionName: string): ExpressionT.ffiFn => {
NameSpace( // (args: array<internalExpressionValue>, _environment: environment): result<
newContainer->Belt.Map.String.reduce(container, (container, key, value) => // internalExpressionValue,
Belt.Map.String.set(container, key, value) // errorValue,
), // > => {
) // let call = (functionName, args)
} // functionNotFoundError(call)
// }
// }
let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => { // let convertOptionToFfiFnReturningResult = (
let keys = Belt.Map.String.keysToArray(otherContainer) // myFunctionName: string,
NameSpace( // myFunction: ExpressionT.optionFfiFnReturningResult,
Belt.Map.String.keep(container, (key, _value) => { // ): ExpressionT.ffiFn => {
let removeThis = Js.Array2.includes(keys, key) // (args: array<InternalExpressionValue.t>, environment) => {
!removeThis // myFunction(args, environment)->Belt.Option.getWithDefault(
}), // functionNotFoundErrorFFIFn(myFunctionName)(args, environment),
) // )
} // }
// }
external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity" // let convertOptionToFfiFn = (
// myFunctionName: string,
let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => { // myFunction: ExpressionT.optionFfiFn,
IEvLambda({ // ): ExpressionT.ffiFn => {
parameters: [], // (args: array<InternalExpressionValue.t>, environment) => {
context: emptyModule, // myFunction(args, environment)
body: FFI(ffiFn)->castExpressionToInternalCode, // ->Belt.Option.map(v => v->Ok)
}) // ->Belt.Option.getWithDefault(functionNotFoundErrorFFIFn(myFunctionName)(args, environment))
} // }
// }
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))
}
}
// -- Module definition // -- Module definition
let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => { // let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => {
NameSpace(Belt.Map.String.set(container, identifier, ev)) // NameSpace(Belt.Map.String.set(container, identifier, ev))
} // }
let defineNumber = (nameSpace: t, identifier: string, value: float): t => // let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
nameSpace->define(identifier, IEvNumber(value)) // nameSpace->define(identifier, IEvNumber(value))
let defineString = (nameSpace: t, identifier: string, value: string): t => // let defineString = (nameSpace: t, identifier: string, value: string): t =>
nameSpace->define(identifier, IEvString(value)) // nameSpace->define(identifier, IEvString(value))
let defineBool = (nameSpace: t, identifier: string, value: bool): t => // let defineBool = (nameSpace: t, identifier: string, value: bool): t =>
nameSpace->define(identifier, IEvBool(value)) // nameSpace->define(identifier, IEvBool(value))
let defineModule = (nameSpace: t, identifier: string, value: t): t => // let defineModule = (nameSpace: t, identifier: string, value: t): t =>
nameSpace->define(identifier, toExpressionValue(value)) // nameSpace->define(identifier, toExpressionValue(value))
let 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
}

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 Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module Continuation = ReducerInterface_Value_Continuation module Continuation = ReducerInterface_Value_Continuation
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary module ExternalLibrary = ReducerInterface.ExternalLibrary
module Lambda = Reducer_Expression_Lambda module Lambda = Reducer_Expression_Lambda
module MathJs = Reducer_MathJs module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
module Result = Belt.Result module Result = Belt.Result
module TypeBuilder = Reducer_Type_TypeBuilder module TypeBuilder = Reducer_Type_TypeBuilder
open ReducerInterface_InternalExpressionValue module IEV = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue open Reducer_ErrorValue
/* /*
@ -24,42 +22,42 @@ open Reducer_ErrorValue
exception TestRescriptException exception TestRescriptException
let callInternal = ( let callInternal = (
call: functionCall, call: IEV.functionCall,
accessors: ProjectAccessorsT.t, _: Reducer_T.environment,
reducer: ProjectReducerFnT.t, _: Reducer_T.reducerFn,
): result<'b, errorValue> => { ): result<'b, errorValue> => {
let callMathJs = (call: functionCall): result<'b, errorValue> => let callMathJs = (call: IEV.functionCall): result<'b, errorValue> =>
switch call { 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 | ("rescriptraise", _) => raise(TestRescriptException) // For Tests
| call => call->toStringFunctionCall->MathJs.Eval.eval | call => call->IEV.toStringFunctionCall->MathJs.Eval.eval
} }
let constructRecord = arrayOfPairs => { let constructRecord = arrayOfPairs => {
Belt.Array.map(arrayOfPairs, pairValue => Belt.Array.map(arrayOfPairs, pairValue =>
switch pairValue { switch pairValue {
| IEvArray([IEvString(key), valueValue]) => (key, valueValue) | Reducer_T.IEvArray([IEvString(key), valueValue]) => (key, valueValue)
| _ => ("wrong key type", pairValue->toStringWithType->IEvString) | _ => ("wrong key type", pairValue->IEV.toStringWithType->IEvString)
} }
) )
->Belt.Map.String.fromArray ->Belt.Map.String.fromArray
->IEvRecord ->Reducer_T.IEvRecord
->Ok ->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)) { switch Belt.Array.get(aValueArray, Belt.Int.fromFloat(fIndex)) {
| Some(value) => value->Ok | Some(value) => value->Ok
| None => REArrayIndexNotFound("Array index not found", Belt.Int.fromFloat(fIndex))->Error | 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) { switch Bindings.get(nameSpace, sIndex) {
| Some(value) => value->Ok | Some(value) => value->Ok
| None => RERecordPropertyNotFound("Bindings property not found", sIndex)->Error | 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) { switch Belt.Map.String.get(dict, sIndex) {
| Some(value) => value->Ok | Some(value) => value->Ok
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error | None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
@ -68,26 +66,26 @@ let callInternal = (
let doAddArray = (originalA, b) => { let doAddArray = (originalA, b) => {
let a = originalA->Js.Array2.copy let a = originalA->Js.Array2.copy
let _ = Js.Array2.pushMany(a, b) let _ = Js.Array2.pushMany(a, b)
a->IEvArray->Ok a->Reducer_T.IEvArray->Ok
} }
let doAddString = (a, b) => { let doAddString = (a, b) => {
let answer = Js.String2.concat(a, b) let answer = Js.String2.concat(a, b)
answer->IEvString->Ok answer->Reducer_T.IEvString->Ok
} }
let inspect = (value: internalExpressionValue) => { let inspect = (value: Reducer_T.value) => {
Js.log(value->toString) Js.log(value->IEV.toString)
value->Ok value->Ok
} }
let inspectLabel = (value: internalExpressionValue, label: string) => { let inspectLabel = (value: Reducer_T.value, label: string) => {
Js.log(`${label}: ${value->toString}`) Js.log(`${label}: ${value->IEV.toString}`)
value->Ok value->Ok
} }
let doSetBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) => { // let doSetBindings = (bindings: Reducer_T.nameSpace, symbol: string, value: Reducer_T.value) => {
Bindings.set(bindings, symbol, value)->IEvBindings->Ok // Bindings.set(bindings, symbol, value)->IEvBindings->Ok
} // }
// let doSetTypeAliasBindings = ( // let doSetTypeAliasBindings = (
// bindings: nameSpace, // bindings: nameSpace,
@ -98,50 +96,15 @@ let callInternal = (
// let doSetTypeOfBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) => // let doSetTypeOfBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) =>
// Bindings.setTypeOf(bindings, symbol, value)->IEvBindings->Ok // 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 doDumpBindings = (continuation: Reducer_T.nameSpace, value: Reducer_T.value) => {
// let _ = Continuation.inspect(continuation, "doDumpBindings") // // let _ = Continuation.inspect(continuation, "doDumpBindings")
accessors.states.continuation = continuation->Bindings.set("__result__", value) // accessors.states.continuation = continuation->Bindings.set("__result__", value)
value->Ok // 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))
}
}
}
switch call { switch call {
| ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex) | ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
@ -149,15 +112,15 @@ let callInternal = (
| ("$_atIndex_$", [IEvRecord(dict), IEvString(sIndex)]) => recordAtIndex(dict, sIndex) | ("$_atIndex_$", [IEvRecord(dict), IEvString(sIndex)]) => recordAtIndex(dict, sIndex)
| ("$_constructArray_$", args) => IEvArray(args)->Ok | ("$_constructArray_$", args) => IEvArray(args)->Ok
| ("$_constructRecord_$", [IEvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs) | ("$_constructRecord_$", [IEvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs)
| ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace) // | ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace)
| ("$_exportBindings_$", [evValue]) => doIdentity(evValue) // | ("$_exportBindings_$", [evValue]) => doIdentity(evValue)
| ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) => // | ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
doSetBindings(nameSpace, symbol, value) // doSetBindings(nameSpace, symbol, value)
// | ("$_setTypeAliasBindings_$", [IEvBindings(nameSpace), IEvTypeIdentifier(symbol), value]) => // | ("$_setTypeAliasBindings_$", [IEvBindings(nameSpace), IEvTypeIdentifier(symbol), value]) =>
// doSetTypeAliasBindings(nameSpace, symbol, value) // doSetTypeAliasBindings(nameSpace, symbol, value)
// | ("$_setTypeOfBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) => // | ("$_setTypeOfBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
// doSetTypeOfBindings(nameSpace, 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)]) => // | ("$_typeModifier_memberOf_$", [IEvTypeIdentifier(typeIdentifier), IEvArray(arr)]) =>
// TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr)) // TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
// | ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) => // | ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) =>
@ -191,28 +154,28 @@ let callInternal = (
| (_, [IEvString(_), IEvString(_)]) => | (_, [IEvString(_), IEvString(_)]) =>
callMathJs(call) callMathJs(call)
| 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 Reducer uses Result monad while reducing expressions
*/ */
let dispatch = ( let dispatch = (
call: functionCall, call: IEV.functionCall,
accessors: ProjectAccessorsT.t, env: Reducer_T.environment,
reducer: ProjectReducerFnT.t, reducer: Reducer_T.reducerFn
): internalExpressionValue => ): Reducer_T.value =>
try { try {
let (fn, args) = call let (fn, args) = call
if fn->Js.String2.startsWith("$") { if fn->Js.String2.startsWith("$") {
switch callInternal((fn, args), accessors, reducer) { switch callInternal((fn, args), env, reducer) {
| Ok(v) => v | Ok(v) => v
| Error(e) => raise(ErrorException(e)) | Error(e) => raise(ErrorException(e))
} }
} else { } else {
// There is a bug that prevents string match in patterns // There is a bug that prevents string match in patterns
// So we have to recreate a copy of the string // So we have to recreate a copy of the string
switch ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) { switch ExternalLibrary.dispatch((Js.String.make(fn), args), env, reducer, callInternal) {
| Ok(v) => v | Ok(v) => v
| Error(e) => raise(ErrorException(e)) | Error(e) => raise(ErrorException(e))
} }

View File

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

View File

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

View File

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

View File

@ -1,119 +1,100 @@
module Bindings = Reducer_Bindings 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 Lambda = Reducer_Expression_Lambda
module Macro = Reducer_Expression_Macro
module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module Result = Belt.Result module Result = Belt.Result
module T = Reducer_Expression_T module T = Reducer_T
type errorValue = Reducer_ErrorValue.errorValue type errorValue = Reducer_ErrorValue.errorValue
type t = T.t
exception ErrorException = Reducer_ErrorValue.ErrorException exception ErrorException = Reducer_ErrorValue.ErrorException
/* /*
Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus) Recursively evaluate the expression
*/ */
let rec evaluate = ( let rec evaluate: T.reducerFn = (
expression: t, expression,
bindings: T.bindings, context
accessors: ProjectAccessorsT.t, ) => {
): InternalExpressionValue.t => { Js.log(`reduce: ${expression->Reducer_Expression_T.toString}`)
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
// Js.log(`reduce: ${T.toString(expression)}`)
switch expression { switch expression {
| T.Eblock(statements) => { | T.EBlock(statements) => {
statements->Js.Array2.reduce(statement => evaluate(statement, bindings, accessors)) 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) => { | T.ETernary(predicate, trueCase, falseCase) => {
let predicateResult = evaluate(predicate, bindings, accessors) let predicateResult = predicate->evaluate(context)
switch predicateResult { switch predicateResult {
| InternalExpressionValue.IEvBool(false) => | T.IEvBool(value) =>
evaluate(false, bindings, accessors) (value ? trueCase : falseCase)->evaluate(context)
| InternalExpressionValue.IEvBool(true) =>
evaluate(trueCase, bindings, accessors)
| _ => REExpectedType("Boolean", "")->ErrorException->raise | _ => REExpectedType("Boolean", "")->ErrorException->raise
} }
} }
| T.ELambda(parameteres, expr) => {
BInternalExpressionValue.IEvLambda({ | T.ELambda(parameters, body) =>
parameters: parameters, Lambda.makeLambda(parameters, context.bindings, body)->T.IEvLambda
context: context,
body: NotFFI(expr)->BBindings.castExpressionToInternalCode,
})->T.EValue
}
| T.ECall(fn, args) => { | T.ECall(fn, args) => {
let func = evaluate(fn, bindings, accessors) let lambda = fn->evaluate(context)
"TODO" let argValues = Js.Array2.map(args, arg => arg->evaluate(context))
// Lambda.doLambdaCall(), etc. switch lambda {
| T.IEvLambda(lambda) =>
Lambda.doLambdaCall(lambda, argValues, context.environment, evaluate)
| _ => REExpectedType("Lambda", "")->ErrorException->raise
} }
} }
}
/*
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
} }
(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 = { module BackCompatible = {
// Those methods are used to support the existing tests // Those methods are used to support the existing tests
// If they are used outside limited testing context, error location reporting will fail // 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) peggyCode->Reducer_Peggy_Parse.parse->Result.map(Reducer_Peggy_ToExpression.fromNode)
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => { let evaluate = (expression: Reducer_T.expression): result<Reducer_T.value, errorValue> => {
let accessors = ProjectAccessorsT.identityAccessors let context = Reducer_Context.createDefaultContext()
try { try {
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok expression->evaluate(context)->Ok
} catch { } catch {
| ErrorException(e) => Error(e) | ErrorException(e) => Error(e)
| _ => raise(ErrorException(RETodo("internal exception"))) | _ => 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) parse(peggyCode)->Result.flatMap(evaluate)
} }

View File

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

View File

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

View File

@ -1,43 +1,32 @@
module BBindingsReplacer = Reducer_Expression_BindingsReplacer module BBindingsReplacer = Reducer_Expression_BindingsReplacer
module BErrorValue = Reducer_ErrorValue module BErrorValue = Reducer_ErrorValue
module T = Reducer_Expression_T module T = Reducer_T
module BInternalExpressionValue = ReducerInterface_InternalExpressionValue
module BBindings = Reducer_Bindings
type errorValue = BErrorValue.errorValue type errorValue = BErrorValue.errorValue
type expression = T.expression type expression = Reducer_T.expression
type expressionOrFFI = T.expressionOrFFI
type ffiFn = T.ffiFn
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
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)>) => let eBindings = (anArray: array<(string, T.value)>) =>
anArray->BBindings.fromArray->BBindings.toExpressionValue->T.EValue 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 => let eCall = (fn: expression, args: array<expression>): expression =>
name->BInternalExpressionValue.IEvCall->T.EValue T.ECall(fn, args)
let eFunction = (fName: string, lispArgs: list<expression>): expression => {
let fn = fName->eCall
list{fn, ...lispArgs}->T.EList
}
let eLambda = ( let eLambda = (
parameters: array<string>, parameters: array<string>,
expr: expression, 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 => let eSymbol = (name: string): expression =>
T.ESymbol(name) T.ESymbol(name)
@ -45,8 +34,11 @@ let eSymbol = (name: string): expression =>
let eBlock = (exprs: array<expression>): expression => let eBlock = (exprs: array<expression>): expression =>
T.EBlock(exprs) T.EBlock(exprs)
let eModule = (nameSpace: BInternalExpressionValue.nameSpace): expression => let eProgram = (exprs: array<expression>): expression =>
nameSpace->BInternalExpressionValue.IEvBindings->T.EValue T.EProgram(exprs)
let eModule = (nameSpace: T.nameSpace): expression =>
nameSpace->T.IEvBindings->T.EValue
let eLetStatement = (symbol: string, valueExpression: expression): expression => let eLetStatement = (symbol: string, valueExpression: expression): expression =>
T.EAssign(symbol, valueExpression) T.EAssign(symbol, valueExpression)
@ -55,9 +47,9 @@ let eTernary = (predicate: expression, trueCase: expression, falseCase: expressi
T.ETernary(predicate, trueCase, falseCase) T.ETernary(predicate, trueCase, falseCase)
let eIdentifier = (name: string): expression => let eIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvSymbol->T.EValue name->T.ESymbol
let eTypeIdentifier = (name: string): expression => // let eTypeIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvTypeIdentifier->T.EValue // 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 Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module ErrorValue = Reducer_ErrorValue 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 internalExpressionValue = ReducerInterface_InternalExpressionValue.t
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
external castInternalCodeToExpression: internalCode => expressionOrFFI = "%identity" let doLambdaCall = (
lambdaValue: Reducer_T.lambdaValue,
let checkArity = ( args,
lambdaValue: ExpressionValue.lambdaValue, environment: Reducer_T.environment,
args: list<internalExpressionValue>, reducer: Reducer_T.reducerFn
) => { ): Reducer_T.value => {
let reallyCheck = { lambdaValue.body(args, environment, reducer)
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>) => let makeLambda = (
args->Belt.List.reduceReverse(list{}, (acc, arg) => parameters: array<string>,
switch arg { bindings: Reducer_T.nameSpace,
| IEvSymbol(symbol) => raise(ErrorValue.ErrorException(ErrorValue.RESymbolNotFound(symbol))) body: Reducer_T.expression,
| _ => list{arg, ...acc} ): 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])
} }
) )
let caseNotFFI = ( reducer(body, { bindings: localBindings, environment })
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))
} }
LNoFFI({
context: bindings,
body: lambda,
parameters,
})
} }
let applyParametersToLambda = ( let makeFFILambda = () => raise(Not_found)
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,
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)
}

View File

@ -1,26 +1,26 @@
module ExpressionT = Reducer_Expression_T // module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue // module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionWithContext = Reducer_ExpressionWithContext // module ExpressionWithContext = Reducer_ExpressionWithContext
module Result = Belt.Result // module Result = Belt.Result
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T // module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T // module ProjectReducerFnT = ReducerProject_ReducerFn_T
type environment = InternalExpressionValue.environment // type environment = InternalExpressionValue.environment
type expression = ExpressionT.expression // type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t // type internalExpressionValue = InternalExpressionValue.t
type expressionWithContext = ExpressionWithContext.expressionWithContext // type expressionWithContext = ExpressionWithContext.expressionWithContext
let doMacroCall = ( // let doMacroCall = (
macroExpression: expression, // macroExpression: expression,
bindings: ExpressionT.bindings, // bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t, // accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t, // reduceExpression: ProjectReducerFnT.t,
): internalExpressionValue => // ): internalExpressionValue =>
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( // Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression, // macroExpression,
bindings, // bindings,
(accessors: ProjectAccessorsT.t), // (accessors: ProjectAccessorsT.t),
(reduceExpression: ProjectReducerFnT.t), // (reduceExpression: ProjectReducerFnT.t),
)->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression) // )->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 Extra = Reducer_Extra
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type internalExpressionValue = InternalExpressionValue.t type internalExpressionValue = Reducer_T.value
type environment = ReducerInterface_InternalExpressionValue.environment type environment = Reducer_T.environment
type rec expression = type expression = Reducer_T.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 t = expression type t = expression
type reducerFn = ( type context = Reducer_T.context
expression,
bindings, type reducerFn = Reducer_T.reducerFn
environment,
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue> let commaJoin = values => values->Reducer_Extra_Array.intersperse(", ")->Js.String.concatMany("")
/* /*
Converts the expression to String Converts the expression to String
*/ */
let rec toString = expression => "TODO" let rec toString = (expression: expression) =>
// switch expression { switch expression {
// | EList(list{EValue(IEvCall("$$_block_$$")), ...statements}) => | EBlock(statements) =>
// `{${Belt.List.map(statements, aValue => toString(aValue)) `{${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}}`
// ->Extra.List.intersperse("; ") | EProgram(statements) =>
// ->Belt.List.toArray `<${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}>`
// ->Js.String.concatMany("")}}` | EArray(aList) =>
// | EList(aList) => `[${Js.Array2.map(aList, aValue => toString(aValue))->commaJoin}]`
// `(${Belt.List.map(aList, aValue => toString(aValue)) | ERecord(map) => "TODO"
// ->Extra.List.intersperse(" ") | ESymbol(name) => name
// ->Belt.List.toArray | ETernary(predicate, trueCase, falseCase) => `${predicate->toString} ? (${trueCase->toString}) : (${falseCase->toString})`
// ->Js.String.concatMany("")})` | EAssign(name, value) => `${name} = ${value->toString}`
// | EValue(aValue) => InternalExpressionValue.toString(aValue) | 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 => let toStringResult = codeResult =>
switch codeResult { switch codeResult {

View File

@ -9,25 +9,27 @@ start
zeroOMoreArgumentsBlockOrExpression = innerBlockOrExpression / lambda zeroOMoreArgumentsBlockOrExpression = innerBlockOrExpression / lambda
// { return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
// {return [h.nodeVoid()];}
outerBlock outerBlock
= statements:array_statements finalExpression: (statementSeparator @expression)? = statements:array_statements finalExpression: (statementSeparator @expression)?
{ if (finalExpression != null) { if (finalExpression) statements.push(finalExpression)
{ return h.nodeProgram(statements) }
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]); // / '{' _nl finalExpression: expression _nl '}'
statements.push(newFinalExpression); // { return h.nodeBlock([finalExpression]) }
} // { if (finalExpression != null)
else // {
{ // var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]); // statements.push(newFinalExpression);
statements.push(newFinalStatement); // }
} // else
return h.nodeBlock(statements) } // {
/ finalExpression: expression // var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]);
{ // statements.push(newFinalStatement);
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]); // }
return h.nodeBlock([newFinalExpression])} // return h.nodeBlock(statements) }
// / finalExpression: expression
// {
// var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
// return h.nodeBlock([newFinalExpression])}
innerBlockOrExpression innerBlockOrExpression
= quotedInnerBlock = quotedInnerBlock
@ -36,7 +38,7 @@ innerBlockOrExpression
quotedInnerBlock quotedInnerBlock
= '{' _nl statements:array_statements finalExpression: (statementSeparator @expression) _nl '}' = '{' _nl statements:array_statements finalExpression: (statementSeparator @expression) _nl '}'
{ statements.push(finalExpression) { if (finalExpression) statements.push(finalExpression)
return h.nodeBlock(statements) } return h.nodeBlock(statements) }
/ '{' _nl finalExpression: expression _nl '}' / '{' _nl finalExpression: expression _nl '}'
{ return h.nodeBlock([finalExpression]) } { return h.nodeBlock([finalExpression]) }
@ -50,7 +52,7 @@ array_statements
statement statement
= letStatement = letStatement
/ defunStatement / defunStatement
/ typeStatement // / typeStatement
/ voidStatement / voidStatement
voidStatement voidStatement
@ -337,80 +339,80 @@ statementSeparator 'statement separator'
newLine "newline" newLine "newline"
= [\n\r] = [\n\r]
// Types // // Types
noArguments = ('(' _nl ')' )? // noArguments = ('(' _nl ')' )?
typeIdentifier 'type identifier' // typeIdentifier 'type identifier'
= ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())} // = ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
typeConstructorIdentifier 'type constructor identifier' // typeConstructorIdentifier 'type constructor identifier'
= ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())} // = ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
typeExpression = typePostModifierExpression // typeExpression = typePostModifierExpression
typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)* // typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
{ // {
return tail.reduce((result, element) => { // return tail.reduce((result, element) => {
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args]) // return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head) // }, head)
} // }
typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)* // typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
{ return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); } // { return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); }
typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)* // typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
{ return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); } // { return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); }
typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)* // typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
{ // {
return tail.reduce((result, element) => { // return tail.reduce((result, element) => {
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args]) // return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head) // }, head)
} // }
typeModifier // typeModifier
= modifier:identifier _ '(' _nl args:array_elements _nl ')' // = modifier:identifier _ '(' _nl args:array_elements _nl ')'
{ return {modifier: modifier, args: args}; } // { return {modifier: modifier, args: args}; }
/ modifier:identifier _ noArguments // / modifier:identifier _ noArguments
{ return {modifier: modifier, args: []}; } // { return {modifier: modifier, args: []}; }
basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier // basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
typeArray = '[' _nl elem:typeExpression _nl ']' // typeArray = '[' _nl elem:typeExpression _nl ']'
{return h.makeFunctionCall('$_typeArray_$', [elem])} // {return h.makeFunctionCall('$_typeArray_$', [elem])}
typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']' // typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
{ return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])} // { return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])}
array_typeTupleArguments // array_typeTupleArguments
= head:typeExpression tail:(_ ',' _nl @typeExpression)* // = head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; } // { return [head, ...tail]; }
typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}' // typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
{ return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); } // { return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); }
array_typeRecordArguments // array_typeRecordArguments
= head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)* // = head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
{ return [head, ...tail]; } // { return [head, ...tail]; }
typeKeyValuePair // typeKeyValuePair
= key:identifier _ ':' _nl value:typeExpression // = key:identifier _ ':' _nl value:typeExpression
{ return h.nodeKeyValue(key, value)} // { return h.nodeKeyValue(key, value)}
typeConstructor // typeConstructor
= constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')' // = constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); } // { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); }
/ constructor:typeConstructorIdentifier _ noArguments // / constructor:typeConstructorIdentifier _ noArguments
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); } // { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); }
array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)* // array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; } // { return [head, ...tail]; }
typeStatement = typeAliasStatement / typeOfStatement // typeStatement = typeAliasStatement / typeOfStatement
typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression // typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
{ return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])} // { return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression // typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
{ return h.makeFunctionCall('$_typeOf_$', [identifier, 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 nodeBlock = {...node, "statements": array<node>}
type nodeProgram = {...node, "statements": array<node>}
type nodeBoolean = {...node, "value": bool} type nodeBoolean = {...node, "value": bool}
type nodeCall = {...node, "fn": node, "args": array<node>} type nodeCall = {...node, "fn": node, "args": array<node>}
type nodeFloat = {...node, "value": float} type nodeFloat = {...node, "value": float}
@ -31,11 +32,12 @@ type nodeLetStatement = {...node, "variable": nodeIdentifier, "value": node}
type nodeModuleIdentifier = {...node, "value": string} type nodeModuleIdentifier = {...node, "value": string}
type nodeString = {...node, "value": string} type nodeString = {...node, "value": string}
type nodeTernary = {...node, "condition": node, "trueExpression": node, "falseExpression": node} type nodeTernary = {...node, "condition": node, "trueExpression": node, "falseExpression": node}
type nodeTypeIdentifier = {...node, "value": string} // type nodeTypeIdentifier = {...node, "value": string}
type nodeVoid = node type nodeVoid = node
type peggyNode = type peggyNode =
| PgNodeBlock(nodeBlock) | PgNodeBlock(nodeBlock)
| PgNodeProgram(nodeBlock)
| PgNodeBoolean(nodeBoolean) | PgNodeBoolean(nodeBoolean)
| PgNodeFloat(nodeFloat) | PgNodeFloat(nodeFloat)
| PgNodeCall(nodeCall) | PgNodeCall(nodeCall)
@ -47,10 +49,11 @@ type peggyNode =
| PgNodeModuleIdentifier(nodeModuleIdentifier) | PgNodeModuleIdentifier(nodeModuleIdentifier)
| PgNodeString(nodeString) | PgNodeString(nodeString)
| PgNodeTernary(nodeTernary) | PgNodeTernary(nodeTernary)
| PgNodeTypeIdentifier(nodeTypeIdentifier) // | PgNodeTypeIdentifier(nodeTypeIdentifier)
| PgNodeVoid(nodeVoid) | PgNodeVoid(nodeVoid)
external castNodeBlock: node => nodeBlock = "%identity" external castNodeBlock: node => nodeBlock = "%identity"
external castNodeProgram: node => nodeProgram = "%identity"
external castNodeBoolean: node => nodeBoolean = "%identity" external castNodeBoolean: node => nodeBoolean = "%identity"
external castNodeCall: node => nodeCall = "%identity" external castNodeCall: node => nodeCall = "%identity"
external castNodeFloat: node => nodeFloat = "%identity" external castNodeFloat: node => nodeFloat = "%identity"
@ -62,13 +65,14 @@ external castNodeLetStatement: node => nodeLetStatement = "%identity"
external castNodeModuleIdentifier: node => nodeModuleIdentifier = "%identity" external castNodeModuleIdentifier: node => nodeModuleIdentifier = "%identity"
external castNodeString: node => nodeString = "%identity" external castNodeString: node => nodeString = "%identity"
external castNodeTernary: node => nodeTernary = "%identity" external castNodeTernary: node => nodeTernary = "%identity"
external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity" // external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
external castNodeVoid: node => nodeVoid = "%identity" external castNodeVoid: node => nodeVoid = "%identity"
exception UnsupportedPeggyNodeType(string) // This should never happen; programming error exception UnsupportedPeggyNodeType(string) // This should never happen; programming error
let castNodeType = (node: node) => let castNodeType = (node: node) =>
switch node["type"] { switch node["type"] {
| "Block" => node->castNodeBlock->PgNodeBlock | "Block" => node->castNodeBlock->PgNodeBlock
| "Program" => node->castNodeBlock->PgNodeProgram
| "Boolean" => node->castNodeBoolean->PgNodeBoolean | "Boolean" => node->castNodeBoolean->PgNodeBoolean
| "Call" => node->castNodeCall->PgNodeCall | "Call" => node->castNodeCall->PgNodeCall
| "Float" => node->castNodeFloat->PgNodeFloat | "Float" => node->castNodeFloat->PgNodeFloat
@ -80,7 +84,7 @@ let castNodeType = (node: node) =>
| "ModuleIdentifier" => node->castNodeModuleIdentifier->PgNodeModuleIdentifier | "ModuleIdentifier" => node->castNodeModuleIdentifier->PgNodeModuleIdentifier
| "String" => node->castNodeString->PgNodeString | "String" => node->castNodeString->PgNodeString
| "Ternary" => node->castNodeTernary->PgNodeTernary | "Ternary" => node->castNodeTernary->PgNodeTernary
| "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier // | "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
| "Void" => node->castNodeVoid->PgNodeVoid | "Void" => node->castNodeVoid->PgNodeVoid
| _ => raise(UnsupportedPeggyNodeType(node["type"])) | _ => 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("") nodes->Js.Array2.map(toString)->Extra.Array.intersperse(separator)->Js.String.concatMany("")
switch peggyNode { switch peggyNode {
| PgNodeBlock(node) => "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}" | PgNodeBlock(node)
| PgNodeProgram(node)
=> "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}"
| PgNodeBoolean(node) => node["value"]->Js.String.make | PgNodeBoolean(node) => node["value"]->Js.String.make
| PgNodeCall(node) => "(" ++ node["fn"]->toString ++ " " ++ node["args"]->nodesToStringUsingSeparator(" ") ++ ")" | PgNodeCall(node) => "(" ++ node["fn"]->toString ++ " " ++ node["args"]->nodesToStringUsingSeparator(" ") ++ ")"
| PgNodeFloat(node) => node["value"]->Js.String.make | PgNodeFloat(node) => node["value"]->Js.String.make
@ -113,7 +119,7 @@ let rec pgToString = (peggyNode: peggyNode): string => {
toString(node["trueExpression"]) ++ toString(node["trueExpression"]) ++
" " ++ " " ++
toString(node["falseExpression"]) ++ ")" toString(node["falseExpression"]) ++ ")"
| PgNodeTypeIdentifier(node) => `#${node["value"]}` // | PgNodeTypeIdentifier(node) => `#${node["value"]}`
| PgNodeVoid(_node) => "()" | PgNodeVoid(_node) => "()"
} }
} }

View File

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

View File

@ -40,6 +40,11 @@ type NodeBlock = {
statements: AnyPeggyNode[]; statements: AnyPeggyNode[];
}; };
type NodeProgram = {
type: "Program";
statements: AnyPeggyNode[];
};
type NodeCall = { type NodeCall = {
type: "Call"; type: "Call";
fn: AnyPeggyNode; fn: AnyPeggyNode;
@ -99,6 +104,7 @@ type NodeBoolean = {
export type AnyPeggyNode = export type AnyPeggyNode =
| NodeBlock | NodeBlock
| NodeProgram
| NodeCall | NodeCall
| NodeFloat | NodeFloat
| NodeInteger | NodeInteger
@ -111,7 +117,11 @@ export type AnyPeggyNode =
| NodeBoolean; | NodeBoolean;
export function makeFunctionCall(fn: string, args: AnyPeggyNode[]) { export function makeFunctionCall(fn: string, args: AnyPeggyNode[]) {
if (fn === "$$_applyAll_$$") {
return nodeCall(args[0], args.splice(1));
} else {
return nodeCall(nodeIdentifier(fn), args); return nodeCall(nodeIdentifier(fn), args);
}
} }
export function constructArray(elems: AnyPeggyNode[]) { export function constructArray(elems: AnyPeggyNode[]) {
@ -124,6 +134,9 @@ export function constructRecord(elems: AnyPeggyNode[]) {
export function nodeBlock(statements: AnyPeggyNode[]): NodeBlock { export function nodeBlock(statements: AnyPeggyNode[]): NodeBlock {
return { type: "Block", statements }; return { type: "Block", statements };
} }
export function nodeProgram(statements: AnyPeggyNode[]): NodeProgram {
return { type: "Program", statements };
}
export function nodeBoolean(value: boolean): NodeBoolean { export function nodeBoolean(value: boolean): NodeBoolean {
return { type: "Boolean", value }; 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 Bindings = Reducer_Bindings
module ErrorValue = Reducer_ErrorValue // module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression // module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T // module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue // module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T // module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T // module T = Reducer_Type_T
module T = Reducer_Type_T
let ievFromTypeExpression = ( // let ievFromTypeExpression = (
typeExpressionSourceCode: string, // typeExpressionSourceCode: string,
reducerFn: ProjectReducerFnT.t, // reducerFn: Reducer_T.reducerFn,
): result<InternalExpressionValue.t, ErrorValue.t> => { // ): result<InternalExpressionValue.t, ErrorValue.t> => {
let sIndex = "compiled" // let sIndex = "compiled"
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}` // let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => { // Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
let accessors = ProjectAccessorsT.identityAccessors // let accessors = ProjectAccessorsT.identityAccessors
let result = reducerFn(expr, Bindings.emptyBindings, accessors) // let result = reducerFn(expr, Bindings.emptyBindings, accessors)
let nameSpace = accessors.states.continuation // let nameSpace = accessors.states.continuation
switch Bindings.getType(nameSpace, sIndex) { // switch Bindings.getType(nameSpace, sIndex) {
| Some(value) => value->Ok // | Some(value) => value->Ok
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none")) // | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
} // }
}) // })
} // }
let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: ProjectReducerFnT.t): result< // let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: Reducer_T.reducerFn): result<
T.t, // T.t,
ErrorValue.t, // ErrorValue.t,
> => { // > => {
ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue) // ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue)
} // }
let fromTypeExpressionExn = ( // let fromTypeExpressionExn = (
typeExpressionSourceCode: string, // typeExpressionSourceCode: string,
reducerFn: ProjectReducerFnT.t, // reducerFn: Reducer_T.reducerFn,
): T.t => // ): T.t =>
switch fromTypeExpression(typeExpressionSourceCode, reducerFn) { // switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
| Ok(value) => value // | Ok(value) => value
| _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise // | _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
} // }

View File

@ -1,119 +1,119 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue // module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open InternalExpressionValue // open InternalExpressionValue
type rec iType = // type rec iType =
| ItTypeIdentifier(string) // | ItTypeIdentifier(string)
| ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>}) // | ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>})
| ItTypeOr({typeOr: array<iType>}) // | ItTypeOr({typeOr: array<iType>})
| ItTypeFunction({inputs: array<iType>, output: iType}) // | ItTypeFunction({inputs: array<iType>, output: iType})
| ItTypeArray({element: iType}) // | ItTypeArray({element: iType})
| ItTypeTuple({elements: array<iType>}) // | ItTypeTuple({elements: array<iType>})
| ItTypeRecord({properties: Belt.Map.String.t<iType>}) // | ItTypeRecord({properties: Belt.Map.String.t<iType>})
type t = iType // type t = iType
type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t) // type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
let rec toString = (t: t): string => { // let rec toString = (t: t): string => {
switch t { // switch t {
| ItTypeIdentifier(s) => s // | ItTypeIdentifier(s) => s
| ItModifiedType({modifiedType, contracts}) => // | ItModifiedType({modifiedType, contracts}) =>
`${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) => // `${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) =>
Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"]) // Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
)}` // )}`
| ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})` // | ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
| ItTypeFunction({inputs, output}) => // | ItTypeFunction({inputs, output}) =>
`(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})` // `(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
| ItTypeArray({element}) => `[${toString(element)}]` // | ItTypeArray({element}) => `[${toString(element)}]`
| ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]` // | ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
| ItTypeRecord({properties}) => // | ItTypeRecord({properties}) =>
`{${properties // `{${properties
->Belt.Map.String.toArray // ->Belt.Map.String.toArray
->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)])) // ->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
->Js.Array2.joinWith(", ")}}` // ->Js.Array2.joinWith(", ")}}`
} // }
} // }
let toStringResult = (rt: result<t, ErrorValue.t>) => // let toStringResult = (rt: result<t, ErrorValue.t>) =>
switch rt { // switch rt {
| Ok(t) => toString(t) // | Ok(t) => toString(t)
| Error(e) => ErrorValue.errorToString(e) // | Error(e) => ErrorValue.errorToString(e)
} // }
let rec fromTypeMap = typeMap => { // let rec fromTypeMap = typeMap => {
let default = IEvString("") // let default = IEvString("")
let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"typeTag", // "typeTag",
default, // default,
) // )
let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"typeIdentifier", // "typeIdentifier",
default, // default,
) // )
let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"typeOr", // "typeOr",
default, // default,
) // )
let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"inputs", // "inputs",
default, // default,
) // )
let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"output", // "output",
default, // default,
) // )
let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"element", // "element",
default, // default,
) // )
let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"elements", // "elements",
default, // default,
) // )
let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault( // let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap, // typeMap,
"properties", // "properties",
default, // default,
) // )
let contracts = // let contracts =
typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k)) // typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
let makeIt = switch evTypeTag { // let makeIt = switch evTypeTag {
| IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier) // | IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
| IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)}) // | IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
| IEvString("typeFunction") => // | IEvString("typeFunction") =>
ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)}) // ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
| IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)}) // | IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
| IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)}) // | IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
| IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)}) // | IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag")) // | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
} // }
Belt.Map.String.isEmpty(contracts) // Belt.Map.String.isEmpty(contracts)
? makeIt // ? makeIt
: ItModifiedType({modifiedType: makeIt, contracts: contracts}) // : ItModifiedType({modifiedType: makeIt, contracts: contracts})
} // }
and fromIEvValue = (ievValue: InternalExpressionValue.t): iType => // and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
switch ievValue { // switch ievValue {
| IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier}) // | IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
| IEvType(typeMap) => fromTypeMap(typeMap) // | IEvType(typeMap) => fromTypeMap(typeMap)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue")) // | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
} // }
and fromIEvArray = (ievArray: InternalExpressionValue.t) => // and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
switch ievArray { // switch ievArray {
| IEvArray(array) => array->Belt.Array.map(fromIEvValue) // | IEvArray(array) => array->Belt.Array.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray")) // | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
} // }
and fromIEvRecord = (ievRecord: InternalExpressionValue.t) => // and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
switch ievRecord { // switch ievRecord {
| IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue) // | IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord")) // | _ => 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 typeModifier_memberOf = (aType, anArray) => {
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")), // ("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType), // ("typeIdentifier", aType),
]) // ])
newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok // newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
} // }
let typeModifier_memberOf_update = (aRecord, anArray) => { // let typeModifier_memberOf_update = (aRecord, anArray) => {
aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok // aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
} // }
let typeModifier_min = (aType, value) => { // let typeModifier_min = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")), // ("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType), // ("typeIdentifier", aType),
]) // ])
newRecord->Belt.Map.String.set("min", value)->IEvType->Ok // newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
} // }
let typeModifier_min_update = (aRecord, value) => { // let typeModifier_min_update = (aRecord, value) => {
aRecord->Belt.Map.String.set("min", value)->IEvType->Ok // aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
} // }
let typeModifier_max = (aType, value) => { // let typeModifier_max = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")), // ("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType), // ("typeIdentifier", aType),
]) // ])
newRecord->Belt.Map.String.set("max", value)->IEvType->Ok // newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
} // }
let typeModifier_max_update = (aRecord, value) => // let typeModifier_max_update = (aRecord, value) =>
aRecord->Belt.Map.String.set("max", value)->IEvType->Ok // aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
let typeModifier_opaque_update = aRecord => // let typeModifier_opaque_update = aRecord =>
aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok // aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
let typeOr = evArray => { // let typeOr = evArray => {
let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)]) // let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
newRecord->IEvType->Ok // newRecord->IEvType->Ok
} // }
let typeFunction = anArray => { // let typeFunction = anArray => {
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1) // let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1) // let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeFunction")), // ("typeTag", IEvString("typeFunction")),
("inputs", IEvArray(inputs)), // ("inputs", IEvArray(inputs)),
("output", output), // ("output", output),
]) // ])
newRecord->IEvType->Ok // newRecord->IEvType->Ok
} // }
let typeArray = element => { // let typeArray = element => {
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeArray")), // ("typeTag", IEvString("typeArray")),
("element", element), // ("element", element),
]) // ])
newRecord->IEvType->Ok // newRecord->IEvType->Ok
} // }
let typeTuple = anArray => { // let typeTuple = anArray => {
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeTuple")), // ("typeTag", IEvString("typeTuple")),
("elements", IEvArray(anArray)), // ("elements", IEvArray(anArray)),
]) // ])
newRecord->IEvType->Ok // newRecord->IEvType->Ok
} // }
let typeRecord = propertyMap => { // let typeRecord = propertyMap => {
let newProperties = propertyMap->IEvRecord // let newProperties = propertyMap->IEvRecord
let newRecord = Belt.Map.String.fromArray([ // let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeRecord")), // ("typeTag", IEvString("typeRecord")),
("properties", newProperties), // ("properties", newProperties),
]) // ])
newRecord->IEvType->Ok // newRecord->IEvType->Ok
} // }

View File

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

View File

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

View File

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

View File

@ -1,24 +1,21 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
type internalExpressionValue = InternalExpressionValue.t
/* /*
Map external calls of Reducer Map external calls of Reducer
*/ */
let dispatch = ( let dispatch = (
call: InternalExpressionValue.functionCall, call: InternalExpressionValue.functionCall,
accessors: ProjectAccessorsT.t, environment: Reducer_T.environment,
reducer: ProjectReducerFnT.t, reducer: Reducer_T.reducerFn,
chain, chain,
): result<internalExpressionValue, 'e> => { ): result<Reducer_T.value, 'e> => {
E.A.O.firstSomeFn([ E.A.O.firstSomeFn([
() => ReducerInterface_GenericDistribution.dispatch(call, accessors.environment), () => ReducerInterface_GenericDistribution.dispatch(call, environment),
() => ReducerInterface_Date.dispatch(call, accessors.environment), () => ReducerInterface_Date.dispatch(call, environment),
() => ReducerInterface_Duration.dispatch(call, accessors.environment), () => ReducerInterface_Duration.dispatch(call, environment),
() => ReducerInterface_Number.dispatch(call, accessors.environment), () => ReducerInterface_Number.dispatch(call, environment),
() => FunctionRegistry_Library.dispatch(call, accessors, reducer), () => FunctionRegistry_Library.dispatch(call, environment, reducer),
])->E.O2.defaultFn(() => chain(call, accessors, 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. 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. .e.g + - / * > >= < <= == /= not and or sin cos log ln concat, etc.
// See https://mathjs.org/docs/expressions/syntax.html // See https://mathjs.org/docs/expressions/syntax.html

View File

@ -297,12 +297,12 @@ let genericOutputToReducerValue = (o: DistributionOperation.outputType): result<
Reducer_ErrorValue.errorValue, Reducer_ErrorValue.errorValue,
> => > =>
switch o { switch o {
| Dist(d) => Ok(ReducerInterface_InternalExpressionValue.IEvDistribution(d)) | Dist(d) => Ok(Reducer_T.IEvDistribution(d))
| Float(d) => Ok(IEvNumber(d)) | Float(d) => Ok(IEvNumber(d))
| String(d) => Ok(IEvString(d)) | String(d) => Ok(IEvString(d))
| Bool(d) => Ok(IEvBool(d)) | Bool(d) => Ok(IEvBool(d))
| FloatArray(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)) | 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 ErrorValue = Reducer_ErrorValue
module Extra_Array = Reducer_Extra_Array module Extra_Array = Reducer_Extra_Array
type internalCode = Object
type environment = GenericDist.env type environment = GenericDist.env
module T = Reducer_T
let defaultEnvironment: environment = DistributionOperation.defaultEnv let defaultEnvironment: environment = DistributionOperation.defaultEnv
@genType.opaque type t = Reducer_T.value
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 internalExpressionValue = t type internalExpressionValue = t
type functionCall = (string, array<t>) type functionCall = (string, array<t>)
let rec toString = aValue => let rec toString = (aValue: T.value) =>
switch aValue { switch aValue {
| IEvArray(anArray) => toStringArray(anArray) | IEvArray(anArray) => toStringArray(anArray)
| IEvArrayString(anArray) => toStringArrayString(anArray) | IEvArrayString(anArray) => toStringArrayString(anArray)
| IEvBindings(m) => toStringBindings(m) | IEvBindings(m) => toStringBindings(m)
| IEvBool(aBool) => toStringBool(aBool) | IEvBool(aBool) => toStringBool(aBool)
| IEvCall(fName) => toStringCall(fName) // | IEvCall(fName) => toStringCall(fName)
| IEvDate(date) => toStringDate(date) | IEvDate(date) => toStringDate(date)
| IEvDeclaration(d) => toStringDeclaration(d) | IEvDeclaration(d) => toStringDeclaration(d)
| IEvDistribution(dist) => toStringDistribution(dist) | IEvDistribution(dist) => toStringDistribution(dist)
@ -53,7 +28,7 @@ let rec toString = aValue =>
| IEvNumber(aNumber) => toStringNumber(aNumber) | IEvNumber(aNumber) => toStringNumber(aNumber)
| IEvRecord(aMap) => aMap->toStringRecord | IEvRecord(aMap) => aMap->toStringRecord
| IEvString(aString) => toStringString(aString) | IEvString(aString) => toStringString(aString)
| IEvSymbol(aString) => toStringSymbol(aString) // | IEvSymbol(aString) => toStringSymbol(aString)
| IEvTimeDuration(t) => toStringTimeDuration(t) | IEvTimeDuration(t) => toStringTimeDuration(t)
| IEvType(aMap) => toStringType(aMap) | IEvType(aMap) => toStringType(aMap)
| IEvTypeIdentifier(id) => toStringTypeIdentifier(id) | IEvTypeIdentifier(id) => toStringTypeIdentifier(id)
@ -73,9 +48,12 @@ and toStringCall = fName => `:${fName}`
and toStringDate = date => DateTime.Date.toString(date) and toStringDate = date => DateTime.Date.toString(date)
and toStringDeclaration = d => Declaration.toString(d, r => toString(IEvLambda(r))) and toStringDeclaration = d => Declaration.toString(d, r => toString(IEvLambda(r)))
and toStringDistribution = dist => GenericDist.toString(dist) and toStringDistribution = dist => GenericDist.toString(dist)
and toStringLambda = lambdaValue => and toStringLambda = (lambdaValue: T.lambdaValue) =>
`lambda(${Js.Array2.toString(lambdaValue.parameters)}=>internal code)` switch lambdaValue {
and toStringFunction = lambdaValue => `function(${Js.Array2.toString(lambdaValue.parameters)})` | 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 toStringNumber = aNumber => Js.String.make(aNumber)
and toStringRecord = aMap => aMap->toStringMap and toStringRecord = aMap => aMap->toStringMap
and toStringString = aString => `'${aString}'` and toStringString = aString => `'${aString}'`
@ -94,17 +72,25 @@ and toStringMap = aMap => {
`{${pairs}}` `{${pairs}}`
} }
and toStringNameSpace = nameSpace => { and toStringNameSpace = nameSpace => {
let NameSpace(container, parent) = nameSpace let T.NameSpace(container, parent) = nameSpace
FIXME_CALL_PARENTS let pairs =
container->toStringMap 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 { switch aValue {
| IEvArray(_) => `Array::${toString(aValue)}` | IEvArray(_) => `Array::${toString(aValue)}`
| IEvArrayString(_) => `ArrayString::${toString(aValue)}` | IEvArrayString(_) => `ArrayString::${toString(aValue)}`
| IEvBool(_) => `Bool::${toString(aValue)}` | IEvBool(_) => `Bool::${toString(aValue)}`
| IEvCall(_) => `Call::${toString(aValue)}` // | IEvCall(_) => `Call::${toString(aValue)}`
| IEvDate(_) => `Date::${toString(aValue)}` | IEvDate(_) => `Date::${toString(aValue)}`
| IEvDeclaration(_) => `Declaration::${toString(aValue)}` | IEvDeclaration(_) => `Declaration::${toString(aValue)}`
| IEvDistribution(_) => `Distribution::${toString(aValue)}` | IEvDistribution(_) => `Distribution::${toString(aValue)}`
@ -113,7 +99,7 @@ let toStringWithType = aValue =>
| IEvNumber(_) => `Number::${toString(aValue)}` | IEvNumber(_) => `Number::${toString(aValue)}`
| IEvRecord(_) => `Record::${toString(aValue)}` | IEvRecord(_) => `Record::${toString(aValue)}`
| IEvString(_) => `String::${toString(aValue)}` | IEvString(_) => `String::${toString(aValue)}`
| IEvSymbol(_) => `Symbol::${toString(aValue)}` // | IEvSymbol(_) => `Symbol::${toString(aValue)}`
| IEvTimeDuration(_) => `Date::${toString(aValue)}` | IEvTimeDuration(_) => `Date::${toString(aValue)}`
| IEvType(_) => `Type::${toString(aValue)}` | IEvType(_) => `Type::${toString(aValue)}`
| IEvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}` | IEvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}`
@ -154,7 +140,7 @@ type internalExpressionValueType =
| EvtArray | EvtArray
| EvtArrayString | EvtArrayString
| EvtBool | EvtBool
| EvtCall // | EvtCall
| EvtDate | EvtDate
| EvtDeclaration | EvtDeclaration
| EvtDistribution | EvtDistribution
@ -163,7 +149,7 @@ type internalExpressionValueType =
| EvtNumber | EvtNumber
| EvtRecord | EvtRecord
| EvtString | EvtString
| EvtSymbol // | EvtSymbol
| EvtTimeDuration | EvtTimeDuration
| EvtType | EvtType
| EvtTypeIdentifier | EvtTypeIdentifier
@ -173,12 +159,12 @@ type functionCallSignature = CallSignature(string, array<internalExpressionValue
type functionDefinitionSignature = type functionDefinitionSignature =
FunctionDefinitionSignature(functionCallSignature, internalExpressionValueType) FunctionDefinitionSignature(functionCallSignature, internalExpressionValueType)
let valueToValueType = value => let valueToValueType = (value: T.value) =>
switch value { switch value {
| IEvArray(_) => EvtArray | IEvArray(_) => EvtArray
| IEvArrayString(_) => EvtArrayString | IEvArrayString(_) => EvtArrayString
| IEvBool(_) => EvtBool | IEvBool(_) => EvtBool
| IEvCall(_) => EvtCall // | IEvCall(_) => EvtCall
| IEvDate(_) => EvtDate | IEvDate(_) => EvtDate
| IEvDeclaration(_) => EvtDeclaration | IEvDeclaration(_) => EvtDeclaration
| IEvDistribution(_) => EvtDistribution | IEvDistribution(_) => EvtDistribution
@ -187,7 +173,7 @@ let valueToValueType = value =>
| IEvNumber(_) => EvtNumber | IEvNumber(_) => EvtNumber
| IEvRecord(_) => EvtRecord | IEvRecord(_) => EvtRecord
| IEvString(_) => EvtString | IEvString(_) => EvtString
| IEvSymbol(_) => EvtSymbol // | IEvSymbol(_) => EvtSymbol
| IEvTimeDuration(_) => EvtTimeDuration | IEvTimeDuration(_) => EvtTimeDuration
| IEvType(_) => EvtType | IEvType(_) => EvtType
| IEvTypeIdentifier(_) => EvtTypeIdentifier | IEvTypeIdentifier(_) => EvtTypeIdentifier
@ -204,7 +190,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
| EvtArray => `Array` | EvtArray => `Array`
| EvtArrayString => `ArrayString` | EvtArrayString => `ArrayString`
| EvtBool => `Bool` | EvtBool => `Bool`
| EvtCall => `Call` // | EvtCall => `Call`
| EvtDate => `Date` | EvtDate => `Date`
| EvtDeclaration => `Declaration` | EvtDeclaration => `Declaration`
| EvtDistribution => `Distribution` | EvtDistribution => `Distribution`
@ -213,7 +199,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
| EvtNumber => `Number` | EvtNumber => `Number`
| EvtRecord => `Record` | EvtRecord => `Record`
| EvtString => `String` | EvtString => `String`
| EvtSymbol => `Symbol` // | EvtSymbol => `Symbol`
| EvtTimeDuration => `Duration` | EvtTimeDuration => `Duration`
| EvtType => `Type` | EvtType => `Type`
| EvtTypeIdentifier => `TypeIdentifier` | EvtTypeIdentifier => `TypeIdentifier`
@ -227,10 +213,4 @@ let functionCallSignatureToString = (functionCallSignature: functionCallSignatur
let arrayToValueArray = (arr: array<t>): array<t> => arr let arrayToValueArray = (arr: array<t>): array<t> => arr
let recordToKeyValuePairs = (record: map): array<(string, t)> => record->Belt.Map.String.toArray let recordToKeyValuePairs = (record: T.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
}

View File

@ -39,7 +39,7 @@ let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
| "fromUnit_P") as op, | "fromUnit_P") as op,
[IEvNumber(f)], [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 | _ => None
} }
} }

View File

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

View File

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

View File

@ -1,40 +1,30 @@
module ProjectItemT = ReducerProject_ProjectItem_T // module ProjectItemT = ReducerProject_ProjectItem_T
module Bindings = Reducer_Bindings // module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type states = {mutable continuation: ProjectItemT.continuationArgumentType} // type states = {mutable continuation: ProjectItemT.continuationArgumentType}
type projectAccessors = { // type projectAccessors = {
stdLib: Reducer_Bindings.t, // stdLib: Reducer_Bindings.t,
environment: ExpressionT.environment, // environment: Reducer_T.environment,
states: states, // states: states,
} // }
type t = projectAccessors // type t = projectAccessors
let identityAccessors: t = { // let identityAccessors: t = {
// We need the states at the end of the runtime. // // We need the states at the end of the runtime.
// Accessors can be modified but states will stay as the same pointer // // Accessors can be modified but states will stay as the same pointer
states: { // states: {
continuation: Bindings.emptyBindings, // continuation: Reducer_Bindings.emptyBindings,
}, // },
stdLib: ReducerInterface_StdLib.internalStdLib, // stdLib: ReducerInterface_StdLib.internalStdLib,
environment: InternalExpressionValue.defaultEnvironment, // environment: InternalExpressionValue.defaultEnvironment,
} // }
let identityAccessorsWithEnvironment = (environment): t => { // // to support change of environment in runtime
states: { // let setEnvironment = (this: t, environment: Reducer_T.environment): t => {
continuation: Bindings.emptyBindings, // {
}, // ...this,
stdLib: ReducerInterface_StdLib.internalStdLib, // environment: environment,
environment: environment, // }
} // }
// to support change of environment in runtime
let setEnvironment = (this: t, environment: ExpressionT.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 // 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 module T = ReducerProject_ProjectItem_T
type projectItem = T.projectItem type projectItem = T.projectItem
type t = T.t type t = T.t
let emptyItem = T.ProjectItem({ let emptyItem: projectItem = {
source: "", source: "",
rawParse: None, rawParse: None,
expression: None, expression: None,
continuation: Bindings.emptyBindings, continuation: Reducer_Bindings.makeEmptyBindings(),
result: None, result: None,
continues: [], continues: [],
includes: []->Ok, includes: []->Ok,
directIncludes: [], directIncludes: [],
includeAsVariables: [], includeAsVariables: [],
}) }
// source -> rawParse -> includes -> expression -> continuation -> result // source -> rawParse -> includes -> expression -> continuation -> result
let getSource = (T.ProjectItem(r)): T.sourceType => r.source let getSource = (r: t): T.sourceType => r.source
let getRawParse = (T.ProjectItem(r)): T.rawParseType => r.rawParse let getRawParse = (r: t): T.rawParseType => r.rawParse
let getExpression = (T.ProjectItem(r)): T.expressionType => r.expression let getExpression = (r: t): T.expressionType => r.expression
let getContinuation = (T.ProjectItem(r)): T.continuationArgumentType => r.continuation let getContinuation = (r: t): T.continuationArgumentType => r.continuation
let getResult = (T.ProjectItem(r)): T.resultType => r.result let getResult = (r: t): T.resultType => r.result
let getContinues = (T.ProjectItem(r)): T.continuesType => r.continues let getContinues = (r: t): T.continuesType => r.continues
let getIncludes = (T.ProjectItem(r)): T.includesType => r.includes let getIncludes = (r: t): T.includesType => r.includes
let getDirectIncludes = (T.ProjectItem(r)): array<string> => r.directIncludes let getDirectIncludes = (r: t): array<string> => r.directIncludes
let getIncludesAsVariables = (T.ProjectItem(r)): T.importAsVariablesType => r.includeAsVariables let getIncludesAsVariables = (r: t): T.importAsVariablesType => r.includeAsVariables
let touchSource = (this: t): t => { let touchSource = (this: t): t => {
let T.ProjectItem(r) = emptyItem let r = emptyItem
T.ProjectItem({ {
...r, ...r,
source: getSource(this), source: getSource(this),
continues: getContinues(this), continues: getContinues(this),
includes: getIncludes(this), includes: getIncludes(this),
includeAsVariables: getIncludesAsVariables(this), includeAsVariables: getIncludesAsVariables(this),
directIncludes: getDirectIncludes(this), directIncludes: getDirectIncludes(this),
}) }
} }
let touchRawParse = (this: t): t => { let touchRawParse = (this: t): t => {
let T.ProjectItem(r) = emptyItem {
T.ProjectItem({ ...emptyItem,
...r,
source: getSource(this), source: getSource(this),
continues: getContinues(this), continues: getContinues(this),
includes: getIncludes(this), includes: getIncludes(this),
includeAsVariables: getIncludesAsVariables(this), includeAsVariables: getIncludesAsVariables(this),
directIncludes: getDirectIncludes(this), directIncludes: getDirectIncludes(this),
rawParse: getRawParse(this), rawParse: getRawParse(this),
}) }
} }
let touchExpression = (this: t): t => { let touchExpression = (this: t): t => {
let T.ProjectItem(r) = emptyItem {
T.ProjectItem({ ...this,
...r,
source: getSource(this), source: getSource(this),
continues: getContinues(this), continues: getContinues(this),
includes: getIncludes(this), includes: getIncludes(this),
@ -71,46 +62,40 @@ let touchExpression = (this: t): t => {
directIncludes: getDirectIncludes(this), directIncludes: getDirectIncludes(this),
rawParse: getRawParse(this), rawParse: getRawParse(this),
expression: getExpression(this), expression: getExpression(this),
}) }
} }
let resetIncludes = (T.ProjectItem(r): t): t => { let resetIncludes = (r: t): t => {
T.ProjectItem({
...r, ...r,
includes: []->Ok, includes: []->Ok,
includeAsVariables: [], includeAsVariables: [],
directIncludes: [], directIncludes: [],
})
} }
let setSource = (T.ProjectItem(r): t, source: T.sourceArgumentType): t => let setSource = (r: t, source: T.sourceArgumentType): t =>
T.ProjectItem({...r, source: source})->resetIncludes->touchSource {...r, source: source}->resetIncludes->touchSource
let setRawParse = (T.ProjectItem(r): t, rawParse: T.rawParseArgumentType): t => let setRawParse = (r: t, rawParse: T.rawParseArgumentType): t =>
T.ProjectItem({...r, rawParse: Some(rawParse)})->touchRawParse {...r, rawParse: Some(rawParse)}->touchRawParse
let setExpression = (T.ProjectItem(r): t, expression: T.expressionArgumentType): t => let setExpression = (r: t, expression: T.expressionArgumentType): t =>
T.ProjectItem({...r, expression: Some(expression)})->touchExpression {...r, expression: Some(expression)}->touchExpression
let setContinuation = (T.ProjectItem(r): t, continuation: T.continuationArgumentType): t => { let setContinuation = (r: t, continuation: T.continuationArgumentType): t =>
T.ProjectItem({...r, continuation: continuation}) {...r, continuation: continuation}
}
let setResult = (T.ProjectItem(r): t, result: T.resultArgumentType): t => T.ProjectItem({ let setResult = (r: t, result: T.resultArgumentType): t => {
...r, ...r,
result: Some(result), result: Some(result),
}) }
let cleanResults = touchExpression let cleanResults = touchExpression
let clean = (this: t): t => { let clean = (this: t): t => {
let T.ProjectItem(r) = emptyItem ...this,
T.ProjectItem({
...r,
source: getSource(this), source: getSource(this),
continuation: getContinuation(this), continuation: getContinuation(this),
result: getResult(this), result: getResult(this),
})
} }
let getImmediateDependencies = (this: t): T.includesType => let getImmediateDependencies = (this: t): T.includesType =>
@ -120,27 +105,27 @@ let getPastChain = (this: t): array<string> => {
Js.Array2.concat(getDirectIncludes(this), getContinues(this)) Js.Array2.concat(getDirectIncludes(this), getContinues(this))
} }
let setContinues = (T.ProjectItem(r): t, continues: array<string>): t => let setContinues = (this: t, continues: array<string>): t =>
T.ProjectItem({...r, continues: continues})->touchSource {...this, continues: continues}->touchSource
let removeContinues = (T.ProjectItem(r): t): t => T.ProjectItem({...r, continues: []})->touchSource
let setIncludes = (T.ProjectItem(r): t, includes: T.includesType): t => T.ProjectItem({ let removeContinues = (this: t): t => {...this, continues: []}->touchSource
...r,
let setIncludes = (this: t, includes: T.includesType): t => {
...this,
includes: includes, includes: includes,
}) }
let setImportAsVariables = ( let setImportAsVariables = (
T.ProjectItem(r): t, this: t,
includeAsVariables: T.importAsVariablesType, 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({ let setDirectImports = (this: t, directIncludes: array<string>): t => {
...r, ...this,
directIncludes: directIncludes, directIncludes: directIncludes,
}) }
let parseIncludes = (this: t): t => { let parseIncludes = (this: t): t => {
let T.ProjectItem(r) = this
let rRawImportAsVariables = getSource(this)->ReducerProject_ParseIncludes.parseIncludes let rRawImportAsVariables = getSource(this)->ReducerProject_ParseIncludes.parseIncludes
switch rRawImportAsVariables { switch rRawImportAsVariables {
| Error(e) => resetIncludes(this)->setIncludes(Error(e)) | Error(e) => resetIncludes(this)->setIncludes(Error(e))
@ -152,12 +137,12 @@ let parseIncludes = (this: t): t => {
rawImportAsVariables rawImportAsVariables
->Belt.Array.keep(((variable, _file)) => variable == "") ->Belt.Array.keep(((variable, _file)) => variable == "")
->Belt.Array.map(((_variable, file)) => file) ->Belt.Array.map(((_variable, file)) => file)
T.ProjectItem({ {
...r, ...this,
includes: includes, includes: includes,
includeAsVariables: includeAsVariables, includeAsVariables: includeAsVariables,
directIncludes: directIncludes, 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)) ->Belt.Option.map(o => o->Belt.Result.map(r => r->Reducer_Peggy_ToExpression.fromNode))
let buildExpression = (this: t): t => { let buildExpression = (this: t): t => {
let withRawParse: t = this->rawParse let this = this->rawParse
switch withRawParse->getExpression { switch this->getExpression {
| Some(_) => withRawParse | Some(_) => this // cached
| None => | None =>
withRawParse
->doBuildExpression
->Belt.Option.map(setExpression(withRawParse, _))
->E.O2.defaultFn(() => withRawParse)
}
}
let doBuildResult = (
this: t,
aContinuation: T.continuation,
accessors: ProjectAccessorsT.t,
): T.resultType =>
this this
->getExpression ->doBuildExpression
->Belt.Option.map( ->Belt.Option.map(setExpression(this, _))
Belt.Result.flatMap(_, expression => ->E.O2.defaultFn(() => this)
try {
Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
} catch {
| Reducer_ErrorValue.ErrorException(e) => e->Error
| _ => RETodo("unhandled rescript exception")->Error
}
),
)
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 run = buildResult let failRun = (
this: t,
e: Reducer_ErrorValue.errorValue
): t => this->setResult(e->Error)->setContinuation(Reducer_Bindings.makeEmptyBindings())
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)
}
}

View File

@ -1,6 +1,5 @@
module Parse = Reducer_Peggy_Parse module Parse = Reducer_Peggy_Parse
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue open Reducer_ErrorValue
type sourceArgumentType = string type sourceArgumentType = string
@ -9,13 +8,13 @@ type rawParseArgumentType = result<Parse.node, errorValue>
type rawParseType = option<rawParseArgumentType> type rawParseType = option<rawParseArgumentType>
type expressionArgumentType = result<ExpressionT.t, errorValue> type expressionArgumentType = result<ExpressionT.t, errorValue>
type expressionType = option<expressionArgumentType> type expressionType = option<expressionArgumentType>
type continuation = InternalExpressionValue.nameSpace type continuation = Reducer_T.nameSpace
type continuationArgumentType = InternalExpressionValue.nameSpace type continuationArgumentType = Reducer_T.nameSpace
type continuationType = option<continuationArgumentType> type continuationType = option<continuationArgumentType>
type continuationResultType = option<result<continuationArgumentType, errorValue>> type continuationResultType = option<result<continuationArgumentType, errorValue>>
type bindingsArgumentType = InternalExpressionValue.nameSpace type bindingsArgumentType = Reducer_T.nameSpace
type bindingsType = option<bindingsArgumentType> type bindingsType = option<bindingsArgumentType>
type resultArgumentType = result<InternalExpressionValue.t, errorValue> type resultArgumentType = result<Reducer_T.value, errorValue>
type resultType = option<resultArgumentType> type resultType = option<resultArgumentType>
type continuesArgumentType = array<string> type continuesArgumentType = array<string>
type continuesType = array<string> type continuesType = array<string>
@ -23,8 +22,7 @@ type includesArgumentType = string
type includesType = result<array<string>, errorValue> type includesType = result<array<string>, errorValue>
type importAsVariablesType = array<(string, string)> type importAsVariablesType = array<(string, string)>
type projectItem = type projectItem = {
| ProjectItem({
source: sourceType, source: sourceType,
rawParse: rawParseType, rawParse: rawParseType,
expression: expressionType, expression: expressionType,
@ -34,6 +32,6 @@ type projectItem =
includes: includesType, //For loader includes: includesType, //For loader
includeAsVariables: importAsVariablesType, //For linker includeAsVariables: importAsVariablesType, //For linker
directIncludes: array<string>, directIncludes: array<string>,
}) //For linker }
type t = projectItem 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 ProjectItem = ReducerProject_ProjectItem
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
@genType.opaque @genType.opaque
type project = {"iAmProject": bool} type project = {
//re-export items: Belt.MutableMap.String.t<ProjectItem.t>,
@genType mutable stdLib: Reducer_Bindings.t,
mutable environment: ExpressionT.environment,
mutable previousRunOrder: array<string>,
}
type t = project type t = project
module Private = { // these functions are used in ReducerProject_Topology, so they are defined here to avoid circular dependencies
type internalProject = { let getSourceIds = (project: t): array<string> => Belt.MutableMap.String.keysToArray(project.items)
"iAmProject": bool,
"items": Belt.Map.String.t<ProjectItem.t>,
"stdLib": Reducer_Bindings.t,
"environment": ExpressionT.environment,
"previousRunOrder": array<string>,
}
type t = internalProject
@set let getItem = (project: t, sourceId: string) =>
external setFieldItems: (t, Belt.Map.String.t<ProjectItem.t>) => unit = "items" Belt.MutableMap.String.getWithDefault(project.items, sourceId, ProjectItem.emptyItem)
@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)
}

View File

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

View File

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

View File

@ -1,9 +1,9 @@
module Bindings = Reducer_Bindings 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 ]->Bindings.fromArray
let makeBindings = (previousBindings: Bindings.t): Bindings.t => let makeBindings = (previousBindings: Reducer_T.nameSpace): Reducer_T.nameSpace =>
previousBindings->Bindings.mergeFrom(bindings) previousBindings->Bindings.mergeFrom(bindings)