WIP (basic functionality, stdlib not converted yet)
This commit is contained in:
parent
fe56e81710
commit
7a29be3845
|
@ -7,21 +7,21 @@ open Expect
|
|||
open Expect.Operators
|
||||
|
||||
describe("Name Space", () => {
|
||||
let value = InternalExpressionValue.IEvNumber(1967.0)
|
||||
let nameSpace = Bindings.emptyNameSpace->Bindings.set("value", value)
|
||||
let value = Reducer_T.IEvNumber(1967.0)
|
||||
let nameSpace = Bindings.makeEmptyBindings()->Bindings.set("value", value)
|
||||
test("get", () => {
|
||||
expect(Bindings.get(nameSpace, "value")) == Some(value)
|
||||
})
|
||||
|
||||
test("chain and get", () => {
|
||||
let mainNameSpace = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
|
||||
let mainNameSpace = Bindings.makeEmptyBindings()->Bindings.chainTo([nameSpace])
|
||||
expect(Bindings.get(mainNameSpace, "value")) == Some(value)
|
||||
})
|
||||
|
||||
test("chain and set", () => {
|
||||
let mainNameSpace0 = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
|
||||
let mainNameSpace0 = Bindings.makeEmptyBindings()->Bindings.chainTo([nameSpace])
|
||||
let mainNameSpace =
|
||||
mainNameSpace0->Bindings.set("value", InternalExpressionValue.IEvNumber(1968.0))
|
||||
expect(Bindings.get(mainNameSpace, "value")) == Some(InternalExpressionValue.IEvNumber(1968.0))
|
||||
mainNameSpace0->Bindings.set("value", Reducer_T.IEvNumber(1968.0))
|
||||
expect(Bindings.get(mainNameSpace, "value")) == Some(Reducer_T.IEvNumber(1968.0))
|
||||
})
|
||||
})
|
||||
|
|
|
@ -1,146 +1,146 @@
|
|||
open Jest
|
||||
// open Expect
|
||||
// open Jest
|
||||
// // open Expect
|
||||
|
||||
open Reducer_Expression_ExpressionBuilder
|
||||
open Reducer_TestMacroHelpers
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
// open Reducer_Expression_ExpressionBuilder
|
||||
// open Reducer_TestMacroHelpers
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
|
||||
let exampleExpression = eNumber(1.)
|
||||
let exampleExpressionY = eSymbol("y")
|
||||
let exampleStatementY = eLetStatement("y", eNumber(1.))
|
||||
let exampleStatementX = eLetStatement("y", eSymbol("x"))
|
||||
let exampleStatementZ = eLetStatement("z", eSymbol("y"))
|
||||
// let exampleExpression = eNumber(1.)
|
||||
// let exampleExpressionY = eSymbol("y")
|
||||
// let exampleStatementY = eLetStatement("y", eNumber(1.))
|
||||
// let exampleStatementX = eLetStatement("y", eSymbol("x"))
|
||||
// let exampleStatementZ = eLetStatement("z", eSymbol("y"))
|
||||
|
||||
// If it is not a macro then it is not expanded
|
||||
testMacro([], exampleExpression, "Ok(1)")
|
||||
// // If it is not a macro then it is not expanded
|
||||
// testMacro([], exampleExpression, "Ok(1)")
|
||||
|
||||
describe("bindStatement", () => {
|
||||
// A statement is bound by the bindings created by the previous statement
|
||||
testMacro(
|
||||
[],
|
||||
eBindStatement(eBindings([]), exampleStatementY),
|
||||
"Ok((:$_setBindings_$ @{} :y 1) context: @{})",
|
||||
)
|
||||
// Then it answers the bindings for the next statement when reduced
|
||||
testMacroEval([], eBindStatement(eBindings([]), exampleStatementY), "Ok(@{y: 1})")
|
||||
// Now let's feed a binding to see what happens
|
||||
testMacro(
|
||||
[],
|
||||
eBindStatement(eBindings([("x", IEvNumber(2.))]), exampleStatementX),
|
||||
"Ok((:$_setBindings_$ @{x: 2} :y 2) context: @{x: 2})",
|
||||
)
|
||||
// An expression does not return a binding, thus error
|
||||
testMacro([], eBindStatement(eBindings([]), exampleExpression), "Assignment expected")
|
||||
// When bindings from previous statement are missing the context is injected. This must be the first statement of a block
|
||||
testMacro(
|
||||
[("z", IEvNumber(99.))],
|
||||
eBindStatementDefault(exampleStatementY),
|
||||
"Ok((:$_setBindings_$ @{z: 99} :y 1) context: @{z: 99})",
|
||||
)
|
||||
})
|
||||
// describe("bindStatement", () => {
|
||||
// // A statement is bound by the bindings created by the previous statement
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBindStatement(eBindings([]), exampleStatementY),
|
||||
// "Ok((:$_setBindings_$ @{} :y 1) context: @{})",
|
||||
// )
|
||||
// // Then it answers the bindings for the next statement when reduced
|
||||
// testMacroEval([], eBindStatement(eBindings([]), exampleStatementY), "Ok(@{y: 1})")
|
||||
// // Now let's feed a binding to see what happens
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBindStatement(eBindings([("x", IEvNumber(2.))]), exampleStatementX),
|
||||
// "Ok((:$_setBindings_$ @{x: 2} :y 2) context: @{x: 2})",
|
||||
// )
|
||||
// // An expression does not return a binding, thus error
|
||||
// testMacro([], eBindStatement(eBindings([]), exampleExpression), "Assignment expected")
|
||||
// // When bindings from previous statement are missing the context is injected. This must be the first statement of a block
|
||||
// testMacro(
|
||||
// [("z", IEvNumber(99.))],
|
||||
// eBindStatementDefault(exampleStatementY),
|
||||
// "Ok((:$_setBindings_$ @{z: 99} :y 1) context: @{z: 99})",
|
||||
// )
|
||||
// })
|
||||
|
||||
describe("bindExpression", () => {
|
||||
// x is simply bound in the expression
|
||||
testMacro(
|
||||
[],
|
||||
eBindExpression(eBindings([("x", IEvNumber(2.))]), eSymbol("x")),
|
||||
"Ok(2 context: @{x: 2})",
|
||||
)
|
||||
// When an let statement is the end expression then bindings are returned
|
||||
testMacro(
|
||||
[],
|
||||
eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
|
||||
"Ok((:$_exportBindings_$ (:$_setBindings_$ @{x: 2} :y 1)) context: @{x: 2})",
|
||||
)
|
||||
// Now let's reduce that expression
|
||||
testMacroEval(
|
||||
[],
|
||||
eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
|
||||
"Ok(@{x: 2,y: 1})",
|
||||
)
|
||||
// When bindings are missing the context is injected. This must be the first and last statement of a block
|
||||
testMacroEval(
|
||||
[("z", IEvNumber(99.))],
|
||||
eBindExpressionDefault(exampleStatementY),
|
||||
"Ok(@{y: 1,z: 99})",
|
||||
)
|
||||
})
|
||||
// describe("bindExpression", () => {
|
||||
// // x is simply bound in the expression
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBindExpression(eBindings([("x", IEvNumber(2.))]), eSymbol("x")),
|
||||
// "Ok(2 context: @{x: 2})",
|
||||
// )
|
||||
// // When an let statement is the end expression then bindings are returned
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
|
||||
// "Ok((:$_exportBindings_$ (:$_setBindings_$ @{x: 2} :y 1)) context: @{x: 2})",
|
||||
// )
|
||||
// // Now let's reduce that expression
|
||||
// testMacroEval(
|
||||
// [],
|
||||
// eBindExpression(eBindings([("x", IEvNumber(2.))]), exampleStatementY),
|
||||
// "Ok(@{x: 2,y: 1})",
|
||||
// )
|
||||
// // When bindings are missing the context is injected. This must be the first and last statement of a block
|
||||
// testMacroEval(
|
||||
// [("z", IEvNumber(99.))],
|
||||
// eBindExpressionDefault(exampleStatementY),
|
||||
// "Ok(@{y: 1,z: 99})",
|
||||
// )
|
||||
// })
|
||||
|
||||
describe("block", () => {
|
||||
// Block with a single expression
|
||||
testMacro([], eBlock(list{exampleExpression}), "Ok((:$$_bindExpression_$$ 1))")
|
||||
testMacroEval([], eBlock(list{exampleExpression}), "Ok(1)")
|
||||
// Block with a single statement
|
||||
testMacro([], eBlock(list{exampleStatementY}), "Ok((:$$_bindExpression_$$ (:$_let_$ :y 1)))")
|
||||
testMacroEval([], eBlock(list{exampleStatementY}), "Ok(@{y: 1})")
|
||||
// Block with a statement and an expression
|
||||
testMacro(
|
||||
[],
|
||||
eBlock(list{exampleStatementY, exampleExpressionY}),
|
||||
"Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) :y))",
|
||||
)
|
||||
testMacroEval([], eBlock(list{exampleStatementY, exampleExpressionY}), "Ok(1)")
|
||||
// Block with a statement and another statement
|
||||
testMacro(
|
||||
[],
|
||||
eBlock(list{exampleStatementY, exampleStatementZ}),
|
||||
"Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) (:$_let_$ :z :y)))",
|
||||
)
|
||||
testMacroEval([], eBlock(list{exampleStatementY, exampleStatementZ}), "Ok(@{y: 1,z: 1})")
|
||||
// Block inside a block
|
||||
testMacro([], eBlock(list{eBlock(list{exampleExpression})}), "Ok((:$$_bindExpression_$$ {1}))")
|
||||
testMacroEval([], eBlock(list{eBlock(list{exampleExpression})}), "Ok(1)")
|
||||
// Block assigned to a variable
|
||||
testMacro(
|
||||
[],
|
||||
eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
|
||||
"Ok((:$$_bindExpression_$$ (:$_let_$ :z {{:y}})))",
|
||||
)
|
||||
testMacroEval(
|
||||
[],
|
||||
eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
|
||||
"Ok(@{z: :y})",
|
||||
)
|
||||
// Empty block
|
||||
testMacro([], eBlock(list{}), "Ok(:undefined block)") //TODO: should be an error
|
||||
// :$$_block_$$ (:$$_block_$$ (:$_let_$ :y (:add :x 1)) :y)"
|
||||
testMacro(
|
||||
[],
|
||||
eBlock(list{
|
||||
eBlock(list{
|
||||
eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
|
||||
eSymbol("y"),
|
||||
}),
|
||||
}),
|
||||
"Ok((:$$_bindExpression_$$ {(:$_let_$ :y (:add :x 1)); :y}))",
|
||||
)
|
||||
testMacroEval(
|
||||
[("x", IEvNumber(1.))],
|
||||
eBlock(list{
|
||||
eBlock(list{
|
||||
eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
|
||||
eSymbol("y"),
|
||||
}),
|
||||
}),
|
||||
"Ok(2)",
|
||||
)
|
||||
})
|
||||
// describe("block", () => {
|
||||
// // Block with a single expression
|
||||
// testMacro([], eBlock(list{exampleExpression}), "Ok((:$$_bindExpression_$$ 1))")
|
||||
// testMacroEval([], eBlock(list{exampleExpression}), "Ok(1)")
|
||||
// // Block with a single statement
|
||||
// testMacro([], eBlock(list{exampleStatementY}), "Ok((:$$_bindExpression_$$ (:$_let_$ :y 1)))")
|
||||
// testMacroEval([], eBlock(list{exampleStatementY}), "Ok(@{y: 1})")
|
||||
// // Block with a statement and an expression
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBlock(list{exampleStatementY, exampleExpressionY}),
|
||||
// "Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) :y))",
|
||||
// )
|
||||
// testMacroEval([], eBlock(list{exampleStatementY, exampleExpressionY}), "Ok(1)")
|
||||
// // Block with a statement and another statement
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBlock(list{exampleStatementY, exampleStatementZ}),
|
||||
// "Ok((:$$_bindExpression_$$ (:$$_bindStatement_$$ (:$_let_$ :y 1)) (:$_let_$ :z :y)))",
|
||||
// )
|
||||
// testMacroEval([], eBlock(list{exampleStatementY, exampleStatementZ}), "Ok(@{y: 1,z: 1})")
|
||||
// // Block inside a block
|
||||
// testMacro([], eBlock(list{eBlock(list{exampleExpression})}), "Ok((:$$_bindExpression_$$ {1}))")
|
||||
// testMacroEval([], eBlock(list{eBlock(list{exampleExpression})}), "Ok(1)")
|
||||
// // Block assigned to a variable
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
|
||||
// "Ok((:$$_bindExpression_$$ (:$_let_$ :z {{:y}})))",
|
||||
// )
|
||||
// testMacroEval(
|
||||
// [],
|
||||
// eBlock(list{eLetStatement("z", eBlock(list{eBlock(list{exampleExpressionY})}))}),
|
||||
// "Ok(@{z: :y})",
|
||||
// )
|
||||
// // Empty block
|
||||
// testMacro([], eBlock(list{}), "Ok(:undefined block)") //TODO: should be an error
|
||||
// // :$$_block_$$ (:$$_block_$$ (:$_let_$ :y (:add :x 1)) :y)"
|
||||
// testMacro(
|
||||
// [],
|
||||
// eBlock(list{
|
||||
// eBlock(list{
|
||||
// eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
|
||||
// eSymbol("y"),
|
||||
// }),
|
||||
// }),
|
||||
// "Ok((:$$_bindExpression_$$ {(:$_let_$ :y (:add :x 1)); :y}))",
|
||||
// )
|
||||
// testMacroEval(
|
||||
// [("x", IEvNumber(1.))],
|
||||
// eBlock(list{
|
||||
// eBlock(list{
|
||||
// eLetStatement("y", eFunction("add", list{eSymbol("x"), eNumber(1.)})),
|
||||
// eSymbol("y"),
|
||||
// }),
|
||||
// }),
|
||||
// "Ok(2)",
|
||||
// )
|
||||
// })
|
||||
|
||||
describe("lambda", () => {
|
||||
// assign a lambda to a variable
|
||||
let lambdaExpression = eFunction("$$_lambda_$$", list{eArrayString(["y"]), exampleExpressionY})
|
||||
testMacro([], lambdaExpression, "Ok(lambda(y=>internal code))")
|
||||
// call a lambda
|
||||
let callLambdaExpression = list{lambdaExpression, eNumber(1.)}->ExpressionT.EList
|
||||
testMacro([], callLambdaExpression, "Ok(((:$$_lambda_$$ [y] :y) 1))")
|
||||
testMacroEval([], callLambdaExpression, "Ok(1)")
|
||||
// Parameters shadow the outer scope
|
||||
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(1)")
|
||||
// When not shadowed by the parameters, the outer scope variables are available
|
||||
let lambdaExpression = eFunction(
|
||||
"$$_lambda_$$",
|
||||
list{eArrayString(["z"]), eFunction("add", list{eSymbol("y"), eSymbol("z")})},
|
||||
)
|
||||
let callLambdaExpression = eList(list{lambdaExpression, eNumber(1.)})
|
||||
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(667)")
|
||||
})
|
||||
// describe("lambda", () => {
|
||||
// // assign a lambda to a variable
|
||||
// let lambdaExpression = eFunction("$$_lambda_$$", list{eArrayString(["y"]), exampleExpressionY})
|
||||
// testMacro([], lambdaExpression, "Ok(lambda(y=>internal code))")
|
||||
// // call a lambda
|
||||
// let callLambdaExpression = list{lambdaExpression, eNumber(1.)}->ExpressionT.EList
|
||||
// testMacro([], callLambdaExpression, "Ok(((:$$_lambda_$$ [y] :y) 1))")
|
||||
// testMacroEval([], callLambdaExpression, "Ok(1)")
|
||||
// // Parameters shadow the outer scope
|
||||
// testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(1)")
|
||||
// // When not shadowed by the parameters, the outer scope variables are available
|
||||
// let lambdaExpression = eFunction(
|
||||
// "$$_lambda_$$",
|
||||
// list{eArrayString(["z"]), eFunction("add", list{eSymbol("y"), eSymbol("z")})},
|
||||
// )
|
||||
// let callLambdaExpression = eList(list{lambdaExpression, eNumber(1.)})
|
||||
// testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(667)")
|
||||
// })
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
// Reducer_Helpers
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
|
||||
module Bindings = Reducer_Bindings
|
||||
|
||||
let removeDefaultsInternal = (iev: InternalExpressionValue.t) => {
|
||||
switch iev {
|
||||
| InternalExpressionValue.IEvBindings(nameSpace) =>
|
||||
Bindings.removeOther(
|
||||
nameSpace,
|
||||
ReducerInterface.StdLib.internalStdLib,
|
||||
)->InternalExpressionValue.IEvBindings
|
||||
| value => value
|
||||
}
|
||||
Not_found->raise
|
||||
// switch iev {
|
||||
// | Reducer_T.IEvBindings(nameSpace) =>
|
||||
// Reducer_Bindings.removeOther(
|
||||
// nameSpace,
|
||||
// ReducerInterface.StdLib.internalStdLib,
|
||||
// )->Reducer_T.IEvBindings
|
||||
// | value => value
|
||||
// }
|
||||
}
|
||||
|
||||
let rRemoveDefaultsInternal = r => Belt.Result.map(r, removeDefaultsInternal)
|
||||
|
|
|
@ -9,7 +9,7 @@ open Expect
|
|||
let unwrapRecord = rValue =>
|
||||
rValue->Belt.Result.flatMap(value =>
|
||||
switch value {
|
||||
| InternalExpressionValue.IEvRecord(aRecord) => Ok(aRecord)
|
||||
| Reducer_T.IEvRecord(aRecord) => Ok(aRecord)
|
||||
| _ => ErrorValue.RETodo("TODO: Internal bindings must be returned")->Error
|
||||
}
|
||||
)
|
||||
|
|
|
@ -1,90 +1,89 @@
|
|||
open Jest
|
||||
open Expect
|
||||
// open Jest
|
||||
// open Expect
|
||||
|
||||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module Expression = Reducer_Expression
|
||||
module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
|
||||
module Macro = Reducer_Expression_Macro
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module T = Reducer_Expression_T
|
||||
// module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
// module Expression = Reducer_Expression
|
||||
// module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
// module InternalExpressionValue = ReducerInterface.InternalExpressionValue
|
||||
// module Macro = Reducer_Expression_Macro
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module T = Reducer_Expression_T
|
||||
|
||||
let testMacro_ = (
|
||||
tester,
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedCode: string,
|
||||
) => {
|
||||
let bindings = Bindings.fromArray(bindArray)
|
||||
tester(expr->T.toString, () => {
|
||||
let result = switch expr->Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||
bindings,
|
||||
ProjectAccessorsT.identityAccessors,
|
||||
Expression.reduceExpressionInProject,
|
||||
) {
|
||||
| v => Ok(v)
|
||||
| exception Reducer_ErrorValue.ErrorException(e) => Error(e)
|
||||
}
|
||||
// let testMacro_ = (
|
||||
// tester,
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedCode: string,
|
||||
// ) => {
|
||||
// let bindings = Reducer_Bindings.fromArray(bindArray)
|
||||
// tester(expr->T.toString, () => {
|
||||
// let result = switch expr->Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||
// bindings,
|
||||
// ProjectAccessorsT.identityAccessors,
|
||||
// Expression.reduceExpressionInProject,
|
||||
// ) {
|
||||
// | v => Ok(v)
|
||||
// | exception Reducer_ErrorValue.ErrorException(e) => Error(e)
|
||||
// }
|
||||
|
||||
result->ExpressionWithContext.toStringResult->expect->toEqual(expectedCode)
|
||||
})
|
||||
}
|
||||
// result->ExpressionWithContext.toStringResult->expect->toEqual(expectedCode)
|
||||
// })
|
||||
// }
|
||||
|
||||
let testMacroEval_ = (
|
||||
tester,
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedValue: string,
|
||||
) => {
|
||||
let bindings = Bindings.fromArray(bindArray)
|
||||
tester(expr->T.toString, () =>
|
||||
expr
|
||||
->Macro.doMacroCall(
|
||||
bindings,
|
||||
ProjectAccessorsT.identityAccessors,
|
||||
Expression.reduceExpressionInProject,
|
||||
)
|
||||
->Ok
|
||||
->InternalExpressionValue.toStringResult
|
||||
->expect
|
||||
->toEqual(expectedValue)
|
||||
)
|
||||
}
|
||||
// let testMacroEval_ = (
|
||||
// tester,
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedValue: string,
|
||||
// ) => {
|
||||
// let bindings = Reducer_Bindings.fromArray(bindArray)
|
||||
// tester(expr->T.toString, () =>
|
||||
// expr
|
||||
// ->Macro.doMacroCall(
|
||||
// bindings,
|
||||
// ProjectAccessorsT.identityAccessors,
|
||||
// Expression.reduceExpressionInProject,
|
||||
// )
|
||||
// ->Ok
|
||||
// ->InternalExpressionValue.toStringResult
|
||||
// ->expect
|
||||
// ->toEqual(expectedValue)
|
||||
// )
|
||||
// }
|
||||
|
||||
let testMacro = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedExpr: string,
|
||||
) => testMacro_(test, bindArray, expr, expectedExpr)
|
||||
let testMacroEval = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedValue: string,
|
||||
) => testMacroEval_(test, bindArray, expr, expectedValue)
|
||||
// let testMacro = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedExpr: string,
|
||||
// ) => testMacro_(test, bindArray, expr, expectedExpr)
|
||||
// let testMacroEval = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedValue: string,
|
||||
// ) => testMacroEval_(test, bindArray, expr, expectedValue)
|
||||
|
||||
module MySkip = {
|
||||
let testMacro = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedExpr: string,
|
||||
) => testMacro_(Skip.test, bindArray, expr, expectedExpr)
|
||||
let testMacroEval = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedValue: string,
|
||||
) => testMacroEval_(Skip.test, bindArray, expr, expectedValue)
|
||||
}
|
||||
// module MySkip = {
|
||||
// let testMacro = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedExpr: string,
|
||||
// ) => testMacro_(Skip.test, bindArray, expr, expectedExpr)
|
||||
// let testMacroEval = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedValue: string,
|
||||
// ) => testMacroEval_(Skip.test, bindArray, expr, expectedValue)
|
||||
// }
|
||||
|
||||
module MyOnly = {
|
||||
let testMacro = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedExpr: string,
|
||||
) => testMacro_(Only.test, bindArray, expr, expectedExpr)
|
||||
let testMacroEval = (
|
||||
bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
expr: T.expression,
|
||||
expectedValue: string,
|
||||
) => testMacroEval_(Only.test, bindArray, expr, expectedValue)
|
||||
}
|
||||
// module MyOnly = {
|
||||
// let testMacro = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedExpr: string,
|
||||
// ) => testMacro_(Only.test, bindArray, expr, expectedExpr)
|
||||
// let testMacroEval = (
|
||||
// bindArray: array<(string, InternalExpressionValue.t)>,
|
||||
// expr: T.expression,
|
||||
// expectedValue: string,
|
||||
// ) => testMacroEval_(Only.test, bindArray, expr, expectedValue)
|
||||
// }
|
||||
|
|
|
@ -1,52 +1,52 @@
|
|||
module Expression = Reducer_Expression
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Bindings = Reducer_Bindings
|
||||
module T = Reducer_Type_T
|
||||
module TypeCompile = Reducer_Type_Compile
|
||||
// module Expression = Reducer_Expression
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module Bindings = Reducer_Bindings
|
||||
// module T = Reducer_Type_T
|
||||
// module TypeCompile = Reducer_Type_Compile
|
||||
|
||||
open Jest
|
||||
open Expect
|
||||
// open Jest
|
||||
// open Expect
|
||||
|
||||
let myIevEval = (aTypeSourceCode: string) =>
|
||||
TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
|
||||
let myIevEvalToString = (aTypeSourceCode: string) =>
|
||||
myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
|
||||
// let myIevEval = (aTypeSourceCode: string) =>
|
||||
// TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
|
||||
// let myIevEvalToString = (aTypeSourceCode: string) =>
|
||||
// myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
|
||||
|
||||
let myIevExpectEqual = (aTypeSourceCode, answer) =>
|
||||
expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
// let myIevExpectEqual = (aTypeSourceCode, answer) =>
|
||||
// expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
|
||||
let myIevTest = (test, aTypeSourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
|
||||
// let myIevTest = (test, aTypeSourceCode, answer) =>
|
||||
// test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
|
||||
|
||||
let myTypeEval = (aTypeSourceCode: string) =>
|
||||
TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
|
||||
let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
|
||||
// let myTypeEval = (aTypeSourceCode: string) =>
|
||||
// TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpressionInProject)
|
||||
// let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
|
||||
|
||||
let myTypeExpectEqual = (aTypeSourceCode, answer) =>
|
||||
expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
// let myTypeExpectEqual = (aTypeSourceCode, answer) =>
|
||||
// expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
|
||||
let myTypeTest = (test, aTypeSourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
|
||||
// let myTypeTest = (test, aTypeSourceCode, answer) =>
|
||||
// test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
|
||||
|
||||
// | ItTypeIdentifier(string)
|
||||
myTypeTest(test, "number", "number")
|
||||
myTypeTest(test, "(number)", "number")
|
||||
// | ItModifiedType({modifiedType: iType})
|
||||
myIevTest(test, "number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
|
||||
myTypeTest(test, "number<-min(0)", "number<-min(0)")
|
||||
// | ItTypeOr({typeOr: array<iType>})
|
||||
myTypeTest(test, "number | string", "(number | string)")
|
||||
// | ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
myTypeTest(test, "number => number => number", "(number => number => number)")
|
||||
// | ItTypeArray({element: iType})
|
||||
myIevTest(test, "[number]", "Ok({element: #number,typeTag: 'typeArray'})")
|
||||
myTypeTest(test, "[number]", "[number]")
|
||||
// | ItTypeTuple({elements: array<iType>})
|
||||
myTypeTest(test, "[number, string]", "[number, string]")
|
||||
// | ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
myIevTest(
|
||||
test,
|
||||
"{age: number, name: string}",
|
||||
"Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
|
||||
)
|
||||
myTypeTest(test, "{age: number, name: string}", "{age: number, name: string}")
|
||||
// // | ItTypeIdentifier(string)
|
||||
// myTypeTest(test, "number", "number")
|
||||
// myTypeTest(test, "(number)", "number")
|
||||
// // | ItModifiedType({modifiedType: iType})
|
||||
// myIevTest(test, "number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
|
||||
// myTypeTest(test, "number<-min(0)", "number<-min(0)")
|
||||
// // | ItTypeOr({typeOr: array<iType>})
|
||||
// myTypeTest(test, "number | string", "(number | string)")
|
||||
// // | ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
// myTypeTest(test, "number => number => number", "(number => number => number)")
|
||||
// // | ItTypeArray({element: iType})
|
||||
// myIevTest(test, "[number]", "Ok({element: #number,typeTag: 'typeArray'})")
|
||||
// myTypeTest(test, "[number]", "[number]")
|
||||
// // | ItTypeTuple({elements: array<iType>})
|
||||
// myTypeTest(test, "[number, string]", "[number, string]")
|
||||
// // | ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
// myIevTest(
|
||||
// test,
|
||||
// "{age: number, name: string}",
|
||||
// "Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
|
||||
// )
|
||||
// myTypeTest(test, "{age: number, name: string}", "{age: number, name: string}")
|
||||
|
|
|
@ -1,42 +1,42 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module Expression = Reducer_Expression
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module T = Reducer_Type_T
|
||||
module TypeChecker = Reducer_Type_TypeChecker
|
||||
// module Bindings = Reducer_Bindings
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module Expression = Reducer_Expression
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module T = Reducer_Type_T
|
||||
// module TypeChecker = Reducer_Type_TypeChecker
|
||||
|
||||
open Jest
|
||||
open Expect
|
||||
// open Jest
|
||||
// open Expect
|
||||
|
||||
let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
|
||||
'v,
|
||||
ErrorValue.t,
|
||||
> => {
|
||||
let reducerFn = Expression.reduceExpressionInProject
|
||||
let rResult =
|
||||
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||
)
|
||||
rResult->Belt.Result.flatMap(result =>
|
||||
switch result {
|
||||
| IEvArray(args) => TypeChecker.checkArguments(aTypeSourceCode, args, reducerFn)
|
||||
| _ => Js.Exn.raiseError("Arguments has to be an array")
|
||||
}
|
||||
)
|
||||
}
|
||||
// let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
|
||||
// 'v,
|
||||
// ErrorValue.t,
|
||||
// > => {
|
||||
// let reducerFn = Expression.reduceExpressionInProject
|
||||
// let rResult =
|
||||
// Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||
// reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||
// )
|
||||
// rResult->Belt.Result.flatMap(result =>
|
||||
// switch result {
|
||||
// | IEvArray(args) => TypeChecker.checkArguments(aTypeSourceCode, args, reducerFn)
|
||||
// | _ => Js.Exn.raiseError("Arguments has to be an array")
|
||||
// }
|
||||
// )
|
||||
// }
|
||||
|
||||
let myCheckArguments = (aTypeSourceCode: string, sourceCode: string): string =>
|
||||
switch checkArgumentsSourceCode(aTypeSourceCode, sourceCode) {
|
||||
| Ok(_) => "Ok"
|
||||
| Error(error) => ErrorValue.errorToString(error)
|
||||
}
|
||||
// let myCheckArguments = (aTypeSourceCode: string, sourceCode: string): string =>
|
||||
// switch checkArgumentsSourceCode(aTypeSourceCode, sourceCode) {
|
||||
// | Ok(_) => "Ok"
|
||||
// | Error(error) => ErrorValue.errorToString(error)
|
||||
// }
|
||||
|
||||
let myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
|
||||
expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
|
||||
// let myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
|
||||
// expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
|
||||
|
||||
let myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
|
||||
// let myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
|
||||
// test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
|
||||
|
||||
myCheckArgumentsTest(test, "number=>number=>number", "[1,2]", "Ok")
|
||||
// myCheckArgumentsTest(test, "number=>number=>number", "[1,2]", "Ok")
|
||||
|
|
|
@ -1,73 +1,73 @@
|
|||
module Expression = Reducer_Expression
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Bindings = Reducer_Bindings
|
||||
module T = Reducer_Type_T
|
||||
module TypeChecker = Reducer_Type_TypeChecker
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module Expression = Reducer_Expression
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module Bindings = Reducer_Bindings
|
||||
// module T = Reducer_Type_T
|
||||
// module TypeChecker = Reducer_Type_TypeChecker
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
|
||||
open Jest
|
||||
open Expect
|
||||
// open Jest
|
||||
// open Expect
|
||||
|
||||
// In development, you are expected to use TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn).
|
||||
// isTypeOfSourceCode is written to use strings instead of expression values.
|
||||
// // In development, you are expected to use TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn).
|
||||
// // isTypeOfSourceCode is written to use strings instead of expression values.
|
||||
|
||||
let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
|
||||
'v,
|
||||
ErrorValue.t,
|
||||
> => {
|
||||
let reducerFn = Expression.reduceExpressionInProject
|
||||
let rResult =
|
||||
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||
)
|
||||
rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
|
||||
}
|
||||
// let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
|
||||
// 'v,
|
||||
// ErrorValue.t,
|
||||
// > => {
|
||||
// let reducerFn = Expression.reduceExpressionInProject
|
||||
// let rResult =
|
||||
// Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
|
||||
// reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
|
||||
// )
|
||||
// rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))
|
||||
// }
|
||||
|
||||
let myTypeCheck = (aTypeSourceCode: string, sourceCode: string): string =>
|
||||
switch isTypeOfSourceCode(aTypeSourceCode, sourceCode) {
|
||||
| Ok(_) => "Ok"
|
||||
| Error(error) => ErrorValue.errorToString(error)
|
||||
}
|
||||
// let myTypeCheck = (aTypeSourceCode: string, sourceCode: string): string =>
|
||||
// switch isTypeOfSourceCode(aTypeSourceCode, sourceCode) {
|
||||
// | Ok(_) => "Ok"
|
||||
// | Error(error) => ErrorValue.errorToString(error)
|
||||
// }
|
||||
|
||||
let myTypeCheckExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
|
||||
expect(myTypeCheck(aTypeSourceCode, sourceCode))->toEqual(answer)
|
||||
// let myTypeCheckExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
|
||||
// expect(myTypeCheck(aTypeSourceCode, sourceCode))->toEqual(answer)
|
||||
|
||||
let myTypeCheckTest = (test, aTypeSourceCode, sourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myTypeCheckExpectEqual(aTypeSourceCode, sourceCode, answer))
|
||||
// let myTypeCheckTest = (test, aTypeSourceCode, sourceCode, answer) =>
|
||||
// test(aTypeSourceCode, () => myTypeCheckExpectEqual(aTypeSourceCode, sourceCode, answer))
|
||||
|
||||
myTypeCheckTest(test, "number", "1", "Ok")
|
||||
myTypeCheckTest(test, "number", "'2'", "Expected type: number but got: '2'")
|
||||
myTypeCheckTest(test, "string", "3", "Expected type: string but got: 3")
|
||||
myTypeCheckTest(test, "string", "'a'", "Ok")
|
||||
myTypeCheckTest(test, "[number]", "[1,2,3]", "Ok")
|
||||
myTypeCheckTest(test, "[number]", "['a','a','a']", "Expected type: number but got: 'a'")
|
||||
myTypeCheckTest(test, "[number]", "[1,'a',3]", "Expected type: number but got: 'a'")
|
||||
myTypeCheckTest(test, "[number, string]", "[1,'a']", "Ok")
|
||||
myTypeCheckTest(test, "[number, string]", "[1, 2]", "Expected type: string but got: 2")
|
||||
myTypeCheckTest(
|
||||
test,
|
||||
"[number, string, string]",
|
||||
"[1,'a']",
|
||||
"Expected type: [number, string, string] but got: [1,'a']",
|
||||
)
|
||||
myTypeCheckTest(
|
||||
test,
|
||||
"[number, string]",
|
||||
"[1,'a', 3]",
|
||||
"Expected type: [number, string] but got: [1,'a',3]",
|
||||
)
|
||||
myTypeCheckTest(test, "{age: number, name: string}", "{age: 1, name: 'a'}", "Ok")
|
||||
myTypeCheckTest(
|
||||
test,
|
||||
"{age: number, name: string}",
|
||||
"{age: 1, name: 'a', job: 'IT'}",
|
||||
"Expected type: {age: number, name: string} but got: {age: 1,job: 'IT',name: 'a'}",
|
||||
)
|
||||
myTypeCheckTest(test, "number | string", "1", "Ok")
|
||||
myTypeCheckTest(test, "date | string", "1", "Expected type: (date | string) but got: 1")
|
||||
myTypeCheckTest(test, "number<-min(10)", "10", "Ok")
|
||||
myTypeCheckTest(test, "number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")
|
||||
myTypeCheckTest(test, "any", "0", "Ok")
|
||||
myTypeCheckTest(test, "any", "'a'", "Ok")
|
||||
// myTypeCheckTest(test, "number", "1", "Ok")
|
||||
// myTypeCheckTest(test, "number", "'2'", "Expected type: number but got: '2'")
|
||||
// myTypeCheckTest(test, "string", "3", "Expected type: string but got: 3")
|
||||
// myTypeCheckTest(test, "string", "'a'", "Ok")
|
||||
// myTypeCheckTest(test, "[number]", "[1,2,3]", "Ok")
|
||||
// myTypeCheckTest(test, "[number]", "['a','a','a']", "Expected type: number but got: 'a'")
|
||||
// myTypeCheckTest(test, "[number]", "[1,'a',3]", "Expected type: number but got: 'a'")
|
||||
// myTypeCheckTest(test, "[number, string]", "[1,'a']", "Ok")
|
||||
// myTypeCheckTest(test, "[number, string]", "[1, 2]", "Expected type: string but got: 2")
|
||||
// myTypeCheckTest(
|
||||
// test,
|
||||
// "[number, string, string]",
|
||||
// "[1,'a']",
|
||||
// "Expected type: [number, string, string] but got: [1,'a']",
|
||||
// )
|
||||
// myTypeCheckTest(
|
||||
// test,
|
||||
// "[number, string]",
|
||||
// "[1,'a', 3]",
|
||||
// "Expected type: [number, string] but got: [1,'a',3]",
|
||||
// )
|
||||
// myTypeCheckTest(test, "{age: number, name: string}", "{age: 1, name: 'a'}", "Ok")
|
||||
// myTypeCheckTest(
|
||||
// test,
|
||||
// "{age: number, name: string}",
|
||||
// "{age: 1, name: 'a', job: 'IT'}",
|
||||
// "Expected type: {age: number, name: string} but got: {age: 1,job: 'IT',name: 'a'}",
|
||||
// )
|
||||
// myTypeCheckTest(test, "number | string", "1", "Ok")
|
||||
// myTypeCheckTest(test, "date | string", "1", "Expected type: (date | string) but got: 1")
|
||||
// myTypeCheckTest(test, "number<-min(10)", "10", "Ok")
|
||||
// myTypeCheckTest(test, "number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")
|
||||
// myTypeCheckTest(test, "any", "0", "Ok")
|
||||
// myTypeCheckTest(test, "any", "'a'", "Ok")
|
||||
|
|
|
@ -1,127 +1,126 @@
|
|||
open Jest
|
||||
open Expect
|
||||
// open Jest
|
||||
// open Expect
|
||||
|
||||
module DispatchT = Reducer_Dispatch_T
|
||||
module Expression = Reducer_Expression
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module TypeChecker = Reducer_Type_TypeChecker
|
||||
module TypeCompile = Reducer_Type_Compile
|
||||
// module DispatchT = Reducer_Dispatch_T
|
||||
// module Expression = Reducer_Expression
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module TypeChecker = Reducer_Type_TypeChecker
|
||||
// module TypeCompile = Reducer_Type_Compile
|
||||
|
||||
open ReducerInterface_InternalExpressionValue
|
||||
// open ReducerInterface_InternalExpressionValue
|
||||
|
||||
type errorValue = Reducer_ErrorValue.errorValue
|
||||
// type errorValue = Reducer_ErrorValue.errorValue
|
||||
|
||||
// Let's build a function to replace switch statements
|
||||
// In dispatchChainPiece, we execute an return the result of execution if there is a type match.
|
||||
// Otherwise we return None so that the call chain can continue.
|
||||
// So we want to build a function like
|
||||
// dispatchChainPiece = (call: functionCall, accessors): option<result<internalExpressionValue, errorValue>>
|
||||
// Use accessors.environment to get the environment finally.
|
||||
// // Let's build a function to replace switch statements
|
||||
// // In dispatchChainPiece, we execute an return the result of execution if there is a type match.
|
||||
// // Otherwise we return None so that the call chain can continue.
|
||||
// // So we want to build a function like
|
||||
// // dispatchChainPiece = (call: functionCall, accessors): option<result<internalExpressionValue, errorValue>>
|
||||
// // Use accessors.environment to get the environment finally.
|
||||
|
||||
// Now lets make the dispatchChainPiece itself.
|
||||
// Note that I am not passing the reducer to the dispatchChainPiece as an argument because it is in the context anyway.
|
||||
// Keep in mind that reducerFn is necessary for map/reduce so dispatchChainPiece should have a reducerFn in context.
|
||||
// // Now lets make the dispatchChainPiece itself.
|
||||
// // Note that I am not passing the reducer to the dispatchChainPiece as an argument because it is in the context anyway.
|
||||
// // Keep in mind that reducerFn is necessary for map/reduce so dispatchChainPiece should have a reducerFn in context.
|
||||
|
||||
let makeMyDispatchChainPiece = (reducer: ProjectReducerFnT.t): DispatchT.dispatchChainPiece => {
|
||||
// Let's have a pure implementations
|
||||
module Implementation = {
|
||||
let stringConcat = (a: string, b: string): string => Js.String2.concat(a, b)
|
||||
let arrayConcat = (
|
||||
a: Js.Array2.t<internalExpressionValue>,
|
||||
b: Js.Array2.t<internalExpressionValue>,
|
||||
): Js.Array2.t<internalExpressionValue> => Js.Array2.concat(a, b)
|
||||
let plot = _r => "yey, plotted"
|
||||
}
|
||||
// let makeMyDispatchChainPiece = (reducer: Reducer_T.reducerFn): DispatchT.dispatchChainPiece => {
|
||||
// // Let's have a pure implementations
|
||||
// module Implementation = {
|
||||
// let stringConcat = (a: string, b: string): string => Js.String2.concat(a, b)
|
||||
// let arrayConcat = (
|
||||
// a: Js.Array2.t<internalExpressionValue>,
|
||||
// b: Js.Array2.t<internalExpressionValue>,
|
||||
// ): Js.Array2.t<internalExpressionValue> => Js.Array2.concat(a, b)
|
||||
// let plot = _r => "yey, plotted"
|
||||
// }
|
||||
|
||||
let extractStringString = args =>
|
||||
switch args {
|
||||
| [IEvString(a), IEvString(b)] => (a, b)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("extractStringString developer error"))
|
||||
}
|
||||
// let extractStringString = args =>
|
||||
// switch args {
|
||||
// | [IEvString(a), IEvString(b)] => (a, b)
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("extractStringString developer error"))
|
||||
// }
|
||||
|
||||
let extractArrayArray = args =>
|
||||
switch args {
|
||||
| [IEvArray(a), IEvArray(b)] => (a, b)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("extractArrayArray developer error"))
|
||||
}
|
||||
// let extractArrayArray = args =>
|
||||
// switch args {
|
||||
// | [IEvArray(a), IEvArray(b)] => (a, b)
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("extractArrayArray developer error"))
|
||||
// }
|
||||
|
||||
// Let's bridge the pure implementation to expression values
|
||||
module Bridge = {
|
||||
let stringConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
let (a, b) = extractStringString(args)
|
||||
Implementation.stringConcat(a, b)->IEvString->Ok
|
||||
}
|
||||
let arrayConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
let (a, b) = extractArrayArray(args)
|
||||
Implementation.arrayConcat(a, b)->IEvArray->Ok
|
||||
}
|
||||
let plot: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
switch args {
|
||||
// Just assume that we are doing the business of extracting and converting the deep record
|
||||
| [IEvRecord(_)] => Implementation.plot({"title": "This is a plot"})->IEvString->Ok
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("plot developer error"))
|
||||
}
|
||||
}
|
||||
}
|
||||
// // Let's bridge the pure implementation to expression values
|
||||
// module Bridge = {
|
||||
// let stringConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
// let (a, b) = extractStringString(args)
|
||||
// Implementation.stringConcat(a, b)->IEvString->Ok
|
||||
// }
|
||||
// let arrayConcat: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
// let (a, b) = extractArrayArray(args)
|
||||
// Implementation.arrayConcat(a, b)->IEvArray->Ok
|
||||
// }
|
||||
// let plot: DispatchT.genericIEvFunction = (args, _accessors: ProjectAccessorsT.t) => {
|
||||
// switch args {
|
||||
// // Just assume that we are doing the business of extracting and converting the deep record
|
||||
// | [IEvRecord(_)] => Implementation.plot({"title": "This is a plot"})->IEvString->Ok
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("plot developer error"))
|
||||
// }
|
||||
// }
|
||||
// }
|
||||
|
||||
// concat functions are to illustrate polymoprhism. And the plot function is to illustrate complex types
|
||||
let jumpTable = [
|
||||
(
|
||||
"concat",
|
||||
TypeCompile.fromTypeExpressionExn("string=>string=>string", reducer),
|
||||
Bridge.stringConcat,
|
||||
),
|
||||
(
|
||||
"concat",
|
||||
TypeCompile.fromTypeExpressionExn("[any]=>[any]=>[any]", reducer),
|
||||
Bridge.arrayConcat,
|
||||
),
|
||||
(
|
||||
"plot",
|
||||
TypeCompile.fromTypeExpressionExn(
|
||||
// Nested complex types are available
|
||||
// records {property: type}
|
||||
// arrays [type]
|
||||
// tuples [type, type]
|
||||
// <- type contracts are available naturally and they become part of dispatching
|
||||
// Here we are not enumerating the possibilities because type checking has a dedicated test
|
||||
"{title: string, line: {width: number, color: string}}=>string",
|
||||
reducer,
|
||||
),
|
||||
Bridge.plot,
|
||||
),
|
||||
]
|
||||
// // concat functions are to illustrate polymoprhism. And the plot function is to illustrate complex types
|
||||
// let jumpTable = [
|
||||
// (
|
||||
// "concat",
|
||||
// TypeCompile.fromTypeExpressionExn("string=>string=>string", reducer),
|
||||
// Bridge.stringConcat,
|
||||
// ),
|
||||
// (
|
||||
// "concat",
|
||||
// TypeCompile.fromTypeExpressionExn("[any]=>[any]=>[any]", reducer),
|
||||
// Bridge.arrayConcat,
|
||||
// ),
|
||||
// (
|
||||
// "plot",
|
||||
// TypeCompile.fromTypeExpressionExn(
|
||||
// // Nested complex types are available
|
||||
// // records {property: type}
|
||||
// // arrays [type]
|
||||
// // tuples [type, type]
|
||||
// // <- type contracts are available naturally and they become part of dispatching
|
||||
// // Here we are not enumerating the possibilities because type checking has a dedicated test
|
||||
// "{title: string, line: {width: number, color: string}}=>string",
|
||||
// reducer,
|
||||
// ),
|
||||
// Bridge.plot,
|
||||
// ),
|
||||
// ]
|
||||
|
||||
//Here we are creating a dispatchChainPiece function that will do the actual dispatch from the jumpTable
|
||||
Reducer_Dispatch_ChainPiece.makeFromTypes(jumpTable)
|
||||
}
|
||||
// //Here we are creating a dispatchChainPiece function that will do the actual dispatch from the jumpTable
|
||||
// Reducer_Dispatch_ChainPiece.makeFromTypes(jumpTable)
|
||||
// }
|
||||
|
||||
// And finally, let's write a library dispatch for our external library
|
||||
// Exactly the same as the one used in real life
|
||||
let _dispatch = (
|
||||
call: functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
chain,
|
||||
): result<internalExpressionValue, 'e> => {
|
||||
let dispatchChainPiece = makeMyDispatchChainPiece(reducer)
|
||||
dispatchChainPiece(call, accessors)->E.O2.defaultFn(() => chain(call, accessors, reducer))
|
||||
}
|
||||
// // And finally, let's write a library dispatch for our external library
|
||||
// // Exactly the same as the one used in real life
|
||||
// let _dispatch = (
|
||||
// call: functionCall,
|
||||
// accessors: ProjectAccessorsT.t,
|
||||
// reducer: Reducer_T.reducerFn,
|
||||
// chain,
|
||||
// ): result<internalExpressionValue, 'e> => {
|
||||
// let dispatchChainPiece = makeMyDispatchChainPiece(reducer)
|
||||
// dispatchChainPiece(call, accessors)->E.O2.defaultFn(() => chain(call, accessors, reducer))
|
||||
// }
|
||||
|
||||
// What is important about this implementation?
|
||||
// A) Exactly the same function jump table can be used to create type guarded lambda functions
|
||||
// Guarded lambda functions will be the basis of the next version of Squiggle
|
||||
// B) Complicated recursive record types are not a problem.
|
||||
// // What is important about this implementation?
|
||||
// // A) Exactly the same function jump table can be used to create type guarded lambda functions
|
||||
// // Guarded lambda functions will be the basis of the next version of Squiggle
|
||||
// // B) Complicated recursive record types are not a problem.
|
||||
|
||||
describe("Type Dispatch", () => {
|
||||
let reducerFn = Expression.reduceExpressionInProject
|
||||
let dispatchChainPiece = makeMyDispatchChainPiece(reducerFn)
|
||||
test("stringConcat", () => {
|
||||
let call: functionCall = ("concat", [IEvString("hello"), IEvString("world")])
|
||||
// describe("Type Dispatch", () => {
|
||||
// let reducerFn = Expression.reduceExpressionInProject
|
||||
// let dispatchChainPiece = makeMyDispatchChainPiece(reducerFn)
|
||||
// test("stringConcat", () => {
|
||||
// let call: functionCall = ("concat", [IEvString("hello"), IEvString("world")])
|
||||
|
||||
let result = dispatchChainPiece(call, ProjectAccessorsT.identityAccessors)
|
||||
expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
|
||||
})
|
||||
})
|
||||
// let result = dispatchChainPiece(call, ProjectAccessorsT.identityAccessors)
|
||||
// expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
|
||||
// })
|
||||
// })
|
||||
|
|
|
@ -1,121 +1,121 @@
|
|||
@@warning("-44")
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Project = ForTS_ReducerProject
|
||||
module Bindings = Reducer_Bindings
|
||||
// @@warning("-44")
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module Project = ForTS_ReducerProject
|
||||
// module Bindings = Reducer_Bindings
|
||||
|
||||
open Jest
|
||||
open Expect
|
||||
open Expect.Operators
|
||||
// open Jest
|
||||
// open Expect
|
||||
// open Expect.Operators
|
||||
|
||||
describe("Parse includes", () => {
|
||||
let project = Project.createProject()
|
||||
Project.setSource(
|
||||
project,
|
||||
"main",
|
||||
`
|
||||
#include 'common'
|
||||
x=1`,
|
||||
)
|
||||
Project.parseIncludes(project, "main")
|
||||
test("dependencies", () => {
|
||||
expect(Project.getDependencies(project, "main")) == ["common"]
|
||||
})
|
||||
test("dependents", () => {
|
||||
expect(Project.getDependents(project, "main")) == []
|
||||
})
|
||||
test("getIncludes", () => {
|
||||
let mainIncludes = Project.getIncludes(project, "main")
|
||||
switch mainIncludes {
|
||||
| Ok(includes) => expect(includes) == ["common"]
|
||||
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
}
|
||||
})
|
||||
let internalProject = project->Project.T.Private.castToInternalProject
|
||||
test("past chain", () => {
|
||||
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
|
||||
})
|
||||
test("import as variables", () => {
|
||||
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == []
|
||||
})
|
||||
})
|
||||
// describe("Parse includes", () => {
|
||||
// let project = Project.createProject()
|
||||
// Project.setSource(
|
||||
// project,
|
||||
// "main",
|
||||
// `
|
||||
// #include 'common'
|
||||
// x=1`,
|
||||
// )
|
||||
// Project.parseIncludes(project, "main")
|
||||
// test("dependencies", () => {
|
||||
// expect(Project.getDependencies(project, "main")) == ["common"]
|
||||
// })
|
||||
// test("dependents", () => {
|
||||
// expect(Project.getDependents(project, "main")) == []
|
||||
// })
|
||||
// test("getIncludes", () => {
|
||||
// let mainIncludes = Project.getIncludes(project, "main")
|
||||
// switch mainIncludes {
|
||||
// | Ok(includes) => expect(includes) == ["common"]
|
||||
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
// }
|
||||
// })
|
||||
// let internalProject = project->Project.T.Private.castToInternalProject
|
||||
// test("past chain", () => {
|
||||
// expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
|
||||
// })
|
||||
// test("import as variables", () => {
|
||||
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == []
|
||||
// })
|
||||
// })
|
||||
|
||||
describe("Parse includes", () => {
|
||||
let project = Project.createProject()
|
||||
Project.setSource(
|
||||
project,
|
||||
"main",
|
||||
`
|
||||
#include 'common'
|
||||
#include 'myModule' as myVariable
|
||||
x=1`,
|
||||
)
|
||||
Project.parseIncludes(project, "main")
|
||||
// describe("Parse includes", () => {
|
||||
// let project = Project.createProject()
|
||||
// Project.setSource(
|
||||
// project,
|
||||
// "main",
|
||||
// `
|
||||
// #include 'common'
|
||||
// #include 'myModule' as myVariable
|
||||
// x=1`,
|
||||
// )
|
||||
// Project.parseIncludes(project, "main")
|
||||
|
||||
test("dependencies", () => {
|
||||
expect(Project.getDependencies(project, "main")) == ["common", "myModule"]
|
||||
})
|
||||
// test("dependencies", () => {
|
||||
// expect(Project.getDependencies(project, "main")) == ["common", "myModule"]
|
||||
// })
|
||||
|
||||
test("dependents", () => {
|
||||
expect(Project.getDependents(project, "main")) == []
|
||||
})
|
||||
// test("dependents", () => {
|
||||
// expect(Project.getDependents(project, "main")) == []
|
||||
// })
|
||||
|
||||
test("getIncludes", () => {
|
||||
let mainIncludes = Project.getIncludes(project, "main")
|
||||
switch mainIncludes {
|
||||
| Ok(includes) => expect(includes) == ["common", "myModule"]
|
||||
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
}
|
||||
})
|
||||
// test("getIncludes", () => {
|
||||
// let mainIncludes = Project.getIncludes(project, "main")
|
||||
// switch mainIncludes {
|
||||
// | Ok(includes) => expect(includes) == ["common", "myModule"]
|
||||
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
// }
|
||||
// })
|
||||
|
||||
let internalProject = project->Project.T.Private.castToInternalProject
|
||||
// let internalProject = project->Project.T.Private.castToInternalProject
|
||||
|
||||
test("direct past chain", () => {
|
||||
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
|
||||
})
|
||||
// test("direct past chain", () => {
|
||||
// expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
|
||||
// })
|
||||
|
||||
test("direct includes", () => {
|
||||
expect(Project.Private.getDirectIncludes(internalProject, "main")) == ["common"]
|
||||
})
|
||||
// test("direct includes", () => {
|
||||
// expect(Project.Private.getDirectIncludes(internalProject, "main")) == ["common"]
|
||||
// })
|
||||
|
||||
test("include as variables", () => {
|
||||
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
|
||||
("myVariable", "myModule"),
|
||||
]
|
||||
})
|
||||
})
|
||||
// test("include as variables", () => {
|
||||
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
|
||||
// ("myVariable", "myModule"),
|
||||
// ]
|
||||
// })
|
||||
// })
|
||||
|
||||
describe("Parse multiple direct includes", () => {
|
||||
let project = Project.createProject()
|
||||
Project.setSource(
|
||||
project,
|
||||
"main",
|
||||
`
|
||||
#include 'common'
|
||||
#include 'common2'
|
||||
#include 'myModule' as myVariable
|
||||
x=1`,
|
||||
)
|
||||
Project.parseIncludes(project, "main")
|
||||
test("dependencies", () => {
|
||||
expect(Project.getDependencies(project, "main")) == ["common", "common2", "myModule"]
|
||||
})
|
||||
test("dependents", () => {
|
||||
expect(Project.getDependents(project, "main")) == []
|
||||
})
|
||||
test("getIncludes", () => {
|
||||
let mainIncludes = Project.getIncludes(project, "main")
|
||||
switch mainIncludes {
|
||||
| Ok(includes) => expect(includes) == ["common", "common2", "myModule"]
|
||||
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
}
|
||||
})
|
||||
let internalProject = project->Project.T.Private.castToInternalProject
|
||||
test("direct past chain", () => {
|
||||
expect(Project.getPastChain(project, "main")) == ["common", "common2"]
|
||||
})
|
||||
test("include as variables", () => {
|
||||
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
|
||||
("myVariable", "myModule"),
|
||||
]
|
||||
})
|
||||
})
|
||||
// describe("Parse multiple direct includes", () => {
|
||||
// let project = Project.createProject()
|
||||
// Project.setSource(
|
||||
// project,
|
||||
// "main",
|
||||
// `
|
||||
// #include 'common'
|
||||
// #include 'common2'
|
||||
// #include 'myModule' as myVariable
|
||||
// x=1`,
|
||||
// )
|
||||
// Project.parseIncludes(project, "main")
|
||||
// test("dependencies", () => {
|
||||
// expect(Project.getDependencies(project, "main")) == ["common", "common2", "myModule"]
|
||||
// })
|
||||
// test("dependents", () => {
|
||||
// expect(Project.getDependents(project, "main")) == []
|
||||
// })
|
||||
// test("getIncludes", () => {
|
||||
// let mainIncludes = Project.getIncludes(project, "main")
|
||||
// switch mainIncludes {
|
||||
// | Ok(includes) => expect(includes) == ["common", "common2", "myModule"]
|
||||
// | Error(error) => fail(error->Reducer_ErrorValue.errorToString)
|
||||
// }
|
||||
// })
|
||||
// let internalProject = project->Project.T.Private.castToInternalProject
|
||||
// test("direct past chain", () => {
|
||||
// expect(Project.getPastChain(project, "main")) == ["common", "common2"]
|
||||
// })
|
||||
// test("include as variables", () => {
|
||||
// expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
|
||||
// ("myVariable", "myModule"),
|
||||
// ]
|
||||
// })
|
||||
// })
|
||||
|
|
|
@ -23,10 +23,9 @@ let runFetchFlatBindings = (project, sourceId) => {
|
|||
|
||||
test("setting continuation", () => {
|
||||
let project = Project.createProject()
|
||||
let privateProject = project->Project.T.Private.castToInternalProject
|
||||
let sampleBindings = Bindings.emptyBindings->Bindings.set("test", IEvVoid)
|
||||
Project.Private.setContinuation(privateProject, "main", sampleBindings)
|
||||
let answer = Project.Private.getContinuation(privateProject, "main")
|
||||
let sampleBindings = Bindings.makeEmptyBindings()->Bindings.set("test", IEvVoid)
|
||||
ReducerProject.setContinuation(project, "main", sampleBindings)
|
||||
let answer = ReducerProject.getContinuation(project, "main")
|
||||
expect(answer)->toBe(sampleBindings)
|
||||
})
|
||||
|
||||
|
@ -59,7 +58,6 @@ describe("project1", () => {
|
|||
Project.setSource(project, "first", "x=1")
|
||||
Project.setSource(project, "main", "x")
|
||||
Project.setContinues(project, "main", ["first"])
|
||||
let internalProject = project->Project.T.Private.castToInternalProject
|
||||
|
||||
test("runOrder", () => {
|
||||
expect(Project.getRunOrder(project)) == ["first", "main"]
|
||||
|
@ -78,10 +76,10 @@ describe("project1", () => {
|
|||
})
|
||||
|
||||
test("past chain first", () => {
|
||||
expect(Project.Private.getPastChain(internalProject, "first")) == []
|
||||
expect(ReducerProject.getPastChain(project, "first")) == []
|
||||
})
|
||||
test("past chain main", () => {
|
||||
expect(Project.Private.getPastChain(internalProject, "main")) == ["first"]
|
||||
expect(ReducerProject.getPastChain(project, "main")) == ["first"]
|
||||
})
|
||||
|
||||
test("test result", () => {
|
||||
|
|
|
@ -65,7 +65,7 @@ Case "Running a single source".
|
|||
/* Now you have external bindings and external result. */
|
||||
(
|
||||
result->InternalExpressionValue.toStringResult,
|
||||
bindings->InternalExpressionValue.IEvBindings->InternalExpressionValue.toString,
|
||||
bindings->Reducer_T.IEvBindings->InternalExpressionValue.toString,
|
||||
)->expect == ("Ok(3)", "@{}")
|
||||
})
|
||||
|
||||
|
|
|
@ -62,13 +62,13 @@ export class SqBoolValue extends SqAbstractValue {
|
|||
}
|
||||
}
|
||||
|
||||
export class SqCallValue extends SqAbstractValue {
|
||||
tag = Tag.Call as const;
|
||||
// export class SqCallValue extends SqAbstractValue {
|
||||
// tag = Tag.Call as const;
|
||||
|
||||
get value() {
|
||||
return this.valueMethod(RSValue.getCall);
|
||||
}
|
||||
}
|
||||
// get value() {
|
||||
// return this.valueMethod(RSValue.getCall);
|
||||
// }
|
||||
// }
|
||||
|
||||
export class SqDateValue extends SqAbstractValue {
|
||||
tag = Tag.Date as const;
|
||||
|
@ -134,13 +134,13 @@ export class SqStringValue extends SqAbstractValue {
|
|||
}
|
||||
}
|
||||
|
||||
export class SqSymbolValue extends SqAbstractValue {
|
||||
tag = Tag.Symbol as const;
|
||||
// export class SqSymbolValue extends SqAbstractValue {
|
||||
// tag = Tag.Symbol as const;
|
||||
|
||||
get value(): string {
|
||||
return this.valueMethod(RSValue.getSymbol);
|
||||
}
|
||||
}
|
||||
// get value(): string {
|
||||
// return this.valueMethod(RSValue.getSymbol);
|
||||
// }
|
||||
// }
|
||||
|
||||
export class SqTimeDurationValue extends SqAbstractValue {
|
||||
tag = Tag.TimeDuration as const;
|
||||
|
@ -178,7 +178,7 @@ const tagToClass = {
|
|||
[Tag.Array]: SqArrayValue,
|
||||
[Tag.ArrayString]: SqArrayStringValue,
|
||||
[Tag.Bool]: SqBoolValue,
|
||||
[Tag.Call]: SqCallValue,
|
||||
// [Tag.Call]: SqCallValue,
|
||||
[Tag.Date]: SqDateValue,
|
||||
[Tag.Declaration]: SqDeclarationValue,
|
||||
[Tag.Distribution]: SqDistributionValue,
|
||||
|
@ -187,7 +187,7 @@ const tagToClass = {
|
|||
[Tag.Number]: SqNumberValue,
|
||||
[Tag.Record]: SqRecordValue,
|
||||
[Tag.String]: SqStringValue,
|
||||
[Tag.Symbol]: SqSymbolValue,
|
||||
// [Tag.Symbol]: SqSymbolValue,
|
||||
[Tag.TimeDuration]: SqTimeDurationValue,
|
||||
[Tag.Type]: SqTypeValue,
|
||||
[Tag.TypeIdentifier]: SqTypeIdentifierValue,
|
||||
|
@ -200,7 +200,7 @@ export type SqValue =
|
|||
| SqArrayValue
|
||||
| SqArrayStringValue
|
||||
| SqBoolValue
|
||||
| SqCallValue
|
||||
// | SqCallValue
|
||||
| SqDateValue
|
||||
| SqDeclarationValue
|
||||
| SqDistributionValue
|
||||
|
@ -209,7 +209,7 @@ export type SqValue =
|
|||
| SqNumberValue
|
||||
| SqRecordValue
|
||||
| SqStringValue
|
||||
| SqSymbolValue
|
||||
// | SqSymbolValue
|
||||
| SqTimeDurationValue
|
||||
| SqTypeValue
|
||||
| SqTypeIdentifierValue
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
import { environment } from "../rescript/ForTS/ForTS_ReducerProject.gen";
|
||||
import { environment } from "../rescript/ForTS/ForTS__Types.gen";
|
||||
import { SqProject } from "./SqProject";
|
||||
import { SqValue, SqValueTag } from "./SqValue";
|
||||
export { SqValueLocation } from "./SqValueLocation";
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
@genType type reducerProject = ReducerProject_T.t //re-export
|
||||
@genType type reducerProject = ReducerProject_T.project //re-export
|
||||
|
||||
type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
|
||||
|
||||
|
@ -8,7 +8,7 @@ type squiggleValue_Module = ForTS_SquiggleValue_Module.squiggleValue_Module //us
|
|||
type environment = ForTS_Distribution_Environment.environment //use
|
||||
|
||||
module T = ReducerProject_T
|
||||
module Private = ReducerProject.Private
|
||||
module Private = ReducerProject
|
||||
|
||||
/*
|
||||
PUBLIC FUNCTIONS
|
||||
|
@ -35,35 +35,35 @@ A project has a public field tag with a constant value "reducerProject"
|
|||
project = {tag: "reducerProject"}
|
||||
*/
|
||||
@genType
|
||||
let createProject = (): reducerProject => Private.createProject()->T.Private.castFromInternalProject
|
||||
let createProject = (): reducerProject => Private.createProject()
|
||||
|
||||
/*
|
||||
Answer all the source ids of all the sources in the project.
|
||||
*/
|
||||
@genType
|
||||
let getSourceIds = (project: reducerProject): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getSourceIds
|
||||
project->Private.getSourceIds
|
||||
|
||||
/*
|
||||
Sets the source for a given source Id.
|
||||
*/
|
||||
@genType
|
||||
let setSource = (project: reducerProject, sourceId: string, value: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.setSource(sourceId, value)
|
||||
project->Private.setSource(sourceId, value)
|
||||
|
||||
/*
|
||||
Gets the source for a given source id.
|
||||
*/
|
||||
@genType
|
||||
let getSource = (project: reducerProject, sourceId: string): option<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getSource(sourceId)
|
||||
project->Private.getSource(sourceId)
|
||||
|
||||
/*
|
||||
Touches the source for a given source id. This and dependent, sources are set to be re-evaluated.
|
||||
*/
|
||||
@genType
|
||||
let touchSource = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.touchSource(sourceId)
|
||||
project->Private.touchSource(sourceId)
|
||||
|
||||
/*
|
||||
Cleans the compilation artifacts for a given source ID. The results stay untouched, so compilation won't be run again.
|
||||
|
@ -72,14 +72,14 @@ Normally, you would never need the compilation artifacts again as the results wi
|
|||
*/
|
||||
@genType
|
||||
let clean = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.clean(sourceId)
|
||||
project->Private.clean(sourceId)
|
||||
|
||||
/*
|
||||
Cleans all the compilation artifacts in all of the project
|
||||
*/
|
||||
@genType
|
||||
let cleanAll = (project: reducerProject): unit =>
|
||||
project->T.Private.castToInternalProject->Private.cleanAll
|
||||
project->Private.cleanAll
|
||||
|
||||
/*
|
||||
Cleans results. Compilation stays untouched to be able to re-run the source.
|
||||
|
@ -87,14 +87,14 @@ You would not do this if you were not trying to debug the source code.
|
|||
*/
|
||||
@genType
|
||||
let cleanResults = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.cleanResults(sourceId)
|
||||
project->Private.cleanResults(sourceId)
|
||||
|
||||
/*
|
||||
Cleans all results. Compilations remains untouched to rerun the source.
|
||||
*/
|
||||
@genType
|
||||
let cleanAllResults = (project: reducerProject): unit =>
|
||||
project->T.Private.castToInternalProject->Private.cleanAllResults
|
||||
project->Private.cleanAllResults
|
||||
|
||||
/*
|
||||
To set the includes one first has to call "parseIncludes". The parsed includes or the parser error is returned.
|
||||
|
@ -103,19 +103,19 @@ To set the includes one first has to call "parseIncludes". The parsed includes o
|
|||
let getIncludes = (project: reducerProject, sourceId: string): result<
|
||||
array<string>,
|
||||
reducerErrorValue,
|
||||
> => project->T.Private.castToInternalProject->Private.getIncludes(sourceId)
|
||||
> => project->Private.getIncludes(sourceId)
|
||||
|
||||
/* Other sources contributing to the global namespace of this source. */
|
||||
@genType
|
||||
let getPastChain = (project: reducerProject, sourceId: string): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getPastChain(sourceId)
|
||||
project->Private.getPastChain(sourceId)
|
||||
|
||||
/*
|
||||
Answers the source codes after which this source code is continuing
|
||||
*/
|
||||
@genType
|
||||
let getContinues = (project: reducerProject, sourceId: string): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getContinues(sourceId)
|
||||
project->Private.getContinues(sourceId)
|
||||
|
||||
/*
|
||||
"continues" acts like hidden includes in the source.
|
||||
|
@ -124,35 +124,35 @@ let getContinues = (project: reducerProject, sourceId: string): array<string> =>
|
|||
*/
|
||||
@genType
|
||||
let setContinues = (project: reducerProject, sourceId: string, continues: array<string>): unit =>
|
||||
project->T.Private.castToInternalProject->Private.setContinues(sourceId, continues)
|
||||
project->Private.setContinues(sourceId, continues)
|
||||
|
||||
/*
|
||||
This source depends on the array of sources returned.
|
||||
*/
|
||||
@genType
|
||||
let getDependencies = (project: reducerProject, sourceId: string): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getDependencies(sourceId)
|
||||
project->Private.getDependencies(sourceId)
|
||||
|
||||
/*
|
||||
The sources returned are dependent on this
|
||||
*/
|
||||
@genType
|
||||
let getDependents = (project: reducerProject, sourceId: string): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getDependents(sourceId)
|
||||
project->Private.getDependents(sourceId)
|
||||
|
||||
/*
|
||||
Get the run order for the sources in the project.
|
||||
*/
|
||||
@genType
|
||||
let getRunOrder = (project: reducerProject): array<string> =>
|
||||
project->T.Private.castToInternalProject->Private.getRunOrder
|
||||
project->Private.getRunOrder
|
||||
|
||||
/*
|
||||
Get the run order to get the results of this specific source
|
||||
*/
|
||||
@genType
|
||||
let getRunOrderFor = (project: reducerProject, sourceId: string) =>
|
||||
project->T.Private.castToInternalProject->Private.getRunOrderFor(sourceId)
|
||||
project->Private.getRunOrderFor(sourceId)
|
||||
|
||||
/*
|
||||
Parse includes so that you can load them before running.
|
||||
|
@ -162,7 +162,7 @@ It is your responsibility to load the includes before running.
|
|||
|
||||
@genType
|
||||
let parseIncludes = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.parseIncludes(sourceId)
|
||||
project->Private.parseIncludes(sourceId)
|
||||
|
||||
/*
|
||||
Parse the source code if it is not done already.
|
||||
|
@ -171,28 +171,28 @@ You would need this function if you want to see the parse tree without running t
|
|||
*/
|
||||
@genType
|
||||
let rawParse = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.rawParse(sourceId)
|
||||
project->Private.rawParse(sourceId)
|
||||
|
||||
/*
|
||||
Runs a specific source code if it is not done already. The code is parsed if it is not already done. It runs the dependencies if it is not already done.
|
||||
*/
|
||||
@genType
|
||||
let run = (project: reducerProject, sourceId: string): unit =>
|
||||
project->T.Private.castToInternalProject->Private.run(sourceId)
|
||||
project->Private.run(sourceId)
|
||||
|
||||
/*
|
||||
Runs all of the sources in a project. Their results and bindings will be available
|
||||
*/
|
||||
@genType
|
||||
let runAll = (project: reducerProject): unit =>
|
||||
project->T.Private.castToInternalProject->Private.runAll
|
||||
project->Private.runAll
|
||||
|
||||
/*
|
||||
Get the bindings after running this source fil. The bindings are local to the source
|
||||
*/
|
||||
@genType
|
||||
let getBindings = (project: reducerProject, sourceId: string): squiggleValue_Module =>
|
||||
project->T.Private.castToInternalProject->Private.getBindings(sourceId)
|
||||
project->Private.getBindings(sourceId)
|
||||
|
||||
/*
|
||||
Get the result after running this source file or the project
|
||||
|
@ -201,7 +201,7 @@ Get the result after running this source file or the project
|
|||
let getResult = (project: reducerProject, sourceId: string): result<
|
||||
squiggleValue,
|
||||
reducerErrorValue,
|
||||
> => project->T.Private.castToInternalProject->Private.getResult(sourceId)
|
||||
> => project->Private.getResult(sourceId)
|
||||
|
||||
/*
|
||||
This is a convenience function to get the result of a single source without creating a project.
|
||||
|
@ -216,7 +216,7 @@ let evaluate = (sourceCode: string): (
|
|||
|
||||
@genType
|
||||
let setEnvironment = (project: reducerProject, environment: environment): unit =>
|
||||
project->T.Private.castToInternalProject->Private.setEnvironment(environment)
|
||||
project->Private.setEnvironment(environment)
|
||||
|
||||
/*
|
||||
Foreign function interface is intentionally demolished.
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
@genType type squiggleValue = ReducerInterface_InternalExpressionValue.t //re-export
|
||||
@genType type squiggleValue = Reducer_T.value //re-export
|
||||
type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
|
||||
|
||||
@genType type squiggleValue_Array = ReducerInterface_InternalExpressionValue.squiggleArray //re-export recursive type
|
||||
@genType type squiggleValue_Module = ReducerInterface_InternalExpressionValue.nameSpace //re-export recursive type
|
||||
@genType type squiggleValue_Record = ReducerInterface_InternalExpressionValue.map //re-export recursive type
|
||||
@genType type squiggleValue_Type = ReducerInterface_InternalExpressionValue.map //re-export recursive type
|
||||
@genType type squiggleValue_Array = Reducer_T.arrayValue //re-export recursive type
|
||||
@genType type squiggleValue_Module = Reducer_T.nameSpace //re-export recursive type
|
||||
@genType type squiggleValue_Record = Reducer_T.map //re-export recursive type
|
||||
@genType type squiggleValue_Type = Reducer_T.map //re-export recursive type
|
||||
type squiggleValue_Declaration = ForTS_SquiggleValue_Declaration.squiggleValue_Declaration //use
|
||||
type squiggleValue_Distribution = ForTS_SquiggleValue_Distribution.squiggleValue_Distribution //use
|
||||
type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //use
|
||||
|
@ -20,8 +20,8 @@ external svtArrayString_: string = "ArrayString"
|
|||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtBool_: string = "Bool"
|
||||
|
||||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtCall_: string = "Call"
|
||||
// @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
// external svtCall_: string = "Call"
|
||||
|
||||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtDate_: string = "Date"
|
||||
|
@ -47,8 +47,8 @@ external svtRecord_: string = "Record"
|
|||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtString_: string = "String"
|
||||
|
||||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtSymbol_: string = "Symbol"
|
||||
// @module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
// external svtSymbol_: string = "Symbol"
|
||||
|
||||
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
|
||||
external svtTimeDuration_: string = "TimeDuration"
|
||||
|
@ -73,7 +73,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
|
|||
| IEvArray(_) => svtArray_->castEnum
|
||||
| IEvArrayString(_) => svtArrayString_->castEnum
|
||||
| IEvBool(_) => svtBool_->castEnum
|
||||
| IEvCall(_) => svtCall_->castEnum //Impossible
|
||||
// | IEvCall(_) => svtCall_->castEnum //Impossible
|
||||
| IEvDate(_) => svtDate_->castEnum
|
||||
| IEvDeclaration(_) => svtDeclaration_->castEnum
|
||||
| IEvDistribution(_) => svtDistribution_->castEnum
|
||||
|
@ -82,7 +82,7 @@ let getTag = (variant: squiggleValue): squiggleValueTag =>
|
|||
| IEvNumber(_) => svtNumber_->castEnum
|
||||
| IEvRecord(_) => svtRecord_->castEnum
|
||||
| IEvString(_) => svtString_->castEnum
|
||||
| IEvSymbol(_) => svtSymbol_->castEnum
|
||||
// | IEvSymbol(_) => svtSymbol_->castEnum
|
||||
| IEvTimeDuration(_) => svtTimeDuration_->castEnum
|
||||
| IEvType(_) => svtType_->castEnum
|
||||
| IEvTypeIdentifier(_) => svtTypeIdentifier_->castEnum
|
||||
|
@ -121,12 +121,12 @@ let getBool = (variant: squiggleValue): option<bool> =>
|
|||
| _ => None
|
||||
}
|
||||
|
||||
@genType
|
||||
let getCall = (variant: squiggleValue): option<string> =>
|
||||
switch variant {
|
||||
| IEvCall(value) => value->Some
|
||||
| _ => None
|
||||
}
|
||||
// @genType
|
||||
// let getCall = (variant: squiggleValue): option<string> =>
|
||||
// switch variant {
|
||||
// | IEvCall(value) => value->Some
|
||||
// | _ => None
|
||||
// }
|
||||
|
||||
@genType
|
||||
let getDate = (variant: squiggleValue): option<Js.Date.t> =>
|
||||
|
@ -184,12 +184,12 @@ let getString = (variant: squiggleValue): option<string> =>
|
|||
| _ => None
|
||||
}
|
||||
|
||||
@genType
|
||||
let getSymbol = (variant: squiggleValue): option<string> =>
|
||||
switch variant {
|
||||
| IEvSymbol(value) => value->Some
|
||||
| _ => None
|
||||
}
|
||||
// @genType
|
||||
// let getSymbol = (variant: squiggleValue): option<string> =>
|
||||
// switch variant {
|
||||
// | IEvSymbol(value) => value->Some
|
||||
// | _ => None
|
||||
// }
|
||||
|
||||
@genType
|
||||
let getTimeDuration = (variant: squiggleValue): option<float> =>
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
@genType type squiggleValue_Declaration = ReducerInterface_InternalExpressionValue.lambdaDeclaration //re-export
|
||||
@genType type squiggleValue_Declaration = Reducer_T.lambdaDeclaration //re-export
|
||||
|
||||
@genType
|
||||
let toString = (v: squiggleValue_Declaration): string =>
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
@genType type squiggleValue_Lambda = ReducerInterface_InternalExpressionValue.lambdaValue //re-export
|
||||
@genType type squiggleValue_Lambda = Reducer_T.lambdaValue //re-export
|
||||
|
||||
@genType
|
||||
let toString = (v: squiggleValue_Lambda): string =>
|
||||
|
|
|
@ -3,7 +3,7 @@ type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
|
|||
|
||||
@genType
|
||||
let getKeyValuePairs = (v: squiggleValue_Module): array<(string, squiggleValue)> =>
|
||||
ReducerInterface_InternalExpressionValue.nameSpaceToKeyValuePairs(v)
|
||||
v->Reducer_Bindings.toKeyValuePairs
|
||||
|
||||
@genType
|
||||
let toString = (v: squiggleValue_Module): string =>
|
||||
|
@ -13,4 +13,4 @@ let toString = (v: squiggleValue_Module): string =>
|
|||
let toSquiggleValue = (v: squiggleValue_Module): squiggleValue => IEvBindings(v)
|
||||
|
||||
@genType
|
||||
let get = Reducer_Bindings.get
|
||||
let get = (v: squiggleValue_Module, k: string): option<squiggleValue> => Reducer_Bindings.get(v, k)
|
||||
|
|
|
@ -2,7 +2,7 @@ export enum squiggleValueTag {
|
|||
Array = "Array",
|
||||
ArrayString = "ArrayString",
|
||||
Bool = "Bool",
|
||||
Call = "Call",
|
||||
// Call = "Call",
|
||||
Date = "Date",
|
||||
Declaration = "Declaration",
|
||||
Distribution = "Distribution",
|
||||
|
@ -11,7 +11,7 @@ export enum squiggleValueTag {
|
|||
Number = "Number",
|
||||
Record = "Record",
|
||||
String = "String",
|
||||
Symbol = "Symbol",
|
||||
// Symbol = "Symbol",
|
||||
TimeDuration = "TimeDuration",
|
||||
Type = "Type",
|
||||
TypeIdentifier = "TypeIdentifier",
|
||||
|
|
|
@ -1,6 +1,4 @@
|
|||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
type internalExpressionValue = ReducerInterface_InternalExpressionValue.t
|
||||
type internalExpressionValue = Reducer_T.value
|
||||
type internalExpressionValueType = ReducerInterface_InternalExpressionValue.internalExpressionValueType
|
||||
|
||||
/*
|
||||
|
@ -32,7 +30,7 @@ type rec frValue =
|
|||
| FRValueArray(array<frValue>)
|
||||
| FRValueDistOrNumber(frValueDistOrNumber)
|
||||
| FRValueRecord(frValueRecord)
|
||||
| FRValueLambda(ReducerInterface_InternalExpressionValue.lambdaValue)
|
||||
| FRValueLambda(Reducer_T.lambdaValue)
|
||||
| FRValueString(string)
|
||||
| FRValueVariant(string)
|
||||
| FRValueAny(frValue)
|
||||
|
@ -48,8 +46,8 @@ type fnDefinition = {
|
|||
run: (
|
||||
array<internalExpressionValue>,
|
||||
array<frValue>,
|
||||
ProjectAccessorsT.t,
|
||||
ProjectReducerFnT.t,
|
||||
Reducer_T.environment,
|
||||
Reducer_T.reducerFn,
|
||||
) => result<internalExpressionValue, string>,
|
||||
}
|
||||
|
||||
|
@ -384,12 +382,12 @@ module FnDefinition = {
|
|||
let run = (
|
||||
t: t,
|
||||
args: array<internalExpressionValue>,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn,
|
||||
) => {
|
||||
let argValues = FRType.matchWithExpressionValueArray(t.inputs, args)
|
||||
switch argValues {
|
||||
| Some(values) => t.run(args, values, accessors, reducer)
|
||||
| Some(values) => t.run(args, values, env, reducer)
|
||||
| None => Error("Incorrect Types")
|
||||
}
|
||||
}
|
||||
|
@ -495,8 +493,8 @@ module Registry = {
|
|||
~registry: registry,
|
||||
~fnName: string,
|
||||
~args: array<internalExpressionValue>,
|
||||
~accessors: ProjectAccessorsT.t,
|
||||
~reducer: ProjectReducerFnT.t,
|
||||
~env: Reducer_T.environment,
|
||||
~reducer: Reducer_T.reducerFn,
|
||||
) => {
|
||||
let relevantFunctions = Js.Dict.get(registry.fnNameDict, fnName) |> E.O.default([])
|
||||
let modified = {functions: relevantFunctions, fnNameDict: registry.fnNameDict}
|
||||
|
@ -514,7 +512,7 @@ module Registry = {
|
|||
|
||||
switch Matcher.Registry.findMatches(modified, fnName, args) {
|
||||
| Matcher.Match.FullMatch(match) =>
|
||||
match->matchToDef->E.O2.fmap(FnDefinition.run(_, args, accessors, reducer))
|
||||
match->matchToDef->E.O2.fmap(FnDefinition.run(_, args, env, reducer))
|
||||
| SameNameDifferentArguments(m) => Some(Error(showNameMatchDefinitions(m)))
|
||||
| _ => None
|
||||
}
|
||||
|
@ -523,10 +521,10 @@ module Registry = {
|
|||
let dispatch = (
|
||||
registry,
|
||||
(fnName, args): ReducerInterface_InternalExpressionValue.functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn,
|
||||
) => {
|
||||
_matchAndRun(~registry, ~fnName, ~args, ~accessors, ~reducer)->E.O2.fmap(
|
||||
_matchAndRun(~registry, ~fnName, ~args, ~env, ~reducer)->E.O2.fmap(
|
||||
E.R2.errMap(_, s => Reducer_ErrorValue.RETodo(s)),
|
||||
)
|
||||
}
|
||||
|
|
|
@ -6,11 +6,11 @@ module Wrappers = {
|
|||
let symbolic = r => DistributionTypes.Symbolic(r)
|
||||
let pointSet = r => DistributionTypes.PointSet(r)
|
||||
let sampleSet = r => DistributionTypes.SampleSet(r)
|
||||
let evDistribution = r => ReducerInterface_InternalExpressionValue.IEvDistribution(r)
|
||||
let evNumber = r => ReducerInterface_InternalExpressionValue.IEvNumber(r)
|
||||
let evArray = r => ReducerInterface_InternalExpressionValue.IEvArray(r)
|
||||
let evRecord = r => ReducerInterface_InternalExpressionValue.IEvRecord(r)
|
||||
let evString = r => ReducerInterface_InternalExpressionValue.IEvString(r)
|
||||
let evDistribution = r => Reducer_T.IEvDistribution(r)
|
||||
let evNumber = r => Reducer_T.IEvNumber(r)
|
||||
let evArray = r => Reducer_T.IEvArray(r)
|
||||
let evRecord = r => Reducer_T.IEvRecord(r)
|
||||
let evString = r => Reducer_T.IEvString(r)
|
||||
let symbolicEvDistribution = r => r->DistributionTypes.Symbolic->evDistribution
|
||||
let evArrayOfEvNumber = xs => xs->Belt.Array.map(evNumber)->evArray
|
||||
}
|
||||
|
|
|
@ -69,12 +69,12 @@ module Integration = {
|
|||
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
|
||||
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
|
||||
aLambda,
|
||||
list{pointAsInternalExpression},
|
||||
[pointAsInternalExpression],
|
||||
environment,
|
||||
reducer,
|
||||
reducer
|
||||
)
|
||||
let result = switch resultAsInternalExpression {
|
||||
| IEvNumber(x) => Ok(x)
|
||||
| Reducer_T.IEvNumber(x) => Ok(x)
|
||||
| _ =>
|
||||
Error(
|
||||
"Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
||||
|
@ -132,7 +132,7 @@ module Integration = {
|
|||
| (Ok(yMin), Ok(yMax)) => {
|
||||
let result =
|
||||
(yMin +. yMax) *. weightForAnOuterPoint +. innerPointsSum *. weightForAnInnerPoint
|
||||
let wrappedResult = result->ReducerInterface_InternalExpressionValue.IEvNumber->Ok
|
||||
let wrappedResult = result->Reducer_T.IEvNumber->Ok
|
||||
wrappedResult
|
||||
}
|
||||
| (Error(b), _) => Error(b)
|
||||
|
@ -273,7 +273,7 @@ module DiminishingReturns = {
|
|||
funds,
|
||||
approximateIncrement,
|
||||
environment,
|
||||
reducer,
|
||||
reducer
|
||||
) => {
|
||||
switch (
|
||||
E.A.length(lambdas) > 1,
|
||||
|
@ -303,12 +303,12 @@ module DiminishingReturns = {
|
|||
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
|
||||
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
|
||||
lambda,
|
||||
list{pointAsInternalExpression},
|
||||
[pointAsInternalExpression],
|
||||
environment,
|
||||
reducer,
|
||||
reducer
|
||||
)
|
||||
switch resultAsInternalExpression {
|
||||
| IEvNumber(x) => Ok(x)
|
||||
| Reducer_T.IEvNumber(x) => Ok(x)
|
||||
| _ =>
|
||||
Error(
|
||||
"Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
|
||||
|
@ -401,7 +401,7 @@ module DiminishingReturns = {
|
|||
| [IEvArray(innerlambdas), IEvNumber(funds), IEvNumber(approximateIncrement)] => {
|
||||
let individuallyWrappedLambdas = E.A.fmap(innerLambda => {
|
||||
switch innerLambda {
|
||||
| ReducerInterface_InternalExpressionValue.IEvLambda(lambda) => Ok(lambda)
|
||||
| Reducer_T.IEvLambda(lambda) => Ok(lambda)
|
||||
| _ =>
|
||||
Error(
|
||||
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. A member of the array wasn't a function",
|
||||
|
|
|
@ -4,7 +4,7 @@ open FunctionRegistry_Helpers
|
|||
let nameSpace = "Dict"
|
||||
|
||||
module Internals = {
|
||||
type t = ReducerInterface_InternalExpressionValue.map
|
||||
type t = Reducer_T.map
|
||||
|
||||
let keys = (a: t): internalExpressionValue => IEvArray(
|
||||
Belt.Map.String.keysToArray(a)->E.A2.fmap(Wrappers.evString),
|
||||
|
|
|
@ -21,8 +21,8 @@ module DistributionCreation = {
|
|||
FnDefinition.make(
|
||||
~name,
|
||||
~inputs=[FRTypeDistOrNumber, FRTypeDistOrNumber],
|
||||
~run=(_, inputs, accessors, _) =>
|
||||
inputs->Prepare.ToValueTuple.twoDistOrNumber->process(~fn, ~env=accessors.environment),
|
||||
~run=(_, inputs, env, _) =>
|
||||
inputs->Prepare.ToValueTuple.twoDistOrNumber->process(~fn, ~env=env),
|
||||
(),
|
||||
)
|
||||
}
|
||||
|
@ -31,10 +31,10 @@ module DistributionCreation = {
|
|||
FnDefinition.make(
|
||||
~name,
|
||||
~inputs=[FRTypeRecord([("p5", FRTypeDistOrNumber), ("p95", FRTypeDistOrNumber)])],
|
||||
~run=(_, inputs, accessors, _) =>
|
||||
~run=(_, inputs, env, _) =>
|
||||
inputs
|
||||
->Prepare.ToValueTuple.Record.twoDistOrNumber
|
||||
->process(~fn, ~env=accessors.environment),
|
||||
->process(~fn, ~env=env),
|
||||
(),
|
||||
)
|
||||
}
|
||||
|
@ -43,10 +43,10 @@ module DistributionCreation = {
|
|||
FnDefinition.make(
|
||||
~name,
|
||||
~inputs=[FRTypeRecord([("mean", FRTypeDistOrNumber), ("stdev", FRTypeDistOrNumber)])],
|
||||
~run=(_, inputs, accessors, _) =>
|
||||
~run=(_, inputs, env, _) =>
|
||||
inputs
|
||||
->Prepare.ToValueTuple.Record.twoDistOrNumber
|
||||
->process(~fn, ~env=accessors.environment),
|
||||
->process(~fn, ~env=env),
|
||||
(),
|
||||
)
|
||||
}
|
||||
|
@ -62,8 +62,8 @@ module DistributionCreation = {
|
|||
FnDefinition.make(
|
||||
~name,
|
||||
~inputs=[FRTypeDistOrNumber],
|
||||
~run=(_, inputs, accessors, _) =>
|
||||
inputs->Prepare.ToValueTuple.oneDistOrNumber->process(~fn, ~env=accessors.environment),
|
||||
~run=(_, inputs, env, _) =>
|
||||
inputs->Prepare.ToValueTuple.oneDistOrNumber->process(~fn, ~env=env),
|
||||
(),
|
||||
)
|
||||
}
|
||||
|
|
|
@ -18,7 +18,7 @@ module Declaration = {
|
|||
inputs
|
||||
->E.A2.fmap(getMinMax)
|
||||
->E.A.R.firstErrorOrOpen
|
||||
->E.R2.fmap(args => ReducerInterface_InternalExpressionValue.IEvDeclaration(
|
||||
->E.R2.fmap(args => Reducer_T.IEvDeclaration(
|
||||
Declaration.make(lambda, args),
|
||||
))
|
||||
}
|
||||
|
|
|
@ -1,6 +1,3 @@
|
|||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
|
||||
open FunctionRegistry_Core
|
||||
open FunctionRegistry_Helpers
|
||||
|
||||
|
@ -29,16 +26,16 @@ module Internals = {
|
|||
|
||||
let map = (
|
||||
array: array<internalExpressionValue>,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
eLambdaValue,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
): ReducerInterface_InternalExpressionValue.t => {
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
): internalExpressionValue => {
|
||||
let mappedList = array->E.A.reduceReverse(list{}, (acc, elem) => {
|
||||
let newElem = Reducer_Expression_Lambda.doLambdaCall(
|
||||
eLambdaValue,
|
||||
list{elem},
|
||||
(accessors: ProjectAccessorsT.t),
|
||||
(reducer: ProjectReducerFnT.t),
|
||||
[elem],
|
||||
env,
|
||||
reducer
|
||||
)
|
||||
list{newElem, ...acc}
|
||||
})
|
||||
|
@ -49,11 +46,11 @@ module Internals = {
|
|||
aValueArray,
|
||||
initialValue,
|
||||
aLambdaValue,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
) => {
|
||||
aValueArray->E.A.reduce(initialValue, (acc, elem) =>
|
||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, [acc, elem], env, reducer)
|
||||
)
|
||||
}
|
||||
|
||||
|
@ -61,26 +58,26 @@ module Internals = {
|
|||
aValueArray,
|
||||
initialValue,
|
||||
aLambdaValue,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
) => {
|
||||
aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) =>
|
||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
|
||||
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, [acc, elem], env, reducer)
|
||||
)
|
||||
}
|
||||
|
||||
let filter = (
|
||||
aValueArray,
|
||||
aLambdaValue,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
) => {
|
||||
let mappedList = aValueArray->Belt.Array.reduceReverse(list{}, (acc, elem) => {
|
||||
let newElem = Reducer_Expression_Lambda.doLambdaCall(
|
||||
aLambdaValue,
|
||||
list{elem},
|
||||
accessors,
|
||||
reducer,
|
||||
[elem],
|
||||
env,
|
||||
reducer
|
||||
)
|
||||
switch newElem {
|
||||
| IEvBool(true) => list{elem, ...acc}
|
||||
|
@ -201,10 +198,10 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="map",
|
||||
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||
~run=(inputs, _, env, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvArray(array), IEvLambda(lambda)] =>
|
||||
Ok(Internals.map(array, accessors, lambda, reducer))
|
||||
Ok(Internals.map(array, lambda, env, reducer))
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
@ -221,10 +218,10 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="reduce",
|
||||
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||
~run=(inputs, _, env, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
||||
Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer))
|
||||
Ok(Internals.reduce(array, initialValue, lambda, env, reducer))
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
@ -241,10 +238,10 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="reduceReverse",
|
||||
~inputs=[FRTypeArray(FRTypeAny), FRTypeAny, FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
||||
~run=(inputs, _, env, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
|
||||
Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer))
|
||||
Ok(Internals.reduceReverse(array, initialValue, lambda, env, reducer))
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
@ -261,10 +258,10 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="filter",
|
||||
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
||||
~run=(inputs, _, env, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvArray(array), IEvLambda(lambda)] =>
|
||||
Ok(Internals.filter(array, lambda, accessors, reducer))
|
||||
Ok(Internals.filter(array, lambda, env, reducer))
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
|
|
@ -17,7 +17,7 @@ let inputsTodist = (inputs: array<FunctionRegistry_Core.frValue>, makeDist) => {
|
|||
let expressionValue =
|
||||
xyCoords
|
||||
->E.R.bind(r => r->XYShape.T.makeFromZipped->E.R2.errMap(XYShape.Error.toString))
|
||||
->E.R2.fmap(r => ReducerInterface_InternalExpressionValue.IEvDistribution(
|
||||
->E.R2.fmap(r => Reducer_T.IEvDistribution(
|
||||
PointSet(makeDist(r)),
|
||||
))
|
||||
expressionValue
|
||||
|
@ -27,7 +27,7 @@ module Internal = {
|
|||
type t = PointSetDist.t
|
||||
|
||||
let toType = (r): result<
|
||||
ReducerInterface_InternalExpressionValue.t,
|
||||
Reducer_T.value,
|
||||
Reducer_ErrorValue.errorValue,
|
||||
> =>
|
||||
switch r {
|
||||
|
@ -35,14 +35,14 @@ module Internal = {
|
|||
| Error(err) => Error(REOperationError(err))
|
||||
}
|
||||
|
||||
let doLambdaCall = (aLambdaValue, list, environment, reducer) =>
|
||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
|
||||
| IEvNumber(f) => Ok(f)
|
||||
let doLambdaCall = (aLambdaValue, list, env, reducer) =>
|
||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, env, reducer) {
|
||||
| Reducer_T.IEvNumber(f) => Ok(f)
|
||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||
}
|
||||
|
||||
let mapY = (pointSetDist: t, aLambdaValue, env, reducer) => {
|
||||
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, env, reducer)
|
||||
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], env, reducer)
|
||||
PointSetDist.T.mapYResult(~fn, pointSetDist)->toType
|
||||
}
|
||||
}
|
||||
|
@ -58,13 +58,13 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="fromDist",
|
||||
~inputs=[FRTypeDist],
|
||||
~run=(_, inputs, accessors, _) =>
|
||||
~run=(_, inputs, env, _) =>
|
||||
switch inputs {
|
||||
| [FRValueDist(dist)] =>
|
||||
GenericDist.toPointSet(
|
||||
dist,
|
||||
~xyPointLength=accessors.environment.xyPointLength,
|
||||
~sampleCount=accessors.environment.sampleCount,
|
||||
~xyPointLength=env.xyPointLength,
|
||||
~sampleCount=env.sampleCount,
|
||||
(),
|
||||
)
|
||||
->E.R2.fmap(Wrappers.pointSet)
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
open FunctionRegistry_Core
|
||||
open FunctionRegistry_Helpers
|
||||
|
||||
|
@ -12,16 +10,16 @@ module Internal = {
|
|||
let doLambdaCall = (
|
||||
aLambdaValue,
|
||||
list,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn,
|
||||
) =>
|
||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
||||
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, env, reducer) {
|
||||
| IEvNumber(f) => Ok(f)
|
||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||
}
|
||||
|
||||
let toType = (r): result<
|
||||
ReducerInterface_InternalExpressionValue.t,
|
||||
Reducer_T.value,
|
||||
Reducer_ErrorValue.errorValue,
|
||||
> =>
|
||||
switch r {
|
||||
|
@ -30,26 +28,26 @@ module Internal = {
|
|||
}
|
||||
|
||||
//TODO: I don't know why this seems to need at least one input
|
||||
let fromFn = (aLambdaValue, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => {
|
||||
let sampleCount = accessors.environment.sampleCount
|
||||
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, accessors, reducer)
|
||||
let fromFn = (aLambdaValue, environment: Reducer_T.environment, reducer: Reducer_T.reducerFn) => {
|
||||
let sampleCount = environment.sampleCount
|
||||
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], environment, reducer)
|
||||
Belt_Array.makeBy(sampleCount, r => fn(r->Js.Int.toFloat))->E.A.R.firstErrorOrOpen
|
||||
}
|
||||
|
||||
let map1 = (sampleSetDist: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
|
||||
let fn = r => doLambdaCall(aLambdaValue, list{IEvNumber(r)}, accessors, reducer)
|
||||
let map1 = (sampleSetDist: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
|
||||
let fn = r => doLambdaCall(aLambdaValue, [IEvNumber(r)], environment, reducer)
|
||||
SampleSetDist.samplesMap(~fn, sampleSetDist)->toType
|
||||
}
|
||||
|
||||
let map2 = (t1: t, t2: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
|
||||
let map2 = (t1: t, t2: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
|
||||
let fn = (a, b) =>
|
||||
doLambdaCall(aLambdaValue, list{IEvNumber(a), IEvNumber(b)}, accessors, reducer)
|
||||
doLambdaCall(aLambdaValue, [IEvNumber(a), IEvNumber(b)], environment, reducer)
|
||||
SampleSetDist.map2(~fn, ~t1, ~t2)->toType
|
||||
}
|
||||
|
||||
let map3 = (t1: t, t2: t, t3: t, aLambdaValue, accessors: ProjectAccessorsT.t, reducer) => {
|
||||
let map3 = (t1: t, t2: t, t3: t, aLambdaValue, environment: Reducer_T.environment, reducer) => {
|
||||
let fn = (a, b, c) =>
|
||||
doLambdaCall(aLambdaValue, list{IEvNumber(a), IEvNumber(b), IEvNumber(c)}, accessors, reducer)
|
||||
doLambdaCall(aLambdaValue, [IEvNumber(a), IEvNumber(b), IEvNumber(c)], environment, reducer)
|
||||
SampleSetDist.map3(~fn, ~t1, ~t2, ~t3)->toType
|
||||
}
|
||||
|
||||
|
@ -67,7 +65,7 @@ module Internal = {
|
|||
let mapN = (
|
||||
aValueArray: array<internalExpressionValue>,
|
||||
aLambdaValue,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
environment: Reducer_T.environment,
|
||||
reducer,
|
||||
) => {
|
||||
switch parseSampleSetArray(aValueArray) {
|
||||
|
@ -75,8 +73,8 @@ module Internal = {
|
|||
let fn = a =>
|
||||
doLambdaCall(
|
||||
aLambdaValue,
|
||||
list{IEvArray(E.A.fmap(x => Wrappers.evNumber(x), a))},
|
||||
accessors,
|
||||
[IEvArray(E.A.fmap(x => Wrappers.evNumber(x), a))],
|
||||
environment,
|
||||
reducer,
|
||||
)
|
||||
SampleSetDist.mapN(~fn, ~t1)->toType
|
||||
|
@ -96,10 +94,10 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="fromDist",
|
||||
~inputs=[FRTypeDist],
|
||||
~run=(_, inputs, accessors: ProjectAccessorsT.t, _) =>
|
||||
~run=(_, inputs, environment, _) =>
|
||||
switch inputs {
|
||||
| [FRValueDist(dist)] =>
|
||||
GenericDist.toSampleSetDist(dist, accessors.environment.sampleCount)
|
||||
GenericDist.toSampleSetDist(dist, environment.sampleCount)
|
||||
->E.R2.fmap(Wrappers.sampleSet)
|
||||
->E.R2.fmap(Wrappers.evDistribution)
|
||||
->E.R2.errMap(DistributionTypes.Error.toString)
|
||||
|
@ -163,10 +161,10 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="fromFn",
|
||||
~inputs=[FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
|
||||
~run=(inputs, _, environment, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvLambda(lambda)] =>
|
||||
switch Internal.fromFn(lambda, accessors, reducer) {
|
||||
switch Internal.fromFn(lambda, environment, reducer) {
|
||||
| Ok(r) => Ok(r->Wrappers.sampleSet->Wrappers.evDistribution)
|
||||
| Error(e) => Error(Operation.Error.toString(e))
|
||||
}
|
||||
|
@ -187,10 +185,10 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="map",
|
||||
~inputs=[FRTypeDist, FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||
~run=(inputs, _, environment, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvDistribution(SampleSet(dist)), IEvLambda(lambda)] =>
|
||||
Internal.map1(dist, lambda, accessors, reducer)->E.R2.errMap(_ => "")
|
||||
Internal.map1(dist, lambda, environment, reducer)->E.R2.errMap(_ => "")
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
@ -210,14 +208,14 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="map2",
|
||||
~inputs=[FRTypeDist, FRTypeDist, FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => {
|
||||
~run=(inputs, _, environment, reducer) => {
|
||||
switch inputs {
|
||||
| [
|
||||
IEvDistribution(SampleSet(dist1)),
|
||||
IEvDistribution(SampleSet(dist2)),
|
||||
IEvLambda(lambda),
|
||||
] =>
|
||||
Internal.map2(dist1, dist2, lambda, accessors, reducer)->E.R2.errMap(_ => "")
|
||||
Internal.map2(dist1, dist2, lambda, environment, reducer)->E.R2.errMap(_ => "")
|
||||
| _ => Error(impossibleError)
|
||||
}
|
||||
},
|
||||
|
@ -238,7 +236,7 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="map3",
|
||||
~inputs=[FRTypeDist, FRTypeDist, FRTypeDist, FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||
~run=(inputs, _, environment, reducer) =>
|
||||
switch inputs {
|
||||
| [
|
||||
IEvDistribution(SampleSet(dist1)),
|
||||
|
@ -246,7 +244,7 @@ let libaryBase = [
|
|||
IEvDistribution(SampleSet(dist3)),
|
||||
IEvLambda(lambda),
|
||||
] =>
|
||||
Internal.map3(dist1, dist2, dist3, lambda, accessors, reducer)->E.R2.errMap(_ => "")
|
||||
Internal.map3(dist1, dist2, dist3, lambda, environment, reducer)->E.R2.errMap(_ => "")
|
||||
| _ => Error(impossibleError)
|
||||
},
|
||||
(),
|
||||
|
@ -266,10 +264,10 @@ let libaryBase = [
|
|||
FnDefinition.make(
|
||||
~name="mapN",
|
||||
~inputs=[FRTypeArray(FRTypeDist), FRTypeLambda],
|
||||
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
|
||||
~run=(inputs, _, environment, reducer) =>
|
||||
switch inputs {
|
||||
| [IEvArray(dists), IEvLambda(lambda)] =>
|
||||
Internal.mapN(dists, lambda, accessors, reducer)->E.R2.errMap(_e => {
|
||||
Internal.mapN(dists, lambda, environment, reducer)->E.R2.errMap(_e => {
|
||||
"AHHH doesn't work"
|
||||
})
|
||||
| _ => Error(impossibleError)
|
||||
|
|
|
@ -30,16 +30,16 @@ let library = [
|
|||
("prior", FRTypeDist),
|
||||
]),
|
||||
],
|
||||
~run=(_, inputs, accessors, _) => {
|
||||
~run=(_, inputs, environment, _) => {
|
||||
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.threeArgs(inputs) {
|
||||
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueDist(d)), FRValueDist(prior)]) =>
|
||||
runScoring(estimate, Score_Dist(d), Some(prior), accessors.environment)
|
||||
runScoring(estimate, Score_Dist(d), Some(prior), environment)
|
||||
| Ok([
|
||||
FRValueDist(estimate),
|
||||
FRValueDistOrNumber(FRValueNumber(d)),
|
||||
FRValueDist(prior),
|
||||
]) =>
|
||||
runScoring(estimate, Score_Scalar(d), Some(prior), accessors.environment)
|
||||
runScoring(estimate, Score_Scalar(d), Some(prior), environment)
|
||||
| Error(e) => Error(e)
|
||||
| _ => Error(FunctionRegistry_Helpers.impossibleError)
|
||||
}
|
||||
|
@ -49,12 +49,12 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="logScore",
|
||||
~inputs=[FRTypeRecord([("estimate", FRTypeDist), ("answer", FRTypeDistOrNumber)])],
|
||||
~run=(_, inputs, accessors, _) => {
|
||||
~run=(_, inputs, environment, _) => {
|
||||
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs(inputs) {
|
||||
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueDist(d))]) =>
|
||||
runScoring(estimate, Score_Dist(d), None, accessors.environment)
|
||||
runScoring(estimate, Score_Dist(d), None, environment)
|
||||
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueNumber(d))]) =>
|
||||
runScoring(estimate, Score_Scalar(d), None, accessors.environment)
|
||||
runScoring(estimate, Score_Scalar(d), None, environment)
|
||||
| Error(e) => Error(e)
|
||||
| _ => Error(FunctionRegistry_Helpers.impossibleError)
|
||||
}
|
||||
|
@ -74,10 +74,10 @@ let library = [
|
|||
FnDefinition.make(
|
||||
~name="klDivergence",
|
||||
~inputs=[FRTypeDist, FRTypeDist],
|
||||
~run=(_, inputs, accessors, _) => {
|
||||
~run=(_, inputs, environment, _) => {
|
||||
switch inputs {
|
||||
| [FRValueDist(estimate), FRValueDist(d)] =>
|
||||
runScoring(estimate, Score_Dist(d), None, accessors.environment)
|
||||
runScoring(estimate, Score_Dist(d), None, environment)
|
||||
| _ => Error(FunctionRegistry_Helpers.impossibleError)
|
||||
}
|
||||
},
|
||||
|
|
|
@ -2,16 +2,86 @@
|
|||
// Other module operations such as import export will be preprocessed jobs
|
||||
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
open Reducer_ErrorValue
|
||||
open ReducerInterface_InternalExpressionValue
|
||||
module T = Reducer_T
|
||||
|
||||
let expressionValueToString = toString
|
||||
type t = Reducer_T.nameSpace
|
||||
type internalExpressionValue = Reducer_T.value
|
||||
|
||||
type t = ReducerInterface_InternalExpressionValue.nameSpace
|
||||
let rec get = (nameSpace: t, id: string) => {
|
||||
let T.NameSpace(container, parent) = nameSpace
|
||||
|
||||
let typeAliasesKey = "_typeAliases_"
|
||||
let typeReferencesKey = "_typeReferences_"
|
||||
switch container->Belt.MutableMap.String.get(id) {
|
||||
| Some(v) => Some(v)
|
||||
| None => switch parent {
|
||||
| Some(p) => get(p, id)
|
||||
| None => None
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
let getWithDefault = (nameSpace: t, id: string, default) =>
|
||||
switch get(nameSpace, id) {
|
||||
| Some(v) => Some(v)
|
||||
| None => default
|
||||
}
|
||||
|
||||
let toString = ReducerInterface_InternalExpressionValue.toStringNameSpace
|
||||
|
||||
let makeEmptyMap = () => Belt.MutableMap.String.make()
|
||||
|
||||
let set = (nameSpace: t, id: string, value): t => {
|
||||
let T.NameSpace(container, _) = nameSpace
|
||||
Belt.MutableMap.String.set(container, id, value)
|
||||
nameSpace
|
||||
}
|
||||
|
||||
let extend = (nameSpace: t) => T.NameSpace(
|
||||
makeEmptyMap(),
|
||||
nameSpace->Some
|
||||
)
|
||||
|
||||
let toKeyValuePairs = (T.NameSpace(container, _): t): array<(string, internalExpressionValue)> => {
|
||||
container->Belt.MutableMap.String.toArray
|
||||
}
|
||||
|
||||
|
||||
let makeEmptyBindings = (): t => T.NameSpace(makeEmptyMap(), None)
|
||||
|
||||
let toExpressionValue = (nameSpace: t): internalExpressionValue => T.IEvBindings(nameSpace)
|
||||
let fromExpressionValue = (aValue: internalExpressionValue): t =>
|
||||
switch aValue {
|
||||
| IEvBindings(nameSpace) => nameSpace
|
||||
| _ => makeEmptyBindings()
|
||||
}
|
||||
|
||||
let fromArray = a => T.NameSpace(Belt.MutableMap.String.fromArray(a), None)
|
||||
|
||||
let mergeFrom = (T.NameSpace(container, _): t, T.NameSpace(newContainer, parent): t): t => {
|
||||
NameSpace(
|
||||
newContainer->Belt.MutableMap.String.reduce(container, (container, key, value) => {
|
||||
if key != "__result__" {
|
||||
Belt.MutableMap.String.set(container, key, value)
|
||||
}
|
||||
container
|
||||
}),
|
||||
parent
|
||||
)
|
||||
}
|
||||
|
||||
let chainTo = (nameSpace: t, previousNameSpaces: array<t>) => {
|
||||
previousNameSpaces->Belt.Array.reduce(nameSpace, (topNameSpace, prevNameSpace) =>
|
||||
mergeFrom(prevNameSpace, topNameSpace)
|
||||
)
|
||||
}
|
||||
|
||||
let removeResult = (nameSpace: t): t => {
|
||||
let T.NameSpace(container, _) = nameSpace
|
||||
container->Belt.MutableMap.String.remove("__result__")
|
||||
nameSpace
|
||||
}
|
||||
|
||||
// let typeAliasesKey = "_typeAliases_"
|
||||
// let typeReferencesKey = "_typeReferences_"
|
||||
|
||||
// let getType = (NameSpace(container): t, id: string) => {
|
||||
// Belt.Map.String.get(container, typeAliasesKey)->Belt.Option.flatMap(aliases =>
|
||||
|
@ -31,27 +101,6 @@ let typeReferencesKey = "_typeReferences_"
|
|||
// )
|
||||
// }
|
||||
|
||||
let getWithDefault = (NameSpace(container): t, id: string, default) =>
|
||||
switch Belt.Map.String.get(container, id) {
|
||||
| Some(v) => v
|
||||
| None => default
|
||||
}
|
||||
|
||||
let get = (nameSpace: t, id: string) => {
|
||||
let NameSpace(container, parent) = nameSpace
|
||||
|
||||
switch container->Belt.MutableMap.String.get(key) {
|
||||
| Some(v) => Some(v)
|
||||
| None => switch parent {
|
||||
| Some(p) => nameSpaceGet(p, key)
|
||||
| None => None
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
let emptyMap: map = Belt.Map.String.empty
|
||||
|
||||
// let setTypeAlias = (NameSpace(container): t, id: string, value): t => {
|
||||
// let rValue = Belt.Map.String.getWithDefault(container, typeAliasesKey, IEvRecord(emptyMap))
|
||||
// let r = switch rValue {
|
||||
|
@ -72,126 +121,74 @@ let emptyMap: map = Belt.Map.String.empty
|
|||
// NameSpace(Belt.Map.String.set(container, typeReferencesKey, r2))
|
||||
// }
|
||||
|
||||
let set = (NameSpace(container): t, id: string, value): t => NameSpace(
|
||||
Belt.Map.String.set(container, id, value),
|
||||
)
|
||||
// let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => {
|
||||
// let keys = Belt.Map.String.keysToArray(otherContainer)
|
||||
// NameSpace(
|
||||
// Belt.Map.String.keep(container, (key, _value) => {
|
||||
// let removeThis = Js.Array2.includes(keys, key)
|
||||
// !removeThis
|
||||
// }),
|
||||
// )
|
||||
// }
|
||||
|
||||
let emptyModule: t = NameSpace(emptyMap)
|
||||
let emptyBindings = emptyModule
|
||||
let emptyNameSpace = emptyModule
|
||||
// external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
|
||||
|
||||
let toExpressionValue = (nameSpace: t): internalExpressionValue => IEvBindings(nameSpace)
|
||||
let fromExpressionValue = (aValue: internalExpressionValue): t =>
|
||||
switch aValue {
|
||||
| IEvBindings(nameSpace) => nameSpace
|
||||
| _ => emptyModule
|
||||
}
|
||||
// let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
|
||||
// IEvLambda({
|
||||
// parameters: [],
|
||||
// context: emptyModule,
|
||||
// body: FFI(ffiFn)->castExpressionToInternalCode,
|
||||
// })
|
||||
// }
|
||||
|
||||
let fromArray = a => NameSpace(Belt.Map.String.fromArray(a))
|
||||
// let functionNotFoundError = (call: functionCall) =>
|
||||
// REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
|
||||
|
||||
let mergeFrom = (NameSpace(container): t, NameSpace(newContainer): t): t => {
|
||||
NameSpace(
|
||||
newContainer->Belt.Map.String.reduce(container, (container, key, value) =>
|
||||
Belt.Map.String.set(container, key, value)
|
||||
),
|
||||
)
|
||||
}
|
||||
// let functionNotFoundErrorFFIFn = (functionName: string): ExpressionT.ffiFn => {
|
||||
// (args: array<internalExpressionValue>, _environment: environment): result<
|
||||
// internalExpressionValue,
|
||||
// errorValue,
|
||||
// > => {
|
||||
// let call = (functionName, args)
|
||||
// functionNotFoundError(call)
|
||||
// }
|
||||
// }
|
||||
|
||||
let removeOther = (NameSpace(container): t, NameSpace(otherContainer): t): t => {
|
||||
let keys = Belt.Map.String.keysToArray(otherContainer)
|
||||
NameSpace(
|
||||
Belt.Map.String.keep(container, (key, _value) => {
|
||||
let removeThis = Js.Array2.includes(keys, key)
|
||||
!removeThis
|
||||
}),
|
||||
)
|
||||
}
|
||||
// let convertOptionToFfiFnReturningResult = (
|
||||
// myFunctionName: string,
|
||||
// myFunction: ExpressionT.optionFfiFnReturningResult,
|
||||
// ): ExpressionT.ffiFn => {
|
||||
// (args: array<InternalExpressionValue.t>, environment) => {
|
||||
// myFunction(args, environment)->Belt.Option.getWithDefault(
|
||||
// functionNotFoundErrorFFIFn(myFunctionName)(args, environment),
|
||||
// )
|
||||
// }
|
||||
// }
|
||||
|
||||
external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
|
||||
|
||||
let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
|
||||
IEvLambda({
|
||||
parameters: [],
|
||||
context: emptyModule,
|
||||
body: FFI(ffiFn)->castExpressionToInternalCode,
|
||||
})
|
||||
}
|
||||
|
||||
let functionNotFoundError = (call: functionCall) =>
|
||||
REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
|
||||
|
||||
let functionNotFoundErrorFFIFn = (functionName: string): ExpressionT.ffiFn => {
|
||||
(args: array<internalExpressionValue>, _environment: environment): result<
|
||||
internalExpressionValue,
|
||||
errorValue,
|
||||
> => {
|
||||
let call = (functionName, args)
|
||||
functionNotFoundError(call)
|
||||
}
|
||||
}
|
||||
|
||||
let convertOptionToFfiFnReturningResult = (
|
||||
myFunctionName: string,
|
||||
myFunction: ExpressionT.optionFfiFnReturningResult,
|
||||
): ExpressionT.ffiFn => {
|
||||
(args: array<InternalExpressionValue.t>, environment) => {
|
||||
myFunction(args, environment)->Belt.Option.getWithDefault(
|
||||
functionNotFoundErrorFFIFn(myFunctionName)(args, environment),
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
let convertOptionToFfiFn = (
|
||||
myFunctionName: string,
|
||||
myFunction: ExpressionT.optionFfiFn,
|
||||
): ExpressionT.ffiFn => {
|
||||
(args: array<InternalExpressionValue.t>, environment) => {
|
||||
myFunction(args, environment)
|
||||
->Belt.Option.map(v => v->Ok)
|
||||
->Belt.Option.getWithDefault(functionNotFoundErrorFFIFn(myFunctionName)(args, environment))
|
||||
}
|
||||
}
|
||||
// let convertOptionToFfiFn = (
|
||||
// myFunctionName: string,
|
||||
// myFunction: ExpressionT.optionFfiFn,
|
||||
// ): ExpressionT.ffiFn => {
|
||||
// (args: array<InternalExpressionValue.t>, environment) => {
|
||||
// myFunction(args, environment)
|
||||
// ->Belt.Option.map(v => v->Ok)
|
||||
// ->Belt.Option.getWithDefault(functionNotFoundErrorFFIFn(myFunctionName)(args, environment))
|
||||
// }
|
||||
// }
|
||||
|
||||
// -- Module definition
|
||||
let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => {
|
||||
NameSpace(Belt.Map.String.set(container, identifier, ev))
|
||||
}
|
||||
// let define = (NameSpace(container): t, identifier: string, ev: internalExpressionValue): t => {
|
||||
// NameSpace(Belt.Map.String.set(container, identifier, ev))
|
||||
// }
|
||||
|
||||
let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
|
||||
nameSpace->define(identifier, IEvNumber(value))
|
||||
// let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
|
||||
// nameSpace->define(identifier, IEvNumber(value))
|
||||
|
||||
let defineString = (nameSpace: t, identifier: string, value: string): t =>
|
||||
nameSpace->define(identifier, IEvString(value))
|
||||
// let defineString = (nameSpace: t, identifier: string, value: string): t =>
|
||||
// nameSpace->define(identifier, IEvString(value))
|
||||
|
||||
let defineBool = (nameSpace: t, identifier: string, value: bool): t =>
|
||||
nameSpace->define(identifier, IEvBool(value))
|
||||
// let defineBool = (nameSpace: t, identifier: string, value: bool): t =>
|
||||
// nameSpace->define(identifier, IEvBool(value))
|
||||
|
||||
let defineModule = (nameSpace: t, identifier: string, value: t): t =>
|
||||
nameSpace->define(identifier, toExpressionValue(value))
|
||||
|
||||
let defineFunction = (nameSpace: t, identifier: string, value: ExpressionT.optionFfiFn): t => {
|
||||
nameSpace->define(identifier, convertOptionToFfiFn(identifier, value)->eLambdaFFIValue)
|
||||
}
|
||||
|
||||
let defineFunctionReturningResult = (
|
||||
nameSpace: t,
|
||||
identifier: string,
|
||||
value: ExpressionT.optionFfiFnReturningResult,
|
||||
): t => {
|
||||
nameSpace->define(
|
||||
identifier,
|
||||
convertOptionToFfiFnReturningResult(identifier, value)->eLambdaFFIValue,
|
||||
)
|
||||
}
|
||||
|
||||
let emptyStdLib: t = emptyModule->defineBool("_standardLibrary", true)
|
||||
|
||||
let chainTo = (nameSpace: t, previousNameSpaces: array<t>) => {
|
||||
previousNameSpaces->Belt.Array.reduce(nameSpace, (topNameSpace, prevNameSpace) =>
|
||||
mergeFrom(prevNameSpace, topNameSpace)
|
||||
)
|
||||
}
|
||||
|
||||
let removeResult = (NameSpace(container): t): t => {
|
||||
container->Belt.Map.String.remove("__result__")->NameSpace
|
||||
}
|
||||
// let defineModule = (nameSpace: t, identifier: string, value: t): t =>
|
||||
// nameSpace->define(identifier, toExpressionValue(value))
|
||||
|
|
|
@ -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
|
||||
)
|
|
@ -1,2 +0,0 @@
|
|||
module Builtin = Reducer_Dispatch_BuiltIn
|
||||
module BuiltinMacros = Reducer_Dispatch_BuiltInMacros
|
|
@ -1,16 +1,14 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module Continuation = ReducerInterface_Value_Continuation
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ExternalLibrary = ReducerInterface.ExternalLibrary
|
||||
module Lambda = Reducer_Expression_Lambda
|
||||
module MathJs = Reducer_MathJs
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module Result = Belt.Result
|
||||
module TypeBuilder = Reducer_Type_TypeBuilder
|
||||
|
||||
open ReducerInterface_InternalExpressionValue
|
||||
module IEV = ReducerInterface_InternalExpressionValue
|
||||
|
||||
open Reducer_ErrorValue
|
||||
|
||||
/*
|
||||
|
@ -24,42 +22,42 @@ open Reducer_ErrorValue
|
|||
exception TestRescriptException
|
||||
|
||||
let callInternal = (
|
||||
call: functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
call: IEV.functionCall,
|
||||
_: Reducer_T.environment,
|
||||
_: Reducer_T.reducerFn,
|
||||
): result<'b, errorValue> => {
|
||||
let callMathJs = (call: functionCall): result<'b, errorValue> =>
|
||||
let callMathJs = (call: IEV.functionCall): result<'b, errorValue> =>
|
||||
switch call {
|
||||
| ("javascriptraise", [msg]) => Js.Exn.raiseError(toString(msg)) // For Tests
|
||||
| ("javascriptraise", [msg]) => Js.Exn.raiseError(IEV.toString(msg)) // For Tests
|
||||
| ("rescriptraise", _) => raise(TestRescriptException) // For Tests
|
||||
| call => call->toStringFunctionCall->MathJs.Eval.eval
|
||||
| call => call->IEV.toStringFunctionCall->MathJs.Eval.eval
|
||||
}
|
||||
|
||||
let constructRecord = arrayOfPairs => {
|
||||
Belt.Array.map(arrayOfPairs, pairValue =>
|
||||
switch pairValue {
|
||||
| IEvArray([IEvString(key), valueValue]) => (key, valueValue)
|
||||
| _ => ("wrong key type", pairValue->toStringWithType->IEvString)
|
||||
| Reducer_T.IEvArray([IEvString(key), valueValue]) => (key, valueValue)
|
||||
| _ => ("wrong key type", pairValue->IEV.toStringWithType->IEvString)
|
||||
}
|
||||
)
|
||||
->Belt.Map.String.fromArray
|
||||
->IEvRecord
|
||||
->Reducer_T.IEvRecord
|
||||
->Ok
|
||||
}
|
||||
|
||||
let arrayAtIndex = (aValueArray: array<internalExpressionValue>, fIndex: float) =>
|
||||
let arrayAtIndex = (aValueArray: array<Reducer_T.value>, fIndex: float) =>
|
||||
switch Belt.Array.get(aValueArray, Belt.Int.fromFloat(fIndex)) {
|
||||
| Some(value) => value->Ok
|
||||
| None => REArrayIndexNotFound("Array index not found", Belt.Int.fromFloat(fIndex))->Error
|
||||
}
|
||||
|
||||
let moduleAtIndex = (nameSpace: nameSpace, sIndex) =>
|
||||
let moduleAtIndex = (nameSpace: Reducer_T.nameSpace, sIndex) =>
|
||||
switch Bindings.get(nameSpace, sIndex) {
|
||||
| Some(value) => value->Ok
|
||||
| None => RERecordPropertyNotFound("Bindings property not found", sIndex)->Error
|
||||
}
|
||||
|
||||
let recordAtIndex = (dict: Belt.Map.String.t<internalExpressionValue>, sIndex) =>
|
||||
let recordAtIndex = (dict: Belt.Map.String.t<Reducer_T.value>, sIndex) =>
|
||||
switch Belt.Map.String.get(dict, sIndex) {
|
||||
| Some(value) => value->Ok
|
||||
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
|
||||
|
@ -68,26 +66,26 @@ let callInternal = (
|
|||
let doAddArray = (originalA, b) => {
|
||||
let a = originalA->Js.Array2.copy
|
||||
let _ = Js.Array2.pushMany(a, b)
|
||||
a->IEvArray->Ok
|
||||
a->Reducer_T.IEvArray->Ok
|
||||
}
|
||||
let doAddString = (a, b) => {
|
||||
let answer = Js.String2.concat(a, b)
|
||||
answer->IEvString->Ok
|
||||
answer->Reducer_T.IEvString->Ok
|
||||
}
|
||||
|
||||
let inspect = (value: internalExpressionValue) => {
|
||||
Js.log(value->toString)
|
||||
let inspect = (value: Reducer_T.value) => {
|
||||
Js.log(value->IEV.toString)
|
||||
value->Ok
|
||||
}
|
||||
|
||||
let inspectLabel = (value: internalExpressionValue, label: string) => {
|
||||
Js.log(`${label}: ${value->toString}`)
|
||||
let inspectLabel = (value: Reducer_T.value, label: string) => {
|
||||
Js.log(`${label}: ${value->IEV.toString}`)
|
||||
value->Ok
|
||||
}
|
||||
|
||||
let doSetBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) => {
|
||||
Bindings.set(bindings, symbol, value)->IEvBindings->Ok
|
||||
}
|
||||
// let doSetBindings = (bindings: Reducer_T.nameSpace, symbol: string, value: Reducer_T.value) => {
|
||||
// Bindings.set(bindings, symbol, value)->IEvBindings->Ok
|
||||
// }
|
||||
|
||||
// let doSetTypeAliasBindings = (
|
||||
// bindings: nameSpace,
|
||||
|
@ -98,50 +96,15 @@ let callInternal = (
|
|||
// let doSetTypeOfBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) =>
|
||||
// Bindings.setTypeOf(bindings, symbol, value)->IEvBindings->Ok
|
||||
|
||||
let doExportBindings = (bindings: nameSpace) => bindings->Bindings.toExpressionValue->Ok
|
||||
// let doExportBindings = (bindings: nameSpace) => bindings->Bindings.toExpressionValue->Ok
|
||||
|
||||
let doIdentity = (value: internalExpressionValue) => value->Ok
|
||||
// let doIdentity = (value: Reducer_T.value) => value->Ok
|
||||
|
||||
let doDumpBindings = (continuation: nameSpace, value: internalExpressionValue) => {
|
||||
// let _ = Continuation.inspect(continuation, "doDumpBindings")
|
||||
accessors.states.continuation = continuation->Bindings.set("__result__", value)
|
||||
value->Ok
|
||||
}
|
||||
|
||||
module SampleMap = {
|
||||
let doLambdaCall = (aLambdaValue, list) =>
|
||||
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
|
||||
| IEvNumber(f) => Ok(f)
|
||||
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
|
||||
}
|
||||
|
||||
let toType = r =>
|
||||
switch r {
|
||||
| Ok(r) => Ok(IEvDistribution(SampleSet(r)))
|
||||
| Error(r) => Error(REDistributionError(SampleSetError(r)))
|
||||
}
|
||||
|
||||
let parseSampleSetArray = (arr: array<internalExpressionValue>): option<
|
||||
array<SampleSetDist.t>,
|
||||
> => {
|
||||
let parseSampleSet = (value: internalExpressionValue): option<SampleSetDist.t> =>
|
||||
switch value {
|
||||
| IEvDistribution(SampleSet(dist)) => Some(dist)
|
||||
| _ => None
|
||||
}
|
||||
E.A.O.openIfAllSome(E.A.fmap(parseSampleSet, arr))
|
||||
}
|
||||
|
||||
let _mapN = (aValueArray: array<internalExpressionValue>, aLambdaValue) => {
|
||||
switch parseSampleSetArray(aValueArray) {
|
||||
| Some(t1) =>
|
||||
let fn = a => doLambdaCall(aLambdaValue, list{IEvArray(E.A.fmap(x => IEvNumber(x), a))})
|
||||
SampleSetDist.mapN(~fn, ~t1)->toType
|
||||
| None =>
|
||||
Error(REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString))
|
||||
}
|
||||
}
|
||||
}
|
||||
// let doDumpBindings = (continuation: Reducer_T.nameSpace, value: Reducer_T.value) => {
|
||||
// // let _ = Continuation.inspect(continuation, "doDumpBindings")
|
||||
// accessors.states.continuation = continuation->Bindings.set("__result__", value)
|
||||
// value->Ok
|
||||
// }
|
||||
|
||||
switch call {
|
||||
| ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
|
||||
|
@ -149,15 +112,15 @@ let callInternal = (
|
|||
| ("$_atIndex_$", [IEvRecord(dict), IEvString(sIndex)]) => recordAtIndex(dict, sIndex)
|
||||
| ("$_constructArray_$", args) => IEvArray(args)->Ok
|
||||
| ("$_constructRecord_$", [IEvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs)
|
||||
| ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace)
|
||||
| ("$_exportBindings_$", [evValue]) => doIdentity(evValue)
|
||||
| ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
|
||||
doSetBindings(nameSpace, symbol, value)
|
||||
// | ("$_exportBindings_$", [IEvBindings(nameSpace)]) => doExportBindings(nameSpace)
|
||||
// | ("$_exportBindings_$", [evValue]) => doIdentity(evValue)
|
||||
// | ("$_setBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
|
||||
// doSetBindings(nameSpace, symbol, value)
|
||||
// | ("$_setTypeAliasBindings_$", [IEvBindings(nameSpace), IEvTypeIdentifier(symbol), value]) =>
|
||||
// doSetTypeAliasBindings(nameSpace, symbol, value)
|
||||
// | ("$_setTypeOfBindings_$", [IEvBindings(nameSpace), IEvSymbol(symbol), value]) =>
|
||||
// doSetTypeOfBindings(nameSpace, symbol, value)
|
||||
| ("$_dumpBindings_$", [IEvBindings(nameSpace), _, evValue]) => doDumpBindings(nameSpace, evValue)
|
||||
// | ("$_dumpBindings_$", [IEvBindings(nameSpace), _, evValue]) => doDumpBindings(nameSpace, evValue)
|
||||
// | ("$_typeModifier_memberOf_$", [IEvTypeIdentifier(typeIdentifier), IEvArray(arr)]) =>
|
||||
// TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
|
||||
// | ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) =>
|
||||
|
@ -191,31 +154,31 @@ let callInternal = (
|
|||
| (_, [IEvString(_), IEvString(_)]) =>
|
||||
callMathJs(call)
|
||||
| call =>
|
||||
Error(REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)) // Report full type signature as error
|
||||
Error(REFunctionNotFound(call->IEV.functionCallToCallSignature->IEV.functionCallSignatureToString)) // Report full type signature as error
|
||||
}
|
||||
}
|
||||
/*
|
||||
Reducer uses Result monad while reducing expressions
|
||||
*/
|
||||
let dispatch = (
|
||||
call: functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
): internalExpressionValue =>
|
||||
call: IEV.functionCall,
|
||||
env: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
): Reducer_T.value =>
|
||||
try {
|
||||
let (fn, args) = call
|
||||
if fn->Js.String2.startsWith("$") {
|
||||
switch callInternal((fn, args), accessors, reducer) {
|
||||
switch callInternal((fn, args), env, reducer) {
|
||||
| Ok(v) => v
|
||||
| Error(e) => raise(ErrorException(e))
|
||||
}
|
||||
} else {
|
||||
// There is a bug that prevents string match in patterns
|
||||
// So we have to recreate a copy of the string
|
||||
switch ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) {
|
||||
| Ok(v) => v
|
||||
| Error(e) => raise(ErrorException(e))
|
||||
}
|
||||
switch ExternalLibrary.dispatch((Js.String.make(fn), args), env, reducer, callInternal) {
|
||||
| Ok(v) => v
|
||||
| Error(e) => raise(ErrorException(e))
|
||||
}
|
||||
}
|
||||
} catch {
|
||||
| ErrorException(e) => raise(ErrorException(e))
|
||||
|
|
|
@ -1,190 +1,189 @@
|
|||
/*
|
||||
Macros are like functions but instead of taking values as parameters,
|
||||
they take expressions as parameters and return a new expression.
|
||||
Macros are used to define language building blocks. They are like Lisp macros.
|
||||
*/
|
||||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
// /*
|
||||
// Macros are like functions but instead of taking values as parameters,
|
||||
// they take expressions as parameters and return a new expression.
|
||||
// Macros are used to define language building blocks. They are like Lisp macros.
|
||||
// */
|
||||
// module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
|
||||
open Reducer_Expression_ExpressionBuilder
|
||||
// open Reducer_Expression_ExpressionBuilder
|
||||
|
||||
exception ErrorException = ErrorValue.ErrorException
|
||||
type expression = ExpressionT.expression
|
||||
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||
// exception ErrorException = ErrorValue.ErrorException
|
||||
// type expression = ExpressionT.expression
|
||||
// type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||
|
||||
let dispatchMacroCall = (
|
||||
macroExpression: expression,
|
||||
bindings: ExpressionT.bindings,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reduceExpression: ProjectReducerFnT.t,
|
||||
): expressionWithContext => {
|
||||
let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
|
||||
let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
|
||||
// let dispatchMacroCall = (
|
||||
// macroExpression: expression,
|
||||
// bindings: ExpressionT.bindings,
|
||||
// accessors: ProjectAccessorsT.t,
|
||||
// reduceExpression: ProjectReducerFnT.t,
|
||||
// ): expressionWithContext => {
|
||||
// let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
|
||||
// let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
|
||||
|
||||
let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
|
||||
// let newBindings = Reducer_Bindings.fromExpressionValue(nameSpaceValue)
|
||||
|
||||
let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
|
||||
// let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
|
||||
|
||||
ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
|
||||
}
|
||||
// ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
|
||||
// }
|
||||
|
||||
let correspondingSetBindingsFn = (fnName: string): string =>
|
||||
switch fnName {
|
||||
| "$_let_$" => "$_setBindings_$"
|
||||
| "$_typeOf_$" => "$_setTypeOfBindings_$"
|
||||
| "$_typeAlias_$" => "$_setTypeAliasBindings_$"
|
||||
| "$_endOfOuterBlock_$" => "$_dumpBindings_$"
|
||||
| _ => ""
|
||||
}
|
||||
// let correspondingSetBindingsFn = (fnName: string): string =>
|
||||
// switch fnName {
|
||||
// | "$_let_$" => "$_setBindings_$"
|
||||
// | "$_typeOf_$" => "$_setTypeOfBindings_$"
|
||||
// | "$_typeAlias_$" => "$_setTypeAliasBindings_$"
|
||||
// | "$_endOfOuterBlock_$" => "$_dumpBindings_$"
|
||||
// | _ => ""
|
||||
// }
|
||||
|
||||
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
|
||||
let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException
|
||||
switch statement {
|
||||
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), ExpressionT.EValue(IEvSymbol(symbolExpr)), statement}) => {
|
||||
let setBindingsFn = correspondingSetBindingsFn(callName)
|
||||
if setBindingsFn !== "" {
|
||||
useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
newBindingsExpr,
|
||||
boundStatement,
|
||||
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr->IEvSymbol->ExpressionT.EValue, boundStatement}))
|
||||
} else {
|
||||
raise(defaultStatement)
|
||||
}
|
||||
}
|
||||
| _ => raise(defaultStatement)
|
||||
}
|
||||
}
|
||||
// let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
|
||||
// let defaultStatement = ErrorValue.REAssignmentExpected->ErrorException
|
||||
// switch statement {
|
||||
// | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), ExpressionT.EValue(IEvSymbol(symbolExpr)), statement}) => {
|
||||
// let setBindingsFn = correspondingSetBindingsFn(callName)
|
||||
// if setBindingsFn !== "" {
|
||||
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
// newBindingsExpr,
|
||||
// boundStatement,
|
||||
// ) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr->IEvSymbol->ExpressionT.EValue, boundStatement}))
|
||||
// } else {
|
||||
// raise(defaultStatement)
|
||||
// }
|
||||
// }
|
||||
// | _ => raise(defaultStatement)
|
||||
// }
|
||||
// }
|
||||
|
||||
let doBindExpression = (
|
||||
bindingExpr: expression,
|
||||
statement: expression,
|
||||
accessors,
|
||||
): expressionWithContext => {
|
||||
let defaultStatement = () =>
|
||||
useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
_newBindingsExpr,
|
||||
boundStatement,
|
||||
) => boundStatement)
|
||||
// let doBindExpression = (
|
||||
// bindingExpr: expression,
|
||||
// statement: expression,
|
||||
// accessors,
|
||||
// ): expressionWithContext => {
|
||||
// let defaultStatement = () =>
|
||||
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
// _newBindingsExpr,
|
||||
// boundStatement,
|
||||
// ) => boundStatement)
|
||||
|
||||
switch statement {
|
||||
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
|
||||
let setBindingsFn = correspondingSetBindingsFn(callName)
|
||||
if setBindingsFn !== "" {
|
||||
useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
newBindingsExpr,
|
||||
boundStatement,
|
||||
) =>
|
||||
eFunction(
|
||||
"$_exportBindings_$",
|
||||
list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})}, // expression returning bindings
|
||||
)
|
||||
)
|
||||
} else {
|
||||
defaultStatement()
|
||||
}
|
||||
}
|
||||
| _ => defaultStatement()
|
||||
}
|
||||
}
|
||||
// switch statement {
|
||||
// | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
|
||||
// let setBindingsFn = correspondingSetBindingsFn(callName)
|
||||
// if setBindingsFn !== "" {
|
||||
// useExpressionToSetBindings(bindingExpr, accessors, statement, (
|
||||
// newBindingsExpr,
|
||||
// boundStatement,
|
||||
// ) =>
|
||||
// eFunction(
|
||||
// "$_exportBindings_$",
|
||||
// list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})}, // expression returning bindings
|
||||
// )
|
||||
// )
|
||||
// } else {
|
||||
// defaultStatement()
|
||||
// }
|
||||
// }
|
||||
// | _ => defaultStatement()
|
||||
// }
|
||||
// }
|
||||
|
||||
let doBlock = (
|
||||
exprs: list<expression>,
|
||||
_bindings: ExpressionT.bindings,
|
||||
_accessors,
|
||||
): expressionWithContext => {
|
||||
let exprsArray = Belt.List.toArray(exprs)
|
||||
let maxIndex = Js.Array2.length(exprsArray) - 1
|
||||
let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) =>
|
||||
if index == 0 {
|
||||
if index == maxIndex {
|
||||
eBindExpressionDefault(statement)
|
||||
} else {
|
||||
eBindStatementDefault(statement)
|
||||
}
|
||||
} else if index == maxIndex {
|
||||
eBindExpression(acc, statement)
|
||||
} else {
|
||||
eBindStatement(acc, statement)
|
||||
}
|
||||
, eSymbol("undefined block"))
|
||||
ExpressionWithContext.noContext(newStatement)
|
||||
}
|
||||
// let doBlock = (
|
||||
// exprs: list<expression>,
|
||||
// _bindings: ExpressionT.bindings,
|
||||
// _accessors,
|
||||
// ): expressionWithContext => {
|
||||
// let exprsArray = Belt.List.toArray(exprs)
|
||||
// let maxIndex = Js.Array2.length(exprsArray) - 1
|
||||
// let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) =>
|
||||
// if index == 0 {
|
||||
// if index == maxIndex {
|
||||
// eBindExpressionDefault(statement)
|
||||
// } else {
|
||||
// eBindStatementDefault(statement)
|
||||
// }
|
||||
// } else if index == maxIndex {
|
||||
// eBindExpression(acc, statement)
|
||||
// } else {
|
||||
// eBindStatement(acc, statement)
|
||||
// }
|
||||
// , eSymbol("undefined block"))
|
||||
// ExpressionWithContext.noContext(newStatement)
|
||||
// }
|
||||
|
||||
let doLambdaDefinition = (
|
||||
bindings: ExpressionT.bindings,
|
||||
parameters: array<string>,
|
||||
lambdaDefinition: ExpressionT.expression,
|
||||
) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
|
||||
// let doLambdaDefinition = (
|
||||
// bindings: ExpressionT.bindings,
|
||||
// parameters: array<string>,
|
||||
// lambdaDefinition: ExpressionT.expression,
|
||||
// ) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
|
||||
|
||||
let doTernary = (
|
||||
condition: expression,
|
||||
ifTrue: expression,
|
||||
ifFalse: expression,
|
||||
bindings: ExpressionT.bindings,
|
||||
accessors,
|
||||
): expressionWithContext => {
|
||||
let blockCondition = ExpressionBuilder.eBlock(list{condition})
|
||||
let conditionValue = reduceExpression(blockCondition, bindings, accessors)
|
||||
// let doTernary = (
|
||||
// condition: expression,
|
||||
// ifTrue: expression,
|
||||
// ifFalse: expression,
|
||||
// bindings: ExpressionT.bindings,
|
||||
// accessors,
|
||||
// ): expressionWithContext => {
|
||||
// let blockCondition = ExpressionBuilder.eBlock(list{condition})
|
||||
// let conditionValue = reduceExpression(blockCondition, bindings, accessors)
|
||||
|
||||
switch conditionValue {
|
||||
| InternalExpressionValue.IEvBool(false) => {
|
||||
let ifFalseBlock = eBlock(list{ifFalse})
|
||||
ExpressionWithContext.withContext(ifFalseBlock, bindings)
|
||||
}
|
||||
| InternalExpressionValue.IEvBool(true) => {
|
||||
let ifTrueBlock = eBlock(list{ifTrue})
|
||||
ExpressionWithContext.withContext(ifTrueBlock, bindings)
|
||||
}
|
||||
| _ => raise(ErrorException(REExpectedType("Boolean", "")))
|
||||
}
|
||||
}
|
||||
// switch conditionValue {
|
||||
// | InternalExpressionValue.IEvBool(false) => {
|
||||
// let ifFalseBlock = eBlock(list{ifFalse})
|
||||
// ExpressionWithContext.withContext(ifFalseBlock, bindings)
|
||||
// }
|
||||
// | InternalExpressionValue.IEvBool(true) => {
|
||||
// let ifTrueBlock = eBlock(list{ifTrue})
|
||||
// ExpressionWithContext.withContext(ifTrueBlock, bindings)
|
||||
// }
|
||||
// | _ => raise(ErrorException(REExpectedType("Boolean", "")))
|
||||
// }
|
||||
// }
|
||||
|
||||
let expandExpressionList = (
|
||||
aList,
|
||||
bindings: ExpressionT.bindings,
|
||||
accessors,
|
||||
): expressionWithContext =>
|
||||
switch aList {
|
||||
| list{
|
||||
ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
|
||||
bindingExpr: ExpressionT.expression,
|
||||
statement,
|
||||
} =>
|
||||
doBindStatement(bindingExpr, statement, accessors)
|
||||
| list{ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), statement} =>
|
||||
// bindings of the context are used when there is no binding expression
|
||||
doBindStatement(eModule(bindings), statement, accessors)
|
||||
| list{
|
||||
ExpressionT.EValue(IEvCall("$$_bindExpression_$$")),
|
||||
bindingExpr: ExpressionT.expression,
|
||||
expression,
|
||||
} =>
|
||||
doBindExpression(bindingExpr, expression, accessors)
|
||||
| list{ExpressionT.EValue(IEvCall("$$_bindExpression_$$")), expression} =>
|
||||
// bindings of the context are used when there is no binding expression
|
||||
doBindExpression(eModule(bindings), expression, accessors)
|
||||
| list{ExpressionT.EValue(IEvCall("$$_block_$$")), ...exprs} =>
|
||||
doBlock(exprs, bindings, accessors)
|
||||
| list{
|
||||
ExpressionT.EValue(IEvCall("$$_lambda_$$")),
|
||||
ExpressionT.EValue(IEvArrayString(parameters)),
|
||||
lambdaDefinition,
|
||||
} =>
|
||||
doLambdaDefinition(bindings, parameters, lambdaDefinition)
|
||||
| list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
|
||||
doTernary(condition, ifTrue, ifFalse, bindings, accessors)
|
||||
| _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
|
||||
}
|
||||
// let expandExpressionList = (
|
||||
// aList,
|
||||
// bindings: ExpressionT.bindings,
|
||||
// accessors,
|
||||
// ): expressionWithContext =>
|
||||
// switch aList {
|
||||
// | list{
|
||||
// ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
|
||||
// bindingExpr: ExpressionT.expression,
|
||||
// statement,
|
||||
// } =>
|
||||
// doBindStatement(bindingExpr, statement, accessors)
|
||||
// | list{ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), statement} =>
|
||||
// // bindings of the context are used when there is no binding expression
|
||||
// doBindStatement(eModule(bindings), statement, accessors)
|
||||
// | list{
|
||||
// ExpressionT.EValue(IEvCall("$$_bindExpression_$$")),
|
||||
// bindingExpr: ExpressionT.expression,
|
||||
// expression,
|
||||
// } =>
|
||||
// doBindExpression(bindingExpr, expression, accessors)
|
||||
// | list{ExpressionT.EValue(IEvCall("$$_bindExpression_$$")), expression} =>
|
||||
// // bindings of the context are used when there is no binding expression
|
||||
// doBindExpression(eModule(bindings), expression, accessors)
|
||||
// | list{ExpressionT.EValue(IEvCall("$$_block_$$")), ...exprs} =>
|
||||
// doBlock(exprs, bindings, accessors)
|
||||
// | list{
|
||||
// ExpressionT.EValue(IEvCall("$$_lambda_$$")),
|
||||
// ExpressionT.EValue(IEvArrayString(parameters)),
|
||||
// lambdaDefinition,
|
||||
// } =>
|
||||
// doLambdaDefinition(bindings, parameters, lambdaDefinition)
|
||||
// | list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
|
||||
// doTernary(condition, ifTrue, ifFalse, bindings, accessors)
|
||||
// | _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
|
||||
// }
|
||||
|
||||
switch macroExpression {
|
||||
| EList(aList) => expandExpressionList(aList, bindings, accessors)
|
||||
| _ => ExpressionWithContext.noContext(macroExpression)
|
||||
}
|
||||
}
|
||||
// switch macroExpression {
|
||||
// | EList(aList) => expandExpressionList(aList, bindings, accessors)
|
||||
// | _ => ExpressionWithContext.noContext(macroExpression)
|
||||
// }
|
||||
// }
|
||||
|
|
|
@ -1,23 +1,23 @@
|
|||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module T = Reducer_Dispatch_T
|
||||
module TypeChecker = Reducer_Type_TypeChecker
|
||||
open ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module T = Reducer_Dispatch_T
|
||||
// module TypeChecker = Reducer_Type_TypeChecker
|
||||
// open ReducerInterface_InternalExpressionValue
|
||||
|
||||
type errorValue = Reducer_ErrorValue.errorValue
|
||||
// type errorValue = Reducer_ErrorValue.errorValue
|
||||
|
||||
let makeFromTypes = jumpTable => {
|
||||
let dispatchChainPiece: T.dispatchChainPiece = (
|
||||
(fnName, fnArgs): functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
) => {
|
||||
let jumpTableEntry = jumpTable->Js.Array2.find(elem => {
|
||||
let (candidName, candidType, _) = elem
|
||||
candidName == fnName && TypeChecker.checkITypeArgumentsBool(candidType, fnArgs)
|
||||
})
|
||||
switch jumpTableEntry {
|
||||
| Some((_, _, bridgeFn)) => bridgeFn(fnArgs, accessors)->Some
|
||||
| _ => None
|
||||
}
|
||||
}
|
||||
dispatchChainPiece
|
||||
}
|
||||
// let makeFromTypes = jumpTable => {
|
||||
// let dispatchChainPiece: T.dispatchChainPiece = (
|
||||
// (fnName, fnArgs): functionCall,
|
||||
// accessors: ProjectAccessorsT.t,
|
||||
// ) => {
|
||||
// let jumpTableEntry = jumpTable->Js.Array2.find(elem => {
|
||||
// let (candidName, candidType, _) = elem
|
||||
// candidName == fnName && TypeChecker.checkITypeArgumentsBool(candidType, fnArgs)
|
||||
// })
|
||||
// switch jumpTableEntry {
|
||||
// | Some((_, _, bridgeFn)) => bridgeFn(fnArgs, accessors)->Some
|
||||
// | _ => None
|
||||
// }
|
||||
// }
|
||||
// dispatchChainPiece
|
||||
// }
|
||||
|
|
|
@ -1,22 +1,21 @@
|
|||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
|
||||
// Each piece of the dispatch chain computes the result or returns None so that the chain can continue
|
||||
type dispatchChainPiece = (
|
||||
InternalExpressionValue.functionCall,
|
||||
ProjectAccessorsT.t,
|
||||
) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
|
||||
// // Each piece of the dispatch chain computes the result or returns None so that the chain can continue
|
||||
// type dispatchChainPiece = (
|
||||
// InternalExpressionValue.functionCall,
|
||||
// ProjectAccessorsT.t,
|
||||
// ) => option<result<Reducer_T.value, Reducer_ErrorValue.errorValue>>
|
||||
|
||||
type dispatchChainPieceWithReducer = (
|
||||
InternalExpressionValue.functionCall,
|
||||
ProjectAccessorsT.t,
|
||||
ProjectReducerFnT.t,
|
||||
) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
|
||||
// type dispatchChainPieceWithReducer = (
|
||||
// InternalExpressionValue.functionCall,
|
||||
// ProjectAccessorsT.t,
|
||||
// Reducer_T.reducerFn,
|
||||
// ) => option<result<Reducer_T.value, Reducer_ErrorValue.errorValue>>
|
||||
|
||||
// This is a switch statement case implementation: get the arguments and compute the result
|
||||
type genericIEvFunction = (
|
||||
array<InternalExpressionValue.t>,
|
||||
ProjectAccessorsT.t,
|
||||
) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>
|
||||
// // This is a switch statement case implementation: get the arguments and compute the result
|
||||
// type genericIEvFunction = (
|
||||
// array<Reducer_T.value>,
|
||||
// ProjectAccessorsT.t,
|
||||
// ) => result<Reducer_T.value, Reducer_ErrorValue.errorValue>
|
||||
|
|
|
@ -1,119 +1,100 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module BuiltIn = Reducer_Dispatch_BuiltIn
|
||||
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
|
||||
module Extra = Reducer_Extra
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Lambda = Reducer_Expression_Lambda
|
||||
module Macro = Reducer_Expression_Macro
|
||||
module MathJs = Reducer_MathJs
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module Result = Belt.Result
|
||||
module T = Reducer_Expression_T
|
||||
module T = Reducer_T
|
||||
|
||||
type errorValue = Reducer_ErrorValue.errorValue
|
||||
type t = T.t
|
||||
|
||||
exception ErrorException = Reducer_ErrorValue.ErrorException
|
||||
|
||||
/*
|
||||
Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus)
|
||||
Recursively evaluate the expression
|
||||
*/
|
||||
let rec evaluate = (
|
||||
expression: t,
|
||||
bindings: T.bindings,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
): InternalExpressionValue.t => {
|
||||
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
|
||||
// Js.log(`reduce: ${T.toString(expression)}`)
|
||||
let rec evaluate: T.reducerFn = (
|
||||
expression,
|
||||
context
|
||||
) => {
|
||||
Js.log(`reduce: ${expression->Reducer_Expression_T.toString}`)
|
||||
switch expression {
|
||||
| T.Eblock(statements) => {
|
||||
statements->Js.Array2.reduce(statement => evaluate(statement, bindings, accessors))
|
||||
| T.EBlock(statements) => {
|
||||
let innerContext = {...context, bindings: context.bindings->Bindings.extend}
|
||||
statements->Js.Array2.reduce(
|
||||
(acc, statement) => statement->evaluate(innerContext),
|
||||
T.IEvVoid
|
||||
)
|
||||
}
|
||||
| T.ESymbol(name) => bindings->nameSpaceGet(name)
|
||||
| T.EValue(value) => value
|
||||
|
||||
| T.EProgram(statements) => {
|
||||
Js.log(`bindings: ${context.bindings->Reducer_Bindings.toString}`)
|
||||
let res = statements->Js.Array2.reduce(
|
||||
(acc, statement) => statement->evaluate(context),
|
||||
T.IEvVoid
|
||||
)
|
||||
Js.log(`bindings after: ${context.bindings->Reducer_Bindings.toString}`)
|
||||
res
|
||||
}
|
||||
|
||||
| T.EArray(elements) =>
|
||||
elements->Js.Array2.map(element => evaluate(element, context))->T.IEvArray
|
||||
|
||||
| T.ERecord(map) =>
|
||||
RETodo("TODO")->ErrorException->raise
|
||||
|
||||
| T.EAssign(left, right) => {
|
||||
let result = right->evaluate(context)
|
||||
let _ = context.bindings->Bindings.set(left, result)
|
||||
T.IEvVoid
|
||||
}
|
||||
|
||||
| T.ESymbol(name) =>
|
||||
switch context.bindings->Bindings.get(name) {
|
||||
| Some(v) => v
|
||||
| None => Reducer_ErrorValue.RESymbolNotFound(name)->ErrorException->raise
|
||||
}
|
||||
|
||||
| T.EValue(value) =>
|
||||
value
|
||||
|
||||
| T.ETernary(predicate, trueCase, falseCase) => {
|
||||
let predicateResult = evaluate(predicate, bindings, accessors)
|
||||
let predicateResult = predicate->evaluate(context)
|
||||
switch predicateResult {
|
||||
| InternalExpressionValue.IEvBool(false) =>
|
||||
evaluate(false, bindings, accessors)
|
||||
| InternalExpressionValue.IEvBool(true) =>
|
||||
evaluate(trueCase, bindings, accessors)
|
||||
| T.IEvBool(value) =>
|
||||
(value ? trueCase : falseCase)->evaluate(context)
|
||||
| _ => REExpectedType("Boolean", "")->ErrorException->raise
|
||||
}
|
||||
}
|
||||
| T.ELambda(parameteres, expr) => {
|
||||
BInternalExpressionValue.IEvLambda({
|
||||
parameters: parameters,
|
||||
context: context,
|
||||
body: NotFFI(expr)->BBindings.castExpressionToInternalCode,
|
||||
})->T.EValue
|
||||
}
|
||||
|
||||
| T.ELambda(parameters, body) =>
|
||||
Lambda.makeLambda(parameters, context.bindings, body)->T.IEvLambda
|
||||
|
||||
| T.ECall(fn, args) => {
|
||||
let func = evaluate(fn, bindings, accessors)
|
||||
"TODO"
|
||||
// Lambda.doLambdaCall(), etc.
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
After reducing each level of expression(Lisp AST), we have a value list to evaluate
|
||||
*/
|
||||
and reduceValueList = (
|
||||
valueList: list<InternalExpressionValue.t>,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
): InternalExpressionValue.t =>
|
||||
switch valueList {
|
||||
| list{IEvCall(fName), ...args} => {
|
||||
let checkedArgs = switch fName {
|
||||
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args
|
||||
| _ => args->Lambda.checkIfReduced
|
||||
let lambda = fn->evaluate(context)
|
||||
let argValues = Js.Array2.map(args, arg => arg->evaluate(context))
|
||||
switch lambda {
|
||||
| T.IEvLambda(lambda) =>
|
||||
Lambda.doLambdaCall(lambda, argValues, context.environment, evaluate)
|
||||
| _ => REExpectedType("Lambda", "")->ErrorException->raise
|
||||
}
|
||||
|
||||
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
|
||||
accessors,
|
||||
reduceExpressionInProject,
|
||||
)
|
||||
}
|
||||
| list{IEvLambda(_)} =>
|
||||
// TODO: remove on solving issue#558
|
||||
valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
|
||||
| list{IEvLambda(lambdaCall), ...args} =>
|
||||
args
|
||||
->Lambda.checkIfReduced
|
||||
->Lambda.doLambdaCall(lambdaCall, _, accessors, reduceExpressionInProject)
|
||||
| _ => valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
|
||||
}
|
||||
|
||||
let reduceExpressionInProject = evaluate
|
||||
|
||||
let reduceReturningBindings = (
|
||||
expression: t,
|
||||
continuation: T.bindings,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
): (InternalExpressionValue.t, T.bindings) => {
|
||||
let states = accessors.states
|
||||
let result = reduceExpressionInProject(expression, continuation, accessors)
|
||||
(result, states.continuation)
|
||||
}
|
||||
|
||||
module BackCompatible = {
|
||||
// Those methods are used to support the existing tests
|
||||
// If they are used outside limited testing context, error location reporting will fail
|
||||
let parse = (peggyCode: string): result<t, errorValue> =>
|
||||
let parse = (peggyCode: string): result<Reducer_T.expression, errorValue> =>
|
||||
peggyCode->Reducer_Peggy_Parse.parse->Result.map(Reducer_Peggy_ToExpression.fromNode)
|
||||
|
||||
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => {
|
||||
let accessors = ProjectAccessorsT.identityAccessors
|
||||
let evaluate = (expression: Reducer_T.expression): result<Reducer_T.value, errorValue> => {
|
||||
let context = Reducer_Context.createDefaultContext()
|
||||
try {
|
||||
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
|
||||
expression->evaluate(context)->Ok
|
||||
} catch {
|
||||
| ErrorException(e) => Error(e)
|
||||
| _ => raise(ErrorException(RETodo("internal exception")))
|
||||
}
|
||||
}
|
||||
|
||||
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>
|
||||
let evaluateString = (peggyCode: string): result<Reducer_T.value, errorValue> =>
|
||||
parse(peggyCode)->Result.flatMap(evaluate)
|
||||
}
|
||||
|
|
|
@ -1,53 +1,50 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module Result = Belt.Result
|
||||
// module Bindings = Reducer_Bindings
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module Result = Belt.Result
|
||||
|
||||
type bindings = ExpressionT.bindings
|
||||
type context = bindings
|
||||
type environment = InternalExpressionValue.environment
|
||||
type errorValue = Reducer_ErrorValue.errorValue
|
||||
type expression = ExpressionT.expression
|
||||
type internalExpressionValue = InternalExpressionValue.t
|
||||
// type bindings = Reducer_T.nameSpace
|
||||
// type context = bindings
|
||||
// type environment = InternalExpressionValue.environment
|
||||
// type errorValue = Reducer_ErrorValue.errorValue
|
||||
// type expression = ExpressionT.expression
|
||||
|
||||
type expressionWithContext =
|
||||
| ExpressionWithContext(expression, context)
|
||||
| ExpressionNoContext(expression)
|
||||
// type expressionWithContext =
|
||||
// | ExpressionWithContext(expression, context)
|
||||
// | ExpressionNoContext(expression)
|
||||
|
||||
let callReducer = (
|
||||
expressionWithContext: expressionWithContext,
|
||||
bindings: bindings,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
): internalExpressionValue => {
|
||||
switch expressionWithContext {
|
||||
| ExpressionNoContext(expr) =>
|
||||
// Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
|
||||
reducer(expr, bindings, accessors)
|
||||
| ExpressionWithContext(expr, context) =>
|
||||
// Js.log(`callReducer: context ${Bindings.toString(context)} expr ${ExpressionT.toString(expr)}`)
|
||||
reducer(expr, context, accessors)
|
||||
}
|
||||
}
|
||||
// let callReducer = (
|
||||
// expressionWithContext: expressionWithContext,
|
||||
// bindings: bindings,
|
||||
// accessors: ProjectAccessorsT.t,
|
||||
// reducer: Reducer_T.reducerFn,
|
||||
// ): Reducer_T.value => {
|
||||
// switch expressionWithContext {
|
||||
// | ExpressionNoContext(expr) =>
|
||||
// // Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
|
||||
// reducer(expr, bindings, accessors)
|
||||
// | ExpressionWithContext(expr, context) =>
|
||||
// // Js.log(`callReducer: context ${Bindings.toString(context)} expr ${ExpressionT.toString(expr)}`)
|
||||
// reducer(expr, context, accessors)
|
||||
// }
|
||||
// }
|
||||
|
||||
let withContext = (expression, context) => ExpressionWithContext(expression, context)
|
||||
let noContext = expression => ExpressionNoContext(expression)
|
||||
// let withContext = (expression, context) => ExpressionWithContext(expression, context)
|
||||
// let noContext = expression => ExpressionNoContext(expression)
|
||||
|
||||
let toString = expressionWithContext =>
|
||||
switch expressionWithContext {
|
||||
| ExpressionNoContext(expr) => ExpressionT.toString(expr)
|
||||
| ExpressionWithContext(expr, context) =>
|
||||
`${ExpressionT.toString(expr)} context: ${context
|
||||
->Bindings.toExpressionValue
|
||||
->InternalExpressionValue.toString}`
|
||||
}
|
||||
// let toString = expressionWithContext =>
|
||||
// switch expressionWithContext {
|
||||
// | ExpressionNoContext(expr) => ExpressionT.toString(expr)
|
||||
// | ExpressionWithContext(expr, context) =>
|
||||
// `${ExpressionT.toString(expr)} context: ${context
|
||||
// ->Bindings.toExpressionValue
|
||||
// ->InternalExpressionValue.toString}`
|
||||
// }
|
||||
|
||||
let toStringResult = rExpressionWithContext =>
|
||||
switch rExpressionWithContext {
|
||||
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
|
||||
| Error(errorValue) => ErrorValue.errorToString(errorValue)
|
||||
}
|
||||
// let toStringResult = rExpressionWithContext =>
|
||||
// switch rExpressionWithContext {
|
||||
// | Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
|
||||
// | Error(errorValue) => ErrorValue.errorToString(errorValue)
|
||||
// }
|
||||
|
|
|
@ -1,49 +1,49 @@
|
|||
module ErrorValue = Reducer_ErrorValue
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Bindings = Reducer_Bindings
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module Bindings = Reducer_Bindings
|
||||
|
||||
type errorValue = Reducer_ErrorValue.errorValue
|
||||
type expression = ExpressionT.expression
|
||||
type internalExpressionValue = InternalExpressionValue.t
|
||||
// type errorValue = Reducer_ErrorValue.errorValue
|
||||
// type expression = ExpressionT.expression
|
||||
// type internalExpressionValue = InternalExpressionValue.t
|
||||
|
||||
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||
// let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||
|
||||
let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression =>
|
||||
switch expression {
|
||||
| ExpressionT.EValue(value) => replaceSymbolOnValue(bindings, value)->ExpressionT.EValue
|
||||
| ExpressionT.EList(list) =>
|
||||
switch list {
|
||||
| list{EValue(IEvCall(fName)), ..._args} =>
|
||||
switch isMacroName(fName) {
|
||||
// A macro reduces itself so we dont dive in it
|
||||
| true => expression
|
||||
| false => replaceSymbolsOnExpressionList(bindings, list)
|
||||
}
|
||||
| _ => replaceSymbolsOnExpressionList(bindings, list)
|
||||
}
|
||||
}
|
||||
// let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression =>
|
||||
// switch expression {
|
||||
// | ExpressionT.EValue(value) => replaceSymbolOnValue(bindings, value)->ExpressionT.EValue
|
||||
// | ExpressionT.EList(list) =>
|
||||
// switch list {
|
||||
// | list{EValue(IEvCall(fName)), ..._args} =>
|
||||
// switch isMacroName(fName) {
|
||||
// // A macro reduces itself so we dont dive in it
|
||||
// | true => expression
|
||||
// | false => replaceSymbolsOnExpressionList(bindings, list)
|
||||
// }
|
||||
// | _ => replaceSymbolsOnExpressionList(bindings, list)
|
||||
// }
|
||||
// }
|
||||
|
||||
and replaceSymbolsOnExpressionList = (bindings, list) => {
|
||||
let racc =
|
||||
list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
|
||||
replaceSymbols(bindings, each)->Belt.List.add(acc, _)
|
||||
)
|
||||
ExpressionT.EList(racc)
|
||||
}
|
||||
and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
|
||||
switch evValue {
|
||||
| IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)
|
||||
| IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
|
||||
| _ => evValue
|
||||
}
|
||||
and checkIfCallable = (evValue: internalExpressionValue) =>
|
||||
switch evValue {
|
||||
| IEvCall(_) | IEvLambda(_) => evValue
|
||||
| _ =>
|
||||
raise(
|
||||
ErrorValue.ErrorException(
|
||||
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)),
|
||||
),
|
||||
)
|
||||
}
|
||||
// and replaceSymbolsOnExpressionList = (bindings, list) => {
|
||||
// let racc =
|
||||
// list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
|
||||
// replaceSymbols(bindings, each)->Belt.List.add(acc, _)
|
||||
// )
|
||||
// ExpressionT.EList(racc)
|
||||
// }
|
||||
// and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
|
||||
// switch evValue {
|
||||
// | IEvSymbol(symbol) => Reducer_Bindings.getWithDefault(bindings, symbol, evValue)
|
||||
// | IEvCall(symbol) => Reducer_Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
|
||||
// | _ => evValue
|
||||
// }
|
||||
// and checkIfCallable = (evValue: internalExpressionValue) =>
|
||||
// switch evValue {
|
||||
// | IEvCall(_) | IEvLambda(_) => evValue
|
||||
// | _ =>
|
||||
// raise(
|
||||
// ErrorValue.ErrorException(
|
||||
// ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue)),
|
||||
// ),
|
||||
// )
|
||||
// }
|
||||
|
|
|
@ -1,43 +1,32 @@
|
|||
module BBindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module BErrorValue = Reducer_ErrorValue
|
||||
module T = Reducer_Expression_T
|
||||
module BInternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module BBindings = Reducer_Bindings
|
||||
module T = Reducer_T
|
||||
|
||||
type errorValue = BErrorValue.errorValue
|
||||
type expression = T.expression
|
||||
type expressionOrFFI = T.expressionOrFFI
|
||||
type ffiFn = T.ffiFn
|
||||
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
|
||||
type expression = Reducer_T.expression
|
||||
|
||||
let eArray = anArray => anArray->BInternalExpressionValue.IEvArray->T.EValue
|
||||
let eArray = (anArray: array<T.expression>) => anArray->T.EArray
|
||||
|
||||
let eArrayString = anArray => anArray->BInternalExpressionValue.IEvArrayString->T.EValue
|
||||
let eArrayString = anArray => anArray->T.IEvArrayString->T.EValue
|
||||
|
||||
let eBindings = (anArray: array<(string, BInternalExpressionValue.t)>) =>
|
||||
anArray->BBindings.fromArray->BBindings.toExpressionValue->T.EValue
|
||||
let eBindings = (anArray: array<(string, T.value)>) =>
|
||||
anArray->Reducer_Bindings.fromArray->Reducer_Bindings.toExpressionValue->T.EValue
|
||||
|
||||
let eBool = aBool => aBool->BInternalExpressionValue.IEvBool->T.EValue
|
||||
let eBool = aBool => aBool->T.IEvBool->T.EValue
|
||||
|
||||
let eCall = (name: string): expression =>
|
||||
name->BInternalExpressionValue.IEvCall->T.EValue
|
||||
|
||||
let eFunction = (fName: string, lispArgs: list<expression>): expression => {
|
||||
let fn = fName->eCall
|
||||
list{fn, ...lispArgs}->T.EList
|
||||
}
|
||||
let eCall = (fn: expression, args: array<expression>): expression =>
|
||||
T.ECall(fn, args)
|
||||
|
||||
let eLambda = (
|
||||
parameters: array<string>,
|
||||
expr: expression,
|
||||
) => {
|
||||
T.ELambda(parameters, expr)
|
||||
) => T.ELambda(parameters, expr)
|
||||
|
||||
let eNumber = aNumber => aNumber->BInternalExpressionValue.IEvNumber->T.EValue
|
||||
let eNumber = aNumber => aNumber->T.IEvNumber->T.EValue
|
||||
|
||||
let eRecord = aMap => aMap->BInternalExpressionValue.IEvRecord->T.EValue
|
||||
let eRecord = aMap => aMap->T.IEvRecord->T.EValue
|
||||
|
||||
let eString = aString => aString->BInternalExpressionValue.IEvString->T.EValue
|
||||
let eString = aString => aString->T.IEvString->T.EValue
|
||||
|
||||
let eSymbol = (name: string): expression =>
|
||||
T.ESymbol(name)
|
||||
|
@ -45,8 +34,11 @@ let eSymbol = (name: string): expression =>
|
|||
let eBlock = (exprs: array<expression>): expression =>
|
||||
T.EBlock(exprs)
|
||||
|
||||
let eModule = (nameSpace: BInternalExpressionValue.nameSpace): expression =>
|
||||
nameSpace->BInternalExpressionValue.IEvBindings->T.EValue
|
||||
let eProgram = (exprs: array<expression>): expression =>
|
||||
T.EProgram(exprs)
|
||||
|
||||
let eModule = (nameSpace: T.nameSpace): expression =>
|
||||
nameSpace->T.IEvBindings->T.EValue
|
||||
|
||||
let eLetStatement = (symbol: string, valueExpression: expression): expression =>
|
||||
T.EAssign(symbol, valueExpression)
|
||||
|
@ -55,9 +47,9 @@ let eTernary = (predicate: expression, trueCase: expression, falseCase: expressi
|
|||
T.ETernary(predicate, trueCase, falseCase)
|
||||
|
||||
let eIdentifier = (name: string): expression =>
|
||||
name->BInternalExpressionValue.IEvSymbol->T.EValue
|
||||
name->T.ESymbol
|
||||
|
||||
let eTypeIdentifier = (name: string): expression =>
|
||||
name->BInternalExpressionValue.IEvTypeIdentifier->T.EValue
|
||||
// let eTypeIdentifier = (name: string): expression =>
|
||||
// name->T.IEvTypeIdentifier->T.EValue
|
||||
|
||||
let eVoid: expression = BInternalExpressionValue.IEvVoid->T.EValue
|
||||
let eVoid: expression = T.IEvVoid->T.EValue
|
||||
|
|
|
@ -1,99 +1,53 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module BindingsReplacer = Reducer_Expression_BindingsReplacer
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module Result = Belt.Result
|
||||
|
||||
type expression = ExpressionT.expression
|
||||
type expressionOrFFI = ExpressionT.expressionOrFFI
|
||||
type internalExpressionValue = ReducerInterface_InternalExpressionValue.t
|
||||
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
|
||||
|
||||
external castInternalCodeToExpression: internalCode => expressionOrFFI = "%identity"
|
||||
|
||||
let checkArity = (
|
||||
lambdaValue: ExpressionValue.lambdaValue,
|
||||
args: list<internalExpressionValue>,
|
||||
) => {
|
||||
let reallyCheck = {
|
||||
let argsLength = Belt.List.length(args)
|
||||
let parametersLength = Js.Array2.length(lambdaValue.parameters)
|
||||
if argsLength !== parametersLength {
|
||||
raise(ErrorValue.ErrorException(ErrorValue.REArityError(None, parametersLength, argsLength)))
|
||||
} else {
|
||||
args
|
||||
}
|
||||
}
|
||||
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
||||
switch exprOrFFI {
|
||||
| NotFFI(_) => reallyCheck
|
||||
| FFI(_) => args
|
||||
}
|
||||
}
|
||||
|
||||
let checkIfReduced = (args: list<internalExpressionValue>) =>
|
||||
args->Belt.List.reduceReverse(list{}, (acc, arg) =>
|
||||
switch arg {
|
||||
| IEvSymbol(symbol) => raise(ErrorValue.ErrorException(ErrorValue.RESymbolNotFound(symbol)))
|
||||
| _ => list{arg, ...acc}
|
||||
}
|
||||
)
|
||||
|
||||
let caseNotFFI = (
|
||||
lambdaValue: ExpressionValue.lambdaValue,
|
||||
expr,
|
||||
args,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
) => {
|
||||
let parameterList = lambdaValue.parameters->Belt.List.fromArray
|
||||
let zippedParameterList = parameterList->Belt.List.zip(args)
|
||||
let bindings = Belt.List.reduce(zippedParameterList, lambdaValue.context, (
|
||||
acc,
|
||||
(variable, variableValue),
|
||||
) => acc->Bindings.set(variable, variableValue))
|
||||
let newExpression = ExpressionBuilder.eBlock(list{expr})
|
||||
reducer(newExpression, bindings, accessors)
|
||||
}
|
||||
|
||||
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
|
||||
switch ffiFn(args->Belt.List.toArray, accessors.environment) {
|
||||
| Ok(value) => value
|
||||
| Error(value) => raise(ErrorValue.ErrorException(value))
|
||||
}
|
||||
}
|
||||
|
||||
let applyParametersToLambda = (
|
||||
lambdaValue: ExpressionValue.lambdaValue,
|
||||
args,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
): internalExpressionValue => {
|
||||
let args = checkArity(lambdaValue, args)->checkIfReduced
|
||||
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
|
||||
switch exprOrFFI {
|
||||
| NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer)
|
||||
| FFI(ffiFn) => caseFFI(ffiFn, args, accessors)
|
||||
}
|
||||
}
|
||||
|
||||
let doLambdaCall = (
|
||||
lambdaValue: ExpressionValue.lambdaValue,
|
||||
lambdaValue: Reducer_T.lambdaValue,
|
||||
args,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
) => applyParametersToLambda(lambdaValue, args, accessors, reducer)
|
||||
|
||||
let foreignFunctionInterface = (
|
||||
lambdaValue: ExpressionValue.lambdaValue,
|
||||
argArray: array<internalExpressionValue>,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
): internalExpressionValue => {
|
||||
let args = argArray->Belt.List.fromArray
|
||||
applyParametersToLambda(lambdaValue, args, accessors, reducer)
|
||||
environment: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
): Reducer_T.value => {
|
||||
lambdaValue.body(args, environment, reducer)
|
||||
}
|
||||
|
||||
let makeLambda = (
|
||||
parameters: array<string>,
|
||||
bindings: Reducer_T.nameSpace,
|
||||
body: Reducer_T.expression,
|
||||
): Reducer_T.lambdaValue => {
|
||||
// TODO - clone bindings to avoid later redefinitions affecting lambdas?
|
||||
|
||||
// Note: with this implementation, FFI lambdas (created by other methods than calling `makeLambda`) are allowed to violate the rules, pollute the bindings, etc.
|
||||
// Not sure yet if that's a bug or a feature.
|
||||
|
||||
let lambda = (
|
||||
arguments: array<Reducer_T.value>,
|
||||
environment: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn
|
||||
) => {
|
||||
let argsLength = arguments->Js.Array2.length
|
||||
let parametersLength = parameters->Js.Array2.length
|
||||
if argsLength !== parametersLength {
|
||||
ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.ErrorException->raise
|
||||
}
|
||||
|
||||
let localBindings = bindings->Reducer_Bindings.extend
|
||||
parameters->Js.Array2.forEachi(
|
||||
(parameter, index) => {
|
||||
let _ = localBindings->Reducer_Bindings.set(parameter, arguments[index])
|
||||
}
|
||||
)
|
||||
|
||||
reducer(body, { bindings: localBindings, environment })
|
||||
}
|
||||
|
||||
LNoFFI({
|
||||
context: bindings,
|
||||
body: lambda,
|
||||
parameters,
|
||||
})
|
||||
}
|
||||
|
||||
let makeFFILambda = () => raise(Not_found)
|
||||
|
|
|
@ -1,26 +1,26 @@
|
|||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
module Result = Belt.Result
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ExpressionWithContext = Reducer_ExpressionWithContext
|
||||
// module Result = Belt.Result
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
|
||||
type environment = InternalExpressionValue.environment
|
||||
type expression = ExpressionT.expression
|
||||
type internalExpressionValue = InternalExpressionValue.t
|
||||
type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||
// type environment = InternalExpressionValue.environment
|
||||
// type expression = ExpressionT.expression
|
||||
// type internalExpressionValue = InternalExpressionValue.t
|
||||
// type expressionWithContext = ExpressionWithContext.expressionWithContext
|
||||
|
||||
let doMacroCall = (
|
||||
macroExpression: expression,
|
||||
bindings: ExpressionT.bindings,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reduceExpression: ProjectReducerFnT.t,
|
||||
): internalExpressionValue =>
|
||||
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||
macroExpression,
|
||||
bindings,
|
||||
(accessors: ProjectAccessorsT.t),
|
||||
(reduceExpression: ProjectReducerFnT.t),
|
||||
)->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
|
||||
// let doMacroCall = (
|
||||
// macroExpression: expression,
|
||||
// bindings: ExpressionT.bindings,
|
||||
// accessors: ProjectAccessorsT.t,
|
||||
// reduceExpression: ProjectReducerFnT.t,
|
||||
// ): internalExpressionValue =>
|
||||
// Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
|
||||
// macroExpression,
|
||||
// bindings,
|
||||
// (accessors: ProjectAccessorsT.t),
|
||||
// (reduceExpression: ProjectReducerFnT.t),
|
||||
// )->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
|
||||
|
||||
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||
// let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
|
||||
|
|
|
@ -9,44 +9,38 @@
|
|||
module Extra = Reducer_Extra
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
|
||||
type internalExpressionValue = InternalExpressionValue.t
|
||||
type environment = ReducerInterface_InternalExpressionValue.environment
|
||||
type internalExpressionValue = Reducer_T.value
|
||||
type environment = Reducer_T.environment
|
||||
|
||||
type rec expression =
|
||||
| EBlock(array<expression>)
|
||||
| ESymbol(string)
|
||||
| ETernary(expression, expression, expression)
|
||||
| EAssign(string, expression)
|
||||
| ECall(expression, array<expression>)
|
||||
| ELambda(array<string>, expression)
|
||||
| EValue(internalExpressionValue)
|
||||
and bindings = InternalExpressionValue.nameSpace
|
||||
type expression = Reducer_T.expression
|
||||
|
||||
type t = expression
|
||||
|
||||
type reducerFn = (
|
||||
expression,
|
||||
bindings,
|
||||
environment,
|
||||
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue>
|
||||
type context = Reducer_T.context
|
||||
|
||||
type reducerFn = Reducer_T.reducerFn
|
||||
|
||||
let commaJoin = values => values->Reducer_Extra_Array.intersperse(", ")->Js.String.concatMany("")
|
||||
|
||||
/*
|
||||
Converts the expression to String
|
||||
*/
|
||||
let rec toString = expression => "TODO"
|
||||
// switch expression {
|
||||
// | EList(list{EValue(IEvCall("$$_block_$$")), ...statements}) =>
|
||||
// `{${Belt.List.map(statements, aValue => toString(aValue))
|
||||
// ->Extra.List.intersperse("; ")
|
||||
// ->Belt.List.toArray
|
||||
// ->Js.String.concatMany("")}}`
|
||||
// | EList(aList) =>
|
||||
// `(${Belt.List.map(aList, aValue => toString(aValue))
|
||||
// ->Extra.List.intersperse(" ")
|
||||
// ->Belt.List.toArray
|
||||
// ->Js.String.concatMany("")})`
|
||||
// | EValue(aValue) => InternalExpressionValue.toString(aValue)
|
||||
// }
|
||||
let rec toString = (expression: expression) =>
|
||||
switch expression {
|
||||
| EBlock(statements) =>
|
||||
`{${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}}`
|
||||
| EProgram(statements) =>
|
||||
`<${Js.Array2.map(statements, aValue => toString(aValue))->commaJoin}>`
|
||||
| EArray(aList) =>
|
||||
`[${Js.Array2.map(aList, aValue => toString(aValue))->commaJoin}]`
|
||||
| ERecord(map) => "TODO"
|
||||
| ESymbol(name) => name
|
||||
| ETernary(predicate, trueCase, falseCase) => `${predicate->toString} ? (${trueCase->toString}) : (${falseCase->toString})`
|
||||
| EAssign(name, value) => `${name} = ${value->toString}`
|
||||
| ECall(fn, args) => `(${fn->toString})(${args->Js.Array2.map(toString)->commaJoin})`
|
||||
| ELambda(parameters, body) => `{|${parameters->commaJoin}| ${body->toString}}`
|
||||
| EValue(aValue) => InternalExpressionValue.toString(aValue)
|
||||
}
|
||||
|
||||
let toStringResult = codeResult =>
|
||||
switch codeResult {
|
||||
|
|
|
@ -9,25 +9,27 @@ start
|
|||
|
||||
zeroOMoreArgumentsBlockOrExpression = innerBlockOrExpression / lambda
|
||||
|
||||
// { return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
|
||||
// {return [h.nodeVoid()];}
|
||||
outerBlock
|
||||
= statements:array_statements finalExpression: (statementSeparator @expression)?
|
||||
{ if (finalExpression != null)
|
||||
{
|
||||
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
|
||||
statements.push(newFinalExpression);
|
||||
}
|
||||
else
|
||||
{
|
||||
var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]);
|
||||
statements.push(newFinalStatement);
|
||||
}
|
||||
return h.nodeBlock(statements) }
|
||||
/ finalExpression: expression
|
||||
{
|
||||
var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
|
||||
return h.nodeBlock([newFinalExpression])}
|
||||
{ if (finalExpression) statements.push(finalExpression)
|
||||
return h.nodeProgram(statements) }
|
||||
// / '{' _nl finalExpression: expression _nl '}'
|
||||
// { return h.nodeBlock([finalExpression]) }
|
||||
// { if (finalExpression != null)
|
||||
// {
|
||||
// var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
|
||||
// statements.push(newFinalExpression);
|
||||
// }
|
||||
// else
|
||||
// {
|
||||
// var newFinalStatement = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), h.nodeVoid()]);
|
||||
// statements.push(newFinalStatement);
|
||||
// }
|
||||
// return h.nodeBlock(statements) }
|
||||
// / finalExpression: expression
|
||||
// {
|
||||
// var newFinalExpression = h.makeFunctionCall('$_endOfOuterBlock_$', [h.nodeVoid(), finalExpression]);
|
||||
// return h.nodeBlock([newFinalExpression])}
|
||||
|
||||
innerBlockOrExpression
|
||||
= quotedInnerBlock
|
||||
|
@ -36,7 +38,7 @@ innerBlockOrExpression
|
|||
|
||||
quotedInnerBlock
|
||||
= '{' _nl statements:array_statements finalExpression: (statementSeparator @expression) _nl '}'
|
||||
{ statements.push(finalExpression)
|
||||
{ if (finalExpression) statements.push(finalExpression)
|
||||
return h.nodeBlock(statements) }
|
||||
/ '{' _nl finalExpression: expression _nl '}'
|
||||
{ return h.nodeBlock([finalExpression]) }
|
||||
|
@ -50,7 +52,7 @@ array_statements
|
|||
statement
|
||||
= letStatement
|
||||
/ defunStatement
|
||||
/ typeStatement
|
||||
// / typeStatement
|
||||
/ voidStatement
|
||||
|
||||
voidStatement
|
||||
|
@ -337,80 +339,80 @@ statementSeparator 'statement separator'
|
|||
newLine "newline"
|
||||
= [\n\r]
|
||||
|
||||
// Types
|
||||
// // Types
|
||||
|
||||
noArguments = ('(' _nl ')' )?
|
||||
// noArguments = ('(' _nl ')' )?
|
||||
|
||||
typeIdentifier 'type identifier'
|
||||
= ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
|
||||
// typeIdentifier 'type identifier'
|
||||
// = ([a-z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
|
||||
|
||||
typeConstructorIdentifier 'type constructor identifier'
|
||||
= ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
|
||||
// typeConstructorIdentifier 'type constructor identifier'
|
||||
// = ([A-Z]+[_a-z0-9]i*) {return h.nodeTypeIdentifier(text())}
|
||||
|
||||
typeExpression = typePostModifierExpression
|
||||
// typeExpression = typePostModifierExpression
|
||||
|
||||
typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
|
||||
{
|
||||
return tail.reduce((result, element) => {
|
||||
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
|
||||
}, head)
|
||||
}
|
||||
// typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
|
||||
// {
|
||||
// return tail.reduce((result, element) => {
|
||||
// return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
|
||||
// }, head)
|
||||
// }
|
||||
|
||||
typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
|
||||
{ return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); }
|
||||
// typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
|
||||
// { return tail.length === 0 ? head : h.makeFunctionCall('$_typeOr_$', [h.constructArray([head, ...tail])]); }
|
||||
|
||||
typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
|
||||
{ return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); }
|
||||
// typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
|
||||
// { return tail.length === 0 ? head : h.makeFunctionCall( '$_typeFunction_$', [h.constructArray([head, ...tail])]); }
|
||||
|
||||
typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
|
||||
{
|
||||
return tail.reduce((result, element) => {
|
||||
return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
|
||||
}, head)
|
||||
}
|
||||
// typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
|
||||
// {
|
||||
// return tail.reduce((result, element) => {
|
||||
// return h.makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
|
||||
// }, head)
|
||||
// }
|
||||
|
||||
typeModifier
|
||||
= modifier:identifier _ '(' _nl args:array_elements _nl ')'
|
||||
{ return {modifier: modifier, args: args}; }
|
||||
/ modifier:identifier _ noArguments
|
||||
{ return {modifier: modifier, args: []}; }
|
||||
// typeModifier
|
||||
// = modifier:identifier _ '(' _nl args:array_elements _nl ')'
|
||||
// { return {modifier: modifier, args: args}; }
|
||||
// / modifier:identifier _ noArguments
|
||||
// { return {modifier: modifier, args: []}; }
|
||||
|
||||
basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
|
||||
// basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
|
||||
|
||||
typeArray = '[' _nl elem:typeExpression _nl ']'
|
||||
{return h.makeFunctionCall('$_typeArray_$', [elem])}
|
||||
// typeArray = '[' _nl elem:typeExpression _nl ']'
|
||||
// {return h.makeFunctionCall('$_typeArray_$', [elem])}
|
||||
|
||||
typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
|
||||
{ return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])}
|
||||
// typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
|
||||
// { return h.makeFunctionCall('$_typeTuple_$', [h.constructArray(elems)])}
|
||||
|
||||
array_typeTupleArguments
|
||||
= head:typeExpression tail:(_ ',' _nl @typeExpression)*
|
||||
{ return [head, ...tail]; }
|
||||
// array_typeTupleArguments
|
||||
// = head:typeExpression tail:(_ ',' _nl @typeExpression)*
|
||||
// { return [head, ...tail]; }
|
||||
|
||||
typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
|
||||
{ return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); }
|
||||
// typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
|
||||
// { return h.makeFunctionCall('$_typeRecord_$', [h.constructRecord(elems)]); }
|
||||
|
||||
array_typeRecordArguments
|
||||
= head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
|
||||
{ return [head, ...tail]; }
|
||||
// array_typeRecordArguments
|
||||
// = head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
|
||||
// { return [head, ...tail]; }
|
||||
|
||||
typeKeyValuePair
|
||||
= key:identifier _ ':' _nl value:typeExpression
|
||||
{ return h.nodeKeyValue(key, value)}
|
||||
// typeKeyValuePair
|
||||
// = key:identifier _ ':' _nl value:typeExpression
|
||||
// { return h.nodeKeyValue(key, value)}
|
||||
|
||||
typeConstructor
|
||||
= constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
|
||||
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); }
|
||||
/ constructor:typeConstructorIdentifier _ noArguments
|
||||
{ return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); }
|
||||
// typeConstructor
|
||||
// = constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
|
||||
// { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray(args)]); }
|
||||
// / constructor:typeConstructorIdentifier _ noArguments
|
||||
// { return h.makeFunctionCall('$_typeConstructor_$', [constructor, h.constructArray([])]); }
|
||||
|
||||
array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
|
||||
{ return [head, ...tail]; }
|
||||
// array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
|
||||
// { return [head, ...tail]; }
|
||||
|
||||
typeStatement = typeAliasStatement / typeOfStatement
|
||||
typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
|
||||
{ return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
|
||||
typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
|
||||
{ return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
|
||||
// typeStatement = typeAliasStatement / typeOfStatement
|
||||
// typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
|
||||
// { return h.makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
|
||||
// typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
|
||||
// { return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
|
||||
|
||||
typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}
|
||||
// typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}
|
||||
|
|
|
@ -20,6 +20,7 @@ let parse = (expr: string): result<node, errorValue> =>
|
|||
}
|
||||
|
||||
type nodeBlock = {...node, "statements": array<node>}
|
||||
type nodeProgram = {...node, "statements": array<node>}
|
||||
type nodeBoolean = {...node, "value": bool}
|
||||
type nodeCall = {...node, "fn": node, "args": array<node>}
|
||||
type nodeFloat = {...node, "value": float}
|
||||
|
@ -31,11 +32,12 @@ type nodeLetStatement = {...node, "variable": nodeIdentifier, "value": node}
|
|||
type nodeModuleIdentifier = {...node, "value": string}
|
||||
type nodeString = {...node, "value": string}
|
||||
type nodeTernary = {...node, "condition": node, "trueExpression": node, "falseExpression": node}
|
||||
type nodeTypeIdentifier = {...node, "value": string}
|
||||
// type nodeTypeIdentifier = {...node, "value": string}
|
||||
type nodeVoid = node
|
||||
|
||||
type peggyNode =
|
||||
| PgNodeBlock(nodeBlock)
|
||||
| PgNodeProgram(nodeBlock)
|
||||
| PgNodeBoolean(nodeBoolean)
|
||||
| PgNodeFloat(nodeFloat)
|
||||
| PgNodeCall(nodeCall)
|
||||
|
@ -47,10 +49,11 @@ type peggyNode =
|
|||
| PgNodeModuleIdentifier(nodeModuleIdentifier)
|
||||
| PgNodeString(nodeString)
|
||||
| PgNodeTernary(nodeTernary)
|
||||
| PgNodeTypeIdentifier(nodeTypeIdentifier)
|
||||
// | PgNodeTypeIdentifier(nodeTypeIdentifier)
|
||||
| PgNodeVoid(nodeVoid)
|
||||
|
||||
external castNodeBlock: node => nodeBlock = "%identity"
|
||||
external castNodeProgram: node => nodeProgram = "%identity"
|
||||
external castNodeBoolean: node => nodeBoolean = "%identity"
|
||||
external castNodeCall: node => nodeCall = "%identity"
|
||||
external castNodeFloat: node => nodeFloat = "%identity"
|
||||
|
@ -62,13 +65,14 @@ external castNodeLetStatement: node => nodeLetStatement = "%identity"
|
|||
external castNodeModuleIdentifier: node => nodeModuleIdentifier = "%identity"
|
||||
external castNodeString: node => nodeString = "%identity"
|
||||
external castNodeTernary: node => nodeTernary = "%identity"
|
||||
external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
|
||||
// external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
|
||||
external castNodeVoid: node => nodeVoid = "%identity"
|
||||
|
||||
exception UnsupportedPeggyNodeType(string) // This should never happen; programming error
|
||||
let castNodeType = (node: node) =>
|
||||
switch node["type"] {
|
||||
| "Block" => node->castNodeBlock->PgNodeBlock
|
||||
| "Program" => node->castNodeBlock->PgNodeProgram
|
||||
| "Boolean" => node->castNodeBoolean->PgNodeBoolean
|
||||
| "Call" => node->castNodeCall->PgNodeCall
|
||||
| "Float" => node->castNodeFloat->PgNodeFloat
|
||||
|
@ -80,7 +84,7 @@ let castNodeType = (node: node) =>
|
|||
| "ModuleIdentifier" => node->castNodeModuleIdentifier->PgNodeModuleIdentifier
|
||||
| "String" => node->castNodeString->PgNodeString
|
||||
| "Ternary" => node->castNodeTernary->PgNodeTernary
|
||||
| "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
|
||||
// | "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
|
||||
| "Void" => node->castNodeVoid->PgNodeVoid
|
||||
| _ => raise(UnsupportedPeggyNodeType(node["type"]))
|
||||
}
|
||||
|
@ -93,7 +97,9 @@ let rec pgToString = (peggyNode: peggyNode): string => {
|
|||
nodes->Js.Array2.map(toString)->Extra.Array.intersperse(separator)->Js.String.concatMany("")
|
||||
|
||||
switch peggyNode {
|
||||
| PgNodeBlock(node) => "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}"
|
||||
| PgNodeBlock(node)
|
||||
| PgNodeProgram(node)
|
||||
=> "{" ++ node["statements"]->nodesToStringUsingSeparator("; ") ++ "}"
|
||||
| PgNodeBoolean(node) => node["value"]->Js.String.make
|
||||
| PgNodeCall(node) => "(" ++ node["fn"]->toString ++ " " ++ node["args"]->nodesToStringUsingSeparator(" ") ++ ")"
|
||||
| PgNodeFloat(node) => node["value"]->Js.String.make
|
||||
|
@ -113,7 +119,7 @@ let rec pgToString = (peggyNode: peggyNode): string => {
|
|||
toString(node["trueExpression"]) ++
|
||||
" " ++
|
||||
toString(node["falseExpression"]) ++ ")"
|
||||
| PgNodeTypeIdentifier(node) => `#${node["value"]}`
|
||||
// | PgNodeTypeIdentifier(node) => `#${node["value"]}`
|
||||
| PgNodeVoid(_node) => "()"
|
||||
}
|
||||
}
|
||||
|
|
|
@ -2,12 +2,15 @@ module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
|
|||
module ExpressionT = Reducer_Expression_T
|
||||
module Parse = Reducer_Peggy_Parse
|
||||
|
||||
type expression = ExpressionT.expression
|
||||
type expression = Reducer_T.expression
|
||||
|
||||
let rec fromNode = (node: Parse.node): expression => {
|
||||
let caseBlock = nodeBlock =>
|
||||
ExpressionBuilder.eBlock(nodeBlock["statements"]->Js.Array2.map(fromNode))
|
||||
|
||||
let caseProgram = nodeProgram =>
|
||||
ExpressionBuilder.eProgram(nodeProgram["statements"]->Js.Array2.map(fromNode))
|
||||
|
||||
let caseLambda = (nodeLambda: Parse.nodeLambda): expression => {
|
||||
let args =
|
||||
nodeLambda["args"]
|
||||
|
@ -19,14 +22,14 @@ let rec fromNode = (node: Parse.node): expression => {
|
|||
|
||||
switch Parse.castNodeType(node) {
|
||||
| PgNodeBlock(nodeBlock) => caseBlock(nodeBlock)
|
||||
| PgNodeProgram(nodeProgram) => caseProgram(nodeProgram)
|
||||
| PgNodeBoolean(nodeBoolean) => ExpressionBuilder.eBool(nodeBoolean["value"])
|
||||
| PgNodeExpression(nodeExpression) =>
|
||||
ExpressionT.EList(nodeExpression["nodes"]->Js.Array2.map(fromNode))
|
||||
| PgNodeCall(nodeCall) => ExpressionBuilder.eCall(fromNode(nodeCall["fn"]), nodeCall["args"]->Js.Array2.map(fromNode))
|
||||
| PgNodeFloat(nodeFloat) => ExpressionBuilder.eNumber(nodeFloat["value"])
|
||||
| PgNodeIdentifier(nodeIdentifier) => ExpressionBuilder.eSymbol(nodeIdentifier["value"])
|
||||
| PgNodeInteger(nodeInteger) => ExpressionBuilder.eNumber(Belt.Int.toFloat(nodeInteger["value"]))
|
||||
| PgNodeKeyValue(nodeKeyValue) =>
|
||||
ExpressionT.EList(list{fromNode(nodeKeyValue["key"]), fromNode(nodeKeyValue["value"])})
|
||||
ExpressionBuilder.eArray([fromNode(nodeKeyValue["key"]), fromNode(nodeKeyValue["value"])])
|
||||
| PgNodeLambda(nodeLambda) => caseLambda(nodeLambda)
|
||||
| PgNodeLetStatement(nodeLetStatement) =>
|
||||
ExpressionBuilder.eLetStatement(
|
||||
|
@ -42,8 +45,8 @@ let rec fromNode = (node: Parse.node): expression => {
|
|||
fromNode(nodeTernary["trueExpression"]),
|
||||
fromNode(nodeTernary["falseExpression"])
|
||||
)
|
||||
| PgNodeTypeIdentifier(nodeTypeIdentifier) =>
|
||||
ExpressionBuilder.eTypeIdentifier(nodeTypeIdentifier["value"])
|
||||
// | PgNodeTypeIdentifier(nodeTypeIdentifier) =>
|
||||
// ExpressionBuilder.eTypeIdentifier(nodeTypeIdentifier["value"])
|
||||
| PgNodeVoid(_) => ExpressionBuilder.eVoid
|
||||
}
|
||||
}
|
||||
|
|
|
@ -40,6 +40,11 @@ type NodeBlock = {
|
|||
statements: AnyPeggyNode[];
|
||||
};
|
||||
|
||||
type NodeProgram = {
|
||||
type: "Program";
|
||||
statements: AnyPeggyNode[];
|
||||
};
|
||||
|
||||
type NodeCall = {
|
||||
type: "Call";
|
||||
fn: AnyPeggyNode;
|
||||
|
@ -99,6 +104,7 @@ type NodeBoolean = {
|
|||
|
||||
export type AnyPeggyNode =
|
||||
| NodeBlock
|
||||
| NodeProgram
|
||||
| NodeCall
|
||||
| NodeFloat
|
||||
| NodeInteger
|
||||
|
@ -111,7 +117,11 @@ export type AnyPeggyNode =
|
|||
| NodeBoolean;
|
||||
|
||||
export function makeFunctionCall(fn: string, args: AnyPeggyNode[]) {
|
||||
return nodeCall(nodeIdentifier(fn), args);
|
||||
if (fn === "$$_applyAll_$$") {
|
||||
return nodeCall(args[0], args.splice(1));
|
||||
} else {
|
||||
return nodeCall(nodeIdentifier(fn), args);
|
||||
}
|
||||
}
|
||||
|
||||
export function constructArray(elems: AnyPeggyNode[]) {
|
||||
|
@ -124,6 +134,9 @@ export function constructRecord(elems: AnyPeggyNode[]) {
|
|||
export function nodeBlock(statements: AnyPeggyNode[]): NodeBlock {
|
||||
return { type: "Block", statements };
|
||||
}
|
||||
export function nodeProgram(statements: AnyPeggyNode[]): NodeProgram {
|
||||
return { type: "Program", statements };
|
||||
}
|
||||
export function nodeBoolean(value: boolean): NodeBoolean {
|
||||
return { type: "Boolean", value };
|
||||
}
|
||||
|
|
53
packages/squiggle-lang/src/rescript/Reducer/Reducer_T.res
Normal file
53
packages/squiggle-lang/src/rescript/Reducer/Reducer_T.res
Normal 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
|
|
@ -1,42 +1,41 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module Expression = Reducer_Expression
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module T = Reducer_Type_T
|
||||
// module Bindings = Reducer_Bindings
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
// module Expression = Reducer_Expression
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module T = Reducer_Type_T
|
||||
|
||||
let ievFromTypeExpression = (
|
||||
typeExpressionSourceCode: string,
|
||||
reducerFn: ProjectReducerFnT.t,
|
||||
): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
let sIndex = "compiled"
|
||||
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
|
||||
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
|
||||
let accessors = ProjectAccessorsT.identityAccessors
|
||||
let result = reducerFn(expr, Bindings.emptyBindings, accessors)
|
||||
let nameSpace = accessors.states.continuation
|
||||
// let ievFromTypeExpression = (
|
||||
// typeExpressionSourceCode: string,
|
||||
// reducerFn: Reducer_T.reducerFn,
|
||||
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
// let sIndex = "compiled"
|
||||
// let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
|
||||
// Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
|
||||
// let accessors = ProjectAccessorsT.identityAccessors
|
||||
// let result = reducerFn(expr, Bindings.emptyBindings, accessors)
|
||||
// let nameSpace = accessors.states.continuation
|
||||
|
||||
switch Bindings.getType(nameSpace, sIndex) {
|
||||
| Some(value) => value->Ok
|
||||
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
|
||||
}
|
||||
})
|
||||
}
|
||||
// switch Bindings.getType(nameSpace, sIndex) {
|
||||
// | Some(value) => value->Ok
|
||||
// | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
|
||||
// }
|
||||
// })
|
||||
// }
|
||||
|
||||
let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: ProjectReducerFnT.t): result<
|
||||
T.t,
|
||||
ErrorValue.t,
|
||||
> => {
|
||||
ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue)
|
||||
}
|
||||
// let fromTypeExpression = (typeExpressionSourceCode: string, reducerFn: Reducer_T.reducerFn): result<
|
||||
// T.t,
|
||||
// ErrorValue.t,
|
||||
// > => {
|
||||
// ievFromTypeExpression(typeExpressionSourceCode, reducerFn)->Belt.Result.map(T.fromIEvValue)
|
||||
// }
|
||||
|
||||
let fromTypeExpressionExn = (
|
||||
typeExpressionSourceCode: string,
|
||||
reducerFn: ProjectReducerFnT.t,
|
||||
): T.t =>
|
||||
switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
|
||||
| Ok(value) => value
|
||||
| _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
|
||||
}
|
||||
// let fromTypeExpressionExn = (
|
||||
// typeExpressionSourceCode: string,
|
||||
// reducerFn: Reducer_T.reducerFn,
|
||||
// ): T.t =>
|
||||
// switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
|
||||
// | Ok(value) => value
|
||||
// | _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
|
||||
// }
|
||||
|
|
|
@ -1,119 +1,119 @@
|
|||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
open InternalExpressionValue
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// open InternalExpressionValue
|
||||
|
||||
type rec iType =
|
||||
| ItTypeIdentifier(string)
|
||||
| ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>})
|
||||
| ItTypeOr({typeOr: array<iType>})
|
||||
| ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
| ItTypeArray({element: iType})
|
||||
| ItTypeTuple({elements: array<iType>})
|
||||
| ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
// type rec iType =
|
||||
// | ItTypeIdentifier(string)
|
||||
// | ItModifiedType({modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>})
|
||||
// | ItTypeOr({typeOr: array<iType>})
|
||||
// | ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
// | ItTypeArray({element: iType})
|
||||
// | ItTypeTuple({elements: array<iType>})
|
||||
// | ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
|
||||
type t = iType
|
||||
type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
|
||||
// type t = iType
|
||||
// type typeErrorValue = TypeMismatch(t, InternalExpressionValue.t)
|
||||
|
||||
let rec toString = (t: t): string => {
|
||||
switch t {
|
||||
| ItTypeIdentifier(s) => s
|
||||
| ItModifiedType({modifiedType, contracts}) =>
|
||||
`${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) =>
|
||||
Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
|
||||
)}`
|
||||
| ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
|
||||
| ItTypeFunction({inputs, output}) =>
|
||||
`(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
|
||||
| ItTypeArray({element}) => `[${toString(element)}]`
|
||||
| ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
|
||||
| ItTypeRecord({properties}) =>
|
||||
`{${properties
|
||||
->Belt.Map.String.toArray
|
||||
->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
|
||||
->Js.Array2.joinWith(", ")}}`
|
||||
}
|
||||
}
|
||||
// let rec toString = (t: t): string => {
|
||||
// switch t {
|
||||
// | ItTypeIdentifier(s) => s
|
||||
// | ItModifiedType({modifiedType, contracts}) =>
|
||||
// `${toString(modifiedType)}${contracts->Belt.Map.String.reduce("", (acc, k, v) =>
|
||||
// Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
|
||||
// )}`
|
||||
// | ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
|
||||
// | ItTypeFunction({inputs, output}) =>
|
||||
// `(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
|
||||
// | ItTypeArray({element}) => `[${toString(element)}]`
|
||||
// | ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
|
||||
// | ItTypeRecord({properties}) =>
|
||||
// `{${properties
|
||||
// ->Belt.Map.String.toArray
|
||||
// ->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
|
||||
// ->Js.Array2.joinWith(", ")}}`
|
||||
// }
|
||||
// }
|
||||
|
||||
let toStringResult = (rt: result<t, ErrorValue.t>) =>
|
||||
switch rt {
|
||||
| Ok(t) => toString(t)
|
||||
| Error(e) => ErrorValue.errorToString(e)
|
||||
}
|
||||
// let toStringResult = (rt: result<t, ErrorValue.t>) =>
|
||||
// switch rt {
|
||||
// | Ok(t) => toString(t)
|
||||
// | Error(e) => ErrorValue.errorToString(e)
|
||||
// }
|
||||
|
||||
let rec fromTypeMap = typeMap => {
|
||||
let default = IEvString("")
|
||||
let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"typeTag",
|
||||
default,
|
||||
)
|
||||
let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"typeIdentifier",
|
||||
default,
|
||||
)
|
||||
let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"typeOr",
|
||||
default,
|
||||
)
|
||||
let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"inputs",
|
||||
default,
|
||||
)
|
||||
let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"output",
|
||||
default,
|
||||
)
|
||||
let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"element",
|
||||
default,
|
||||
)
|
||||
let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"elements",
|
||||
default,
|
||||
)
|
||||
let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
typeMap,
|
||||
"properties",
|
||||
default,
|
||||
)
|
||||
// let rec fromTypeMap = typeMap => {
|
||||
// let default = IEvString("")
|
||||
// let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "typeTag",
|
||||
// default,
|
||||
// )
|
||||
// let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "typeIdentifier",
|
||||
// default,
|
||||
// )
|
||||
// let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "typeOr",
|
||||
// default,
|
||||
// )
|
||||
// let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "inputs",
|
||||
// default,
|
||||
// )
|
||||
// let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "output",
|
||||
// default,
|
||||
// )
|
||||
// let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "element",
|
||||
// default,
|
||||
// )
|
||||
// let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "elements",
|
||||
// default,
|
||||
// )
|
||||
// let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
// typeMap,
|
||||
// "properties",
|
||||
// default,
|
||||
// )
|
||||
|
||||
let contracts =
|
||||
typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
|
||||
// let contracts =
|
||||
// typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
|
||||
|
||||
let makeIt = switch evTypeTag {
|
||||
| IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
|
||||
| IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
|
||||
| IEvString("typeFunction") =>
|
||||
ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
|
||||
| IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
|
||||
| IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
|
||||
| IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
|
||||
}
|
||||
// let makeIt = switch evTypeTag {
|
||||
// | IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
|
||||
// | IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
|
||||
// | IEvString("typeFunction") =>
|
||||
// ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
|
||||
// | IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
|
||||
// | IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
|
||||
// | IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
|
||||
// }
|
||||
|
||||
Belt.Map.String.isEmpty(contracts)
|
||||
? makeIt
|
||||
: ItModifiedType({modifiedType: makeIt, contracts: contracts})
|
||||
}
|
||||
// Belt.Map.String.isEmpty(contracts)
|
||||
// ? makeIt
|
||||
// : ItModifiedType({modifiedType: makeIt, contracts: contracts})
|
||||
// }
|
||||
|
||||
and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
|
||||
switch ievValue {
|
||||
| IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
|
||||
| IEvType(typeMap) => fromTypeMap(typeMap)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
|
||||
}
|
||||
and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
|
||||
switch ievArray {
|
||||
| IEvArray(array) => array->Belt.Array.map(fromIEvValue)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
|
||||
}
|
||||
and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
|
||||
switch ievRecord {
|
||||
| IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
|
||||
}
|
||||
// and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
|
||||
// switch ievValue {
|
||||
// | IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
|
||||
// | IEvType(typeMap) => fromTypeMap(typeMap)
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
|
||||
// }
|
||||
// and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
|
||||
// switch ievArray {
|
||||
// | IEvArray(array) => array->Belt.Array.map(fromIEvValue)
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
|
||||
// }
|
||||
// and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
|
||||
// switch ievRecord {
|
||||
// | IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
|
||||
// | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
|
||||
// }
|
||||
|
|
|
@ -1,80 +1,80 @@
|
|||
open ReducerInterface_InternalExpressionValue
|
||||
// open ReducerInterface_InternalExpressionValue
|
||||
|
||||
let typeModifier_memberOf = (aType, anArray) => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeIdentifier")),
|
||||
("typeIdentifier", aType),
|
||||
])
|
||||
newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
|
||||
}
|
||||
// let typeModifier_memberOf = (aType, anArray) => {
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeIdentifier")),
|
||||
// ("typeIdentifier", aType),
|
||||
// ])
|
||||
// newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeModifier_memberOf_update = (aRecord, anArray) => {
|
||||
aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
|
||||
}
|
||||
// let typeModifier_memberOf_update = (aRecord, anArray) => {
|
||||
// aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeModifier_min = (aType, value) => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeIdentifier")),
|
||||
("typeIdentifier", aType),
|
||||
])
|
||||
newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
|
||||
}
|
||||
// let typeModifier_min = (aType, value) => {
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeIdentifier")),
|
||||
// ("typeIdentifier", aType),
|
||||
// ])
|
||||
// newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeModifier_min_update = (aRecord, value) => {
|
||||
aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
|
||||
}
|
||||
// let typeModifier_min_update = (aRecord, value) => {
|
||||
// aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeModifier_max = (aType, value) => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeIdentifier")),
|
||||
("typeIdentifier", aType),
|
||||
])
|
||||
newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
|
||||
}
|
||||
// let typeModifier_max = (aType, value) => {
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeIdentifier")),
|
||||
// ("typeIdentifier", aType),
|
||||
// ])
|
||||
// newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeModifier_max_update = (aRecord, value) =>
|
||||
aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
|
||||
// let typeModifier_max_update = (aRecord, value) =>
|
||||
// aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
|
||||
|
||||
let typeModifier_opaque_update = aRecord =>
|
||||
aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
|
||||
// let typeModifier_opaque_update = aRecord =>
|
||||
// aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
|
||||
|
||||
let typeOr = evArray => {
|
||||
let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
// let typeOr = evArray => {
|
||||
// let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
|
||||
// newRecord->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeFunction = anArray => {
|
||||
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
|
||||
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeFunction")),
|
||||
("inputs", IEvArray(inputs)),
|
||||
("output", output),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
// let typeFunction = anArray => {
|
||||
// let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
|
||||
// let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeFunction")),
|
||||
// ("inputs", IEvArray(inputs)),
|
||||
// ("output", output),
|
||||
// ])
|
||||
// newRecord->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeArray = element => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeArray")),
|
||||
("element", element),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
// let typeArray = element => {
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeArray")),
|
||||
// ("element", element),
|
||||
// ])
|
||||
// newRecord->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeTuple = anArray => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeTuple")),
|
||||
("elements", IEvArray(anArray)),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
// let typeTuple = anArray => {
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeTuple")),
|
||||
// ("elements", IEvArray(anArray)),
|
||||
// ])
|
||||
// newRecord->IEvType->Ok
|
||||
// }
|
||||
|
||||
let typeRecord = propertyMap => {
|
||||
let newProperties = propertyMap->IEvRecord
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeRecord")),
|
||||
("properties", newProperties),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
// let typeRecord = propertyMap => {
|
||||
// let newProperties = propertyMap->IEvRecord
|
||||
// let newRecord = Belt.Map.String.fromArray([
|
||||
// ("typeTag", IEvString("typeRecord")),
|
||||
// ("properties", newProperties),
|
||||
// ])
|
||||
// newRecord->IEvType->Ok
|
||||
// }
|
||||
|
|
|
@ -1,182 +1,181 @@
|
|||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
module T = Reducer_Type_T
|
||||
module TypeContracts = Reducer_Type_Contracts
|
||||
open InternalExpressionValue
|
||||
// module ExpressionT = Reducer_Expression_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
// module T = Reducer_Type_T
|
||||
// module TypeContracts = Reducer_Type_Contracts
|
||||
// open InternalExpressionValue
|
||||
|
||||
let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
|
||||
let caseTypeIdentifier = (anUpperTypeName, aValue) => {
|
||||
let aTypeName = anUpperTypeName->Js.String2.toLowerCase
|
||||
switch aTypeName {
|
||||
| "any" => Ok(true)
|
||||
| _ => {
|
||||
let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
|
||||
switch aTypeName == valueTypeName {
|
||||
| true => Ok(true)
|
||||
| false => T.TypeMismatch(anIType, aValue)->Error
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
// let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
|
||||
// let caseTypeIdentifier = (anUpperTypeName, aValue) => {
|
||||
// let aTypeName = anUpperTypeName->Js.String2.toLowerCase
|
||||
// switch aTypeName {
|
||||
// | "any" => Ok(true)
|
||||
// | _ => {
|
||||
// let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
|
||||
// switch aTypeName == valueTypeName {
|
||||
// | true => Ok(true)
|
||||
// | false => T.TypeMismatch(anIType, aValue)->Error
|
||||
// }
|
||||
// }
|
||||
// }
|
||||
// }
|
||||
|
||||
let caseRecord = (anIType, propertyMap: Belt.Map.String.t<T.iType>, evValue) =>
|
||||
switch evValue {
|
||||
| IEvRecord(aRecord) =>
|
||||
if (
|
||||
Js.Array2.length(propertyMap->Belt.Map.String.keysToArray) ==
|
||||
Js.Array2.length(aRecord->Belt.Map.String.keysToArray)
|
||||
) {
|
||||
Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
|
||||
Belt.Result.flatMap(acc, _ =>
|
||||
switch Belt.Map.String.get(aRecord, property) {
|
||||
| Some(propertyValue) => isITypeOf(propertyType, propertyValue)
|
||||
| None => T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
)
|
||||
})
|
||||
} else {
|
||||
T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
// let caseRecord = (anIType, propertyMap: Belt.Map.String.t<T.iType>, evValue) =>
|
||||
// switch evValue {
|
||||
// | IEvRecord(aRecord) =>
|
||||
// if (
|
||||
// Js.Array2.length(propertyMap->Belt.Map.String.keysToArray) ==
|
||||
// Js.Array2.length(aRecord->Belt.Map.String.keysToArray)
|
||||
// ) {
|
||||
// Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
|
||||
// Belt.Result.flatMap(acc, _ =>
|
||||
// switch Belt.Map.String.get(aRecord, property) {
|
||||
// | Some(propertyValue) => isITypeOf(propertyType, propertyValue)
|
||||
// | None => T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
// )
|
||||
// })
|
||||
// } else {
|
||||
// T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
|
||||
| _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
// | _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
|
||||
let caseArray = (anIType, elementType, evValue) =>
|
||||
switch evValue {
|
||||
| IEvArray(anArray) =>
|
||||
Belt.Array.reduce(anArray, Ok(true), (acc, element) =>
|
||||
Belt.Result.flatMap(acc, _ =>
|
||||
switch isITypeOf(elementType, element) {
|
||||
| Ok(_) => Ok(true)
|
||||
| Error(error) => error->Error
|
||||
}
|
||||
)
|
||||
)
|
||||
| _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
// let caseArray = (anIType, elementType, evValue) =>
|
||||
// switch evValue {
|
||||
// | IEvArray(anArray) =>
|
||||
// Belt.Array.reduce(anArray, Ok(true), (acc, element) =>
|
||||
// Belt.Result.flatMap(acc, _ =>
|
||||
// switch isITypeOf(elementType, element) {
|
||||
// | Ok(_) => Ok(true)
|
||||
// | Error(error) => error->Error
|
||||
// }
|
||||
// )
|
||||
// )
|
||||
// | _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
|
||||
let caseTuple = (anIType, elementTypes, evValue) =>
|
||||
switch evValue {
|
||||
| IEvArray(anArray) =>
|
||||
if Js.Array2.length(elementTypes) == Js.Array2.length(anArray) {
|
||||
let zipped = Belt.Array.zip(elementTypes, anArray)
|
||||
Belt.Array.reduce(zipped, Ok(true), (acc, (elementType, element)) =>
|
||||
switch acc {
|
||||
| Ok(_) =>
|
||||
switch isITypeOf(elementType, element) {
|
||||
| Ok(_) => acc
|
||||
| Error(error) => Error(error)
|
||||
}
|
||||
| _ => acc
|
||||
}
|
||||
)
|
||||
} else {
|
||||
T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
| _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
}
|
||||
// let caseTuple = (anIType, elementTypes, evValue) =>
|
||||
// switch evValue {
|
||||
// | IEvArray(anArray) =>
|
||||
// if Js.Array2.length(elementTypes) == Js.Array2.length(anArray) {
|
||||
// let zipped = Belt.Array.zip(elementTypes, anArray)
|
||||
// Belt.Array.reduce(zipped, Ok(true), (acc, (elementType, element)) =>
|
||||
// switch acc {
|
||||
// | Ok(_) =>
|
||||
// switch isITypeOf(elementType, element) {
|
||||
// | Ok(_) => acc
|
||||
// | Error(error) => Error(error)
|
||||
// }
|
||||
// | _ => acc
|
||||
// }
|
||||
// )
|
||||
// } else {
|
||||
// T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
// | _ => T.TypeMismatch(anIType, evValue)->Error
|
||||
// }
|
||||
|
||||
let caseOr = (anIType, anITypeArray, evValue) =>
|
||||
switch Belt.Array.reduce(anITypeArray, Ok(false), (acc, anIType) =>
|
||||
Belt.Result.flatMap(acc, _ =>
|
||||
switch acc {
|
||||
| Ok(false) =>
|
||||
switch isITypeOf(anIType, evValue) {
|
||||
| Ok(_) => Ok(true)
|
||||
| Error(_) => acc
|
||||
}
|
||||
| _ => acc
|
||||
}
|
||||
)
|
||||
) {
|
||||
| Ok(true) => Ok(true)
|
||||
| Ok(false) => T.TypeMismatch(anIType, evValue)->Error
|
||||
| Error(error) => Error(error)
|
||||
}
|
||||
// let caseOr = (anIType, anITypeArray, evValue) =>
|
||||
// switch Belt.Array.reduce(anITypeArray, Ok(false), (acc, anIType) =>
|
||||
// Belt.Result.flatMap(acc, _ =>
|
||||
// switch acc {
|
||||
// | Ok(false) =>
|
||||
// switch isITypeOf(anIType, evValue) {
|
||||
// | Ok(_) => Ok(true)
|
||||
// | Error(_) => acc
|
||||
// }
|
||||
// | _ => acc
|
||||
// }
|
||||
// )
|
||||
// ) {
|
||||
// | Ok(true) => Ok(true)
|
||||
// | Ok(false) => T.TypeMismatch(anIType, evValue)->Error
|
||||
// | Error(error) => Error(error)
|
||||
// }
|
||||
|
||||
let caseModifiedType = (
|
||||
anIType: T.iType,
|
||||
modifiedType: T.iType,
|
||||
contracts: Belt.Map.String.t<InternalExpressionValue.t>,
|
||||
aValue: InternalExpressionValue.t,
|
||||
) => {
|
||||
isITypeOf(modifiedType, aValue)->Belt.Result.flatMap(_result => {
|
||||
if TypeContracts.checkModifiers(contracts, aValue) {
|
||||
Ok(true)
|
||||
} else {
|
||||
T.TypeMismatch(anIType, aValue)->Error
|
||||
}
|
||||
})
|
||||
}
|
||||
// let caseModifiedType = (
|
||||
// anIType: T.iType,
|
||||
// modifiedType: T.iType,
|
||||
// contracts: Belt.Map.String.t<InternalExpressionValue.t>,
|
||||
// aValue: InternalExpressionValue.t,
|
||||
// ) => {
|
||||
// isITypeOf(modifiedType, aValue)->Belt.Result.flatMap(_result => {
|
||||
// if TypeContracts.checkModifiers(contracts, aValue) {
|
||||
// Ok(true)
|
||||
// } else {
|
||||
// T.TypeMismatch(anIType, aValue)->Error
|
||||
// }
|
||||
// })
|
||||
// }
|
||||
|
||||
switch anIType {
|
||||
| ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
|
||||
| ItModifiedType({modifiedType, contracts}) =>
|
||||
caseModifiedType(anIType, modifiedType, contracts, aValue) //{modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>}
|
||||
| ItTypeOr({typeOr}) => caseOr(anIType, typeOr, aValue)
|
||||
| ItTypeFunction(_) =>
|
||||
raise(
|
||||
Reducer_Exception.ImpossibleException(
|
||||
"Reducer_TypeChecker-functions are without a type at the moment",
|
||||
),
|
||||
)
|
||||
| ItTypeArray({element}) => caseArray(anIType, element, aValue)
|
||||
| ItTypeTuple({elements}) => caseTuple(anIType, elements, aValue)
|
||||
| ItTypeRecord({properties}) => caseRecord(anIType, properties, aValue)
|
||||
}
|
||||
}
|
||||
// switch anIType {
|
||||
// | ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
|
||||
// | ItModifiedType({modifiedType, contracts}) =>
|
||||
// caseModifiedType(anIType, modifiedType, contracts, aValue) //{modifiedType: iType, contracts: Belt.Map.String.t<InternalExpressionValue.t>}
|
||||
// | ItTypeOr({typeOr}) => caseOr(anIType, typeOr, aValue)
|
||||
// | ItTypeFunction(_) =>
|
||||
// raise(
|
||||
// Reducer_Exception.ImpossibleException(
|
||||
// "Reducer_TypeChecker-functions are without a type at the moment",
|
||||
// ),
|
||||
// )
|
||||
// | ItTypeArray({element}) => caseArray(anIType, element, aValue)
|
||||
// | ItTypeTuple({elements}) => caseTuple(anIType, elements, aValue)
|
||||
// | ItTypeRecord({properties}) => caseRecord(anIType, properties, aValue)
|
||||
// }
|
||||
// }
|
||||
|
||||
let isTypeOf = (
|
||||
typeExpressionSourceCode: string,
|
||||
aValue: InternalExpressionValue.t,
|
||||
reducerFn: ProjectReducerFnT.t,
|
||||
): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
|
||||
| Ok(anIType) =>
|
||||
switch isITypeOf(anIType, aValue) {
|
||||
| Ok(_) => Ok(aValue)
|
||||
| Error(T.TypeMismatch(anIType, evValue)) =>
|
||||
Error(
|
||||
ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
|
||||
)
|
||||
}
|
||||
| Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
|
||||
}
|
||||
}
|
||||
// let isTypeOf = (
|
||||
// typeExpressionSourceCode: string,
|
||||
// aValue: InternalExpressionValue.t,
|
||||
// reducerFn: Reducer_T.reducerFn,
|
||||
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
// switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
|
||||
// | Ok(anIType) =>
|
||||
// switch isITypeOf(anIType, aValue) {
|
||||
// | Ok(_) => Ok(aValue)
|
||||
// | Error(T.TypeMismatch(anIType, evValue)) =>
|
||||
// Error(
|
||||
// ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
|
||||
// )
|
||||
// }
|
||||
// | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
|
||||
// }
|
||||
// }
|
||||
|
||||
let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue.t>): result<
|
||||
bool,
|
||||
T.typeErrorValue,
|
||||
> => {
|
||||
switch anIType {
|
||||
| T.ItTypeFunction({inputs}) => isITypeOf(T.ItTypeTuple({elements: inputs}), args->IEvArray)
|
||||
| _ => T.TypeMismatch(anIType, args->IEvArray)->Error
|
||||
}
|
||||
}
|
||||
// let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue.t>): result<
|
||||
// bool,
|
||||
// T.typeErrorValue,
|
||||
// > => {
|
||||
// switch anIType {
|
||||
// | T.ItTypeFunction({inputs}) => isITypeOf(T.ItTypeTuple({elements: inputs}), args->IEvArray)
|
||||
// | _ => T.TypeMismatch(anIType, args->IEvArray)->Error
|
||||
// }
|
||||
// }
|
||||
|
||||
let checkITypeArgumentsBool = (anIType: T.iType, args: array<InternalExpressionValue.t>): bool => {
|
||||
switch checkITypeArguments(anIType, args) {
|
||||
| Ok(_) => true
|
||||
| _ => false
|
||||
}
|
||||
}
|
||||
// let checkITypeArgumentsBool = (anIType: T.iType, args: array<InternalExpressionValue.t>): bool => {
|
||||
// switch checkITypeArguments(anIType, args) {
|
||||
// | Ok(_) => true
|
||||
// | _ => false
|
||||
// }
|
||||
// }
|
||||
|
||||
let checkArguments = (
|
||||
typeExpressionSourceCode: string,
|
||||
args: array<InternalExpressionValue.t>,
|
||||
reducerFn: ProjectReducerFnT.t,
|
||||
): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
|
||||
| Ok(anIType) =>
|
||||
switch checkITypeArguments(anIType, args) {
|
||||
| Ok(_) => Ok(args->IEvArray)
|
||||
| Error(T.TypeMismatch(anIType, evValue)) =>
|
||||
Error(
|
||||
ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
|
||||
)
|
||||
}
|
||||
| Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
|
||||
}
|
||||
}
|
||||
// let checkArguments = (
|
||||
// typeExpressionSourceCode: string,
|
||||
// args: array<InternalExpressionValue.t>,
|
||||
// reducerFn: ReducerT.reducerFn,
|
||||
// ): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
// switch typeExpressionSourceCode->Reducer_Type_Compile.fromTypeExpression(reducerFn) {
|
||||
// | Ok(anIType) =>
|
||||
// switch checkITypeArguments(anIType, args) {
|
||||
// | Ok(_) => Ok(args->IEvArray)
|
||||
// | Error(T.TypeMismatch(anIType, evValue)) =>
|
||||
// Error(
|
||||
// ErrorValue.REExpectedType(anIType->T.toString, evValue->InternalExpressionValue.toString),
|
||||
// )
|
||||
// }
|
||||
// | Error(error) => Error(error) // Directly propagating - err => err - causes type mismatch
|
||||
// }
|
||||
// }
|
||||
|
|
|
@ -1,27 +1,26 @@
|
|||
module IEV = ReducerInterface_InternalExpressionValue
|
||||
type internalExpressionValue = IEV.t
|
||||
module T = Reducer_T
|
||||
|
||||
let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
|
||||
result<internalExpressionValue, QuriSquiggleLang.Reducer_ErrorValue.errorValue>,
|
||||
let dispatch = (call: ReducerInterface_InternalExpressionValue.functionCall, _: GenericDist.env): option<
|
||||
result<T.value, Reducer_ErrorValue.errorValue>,
|
||||
> => {
|
||||
switch call {
|
||||
| ("toString", [IEvDate(t)]) => IEV.IEvString(DateTime.Date.toString(t))->Ok->Some
|
||||
| ("toString", [IEvDate(t)]) => T.IEvString(DateTime.Date.toString(t))->Ok->Some
|
||||
| ("makeDateFromYear", [IEvNumber(year)]) =>
|
||||
switch DateTime.Date.makeFromYear(year) {
|
||||
| Ok(t) => IEV.IEvDate(t)->Ok->Some
|
||||
| Ok(t) => T.IEvDate(t)->Ok->Some
|
||||
| Error(e) => Reducer_ErrorValue.RETodo(e)->Error->Some
|
||||
}
|
||||
| ("dateFromNumber", [IEvNumber(f)]) => IEV.IEvDate(DateTime.Date.fromFloat(f))->Ok->Some
|
||||
| ("toNumber", [IEvDate(f)]) => IEV.IEvNumber(DateTime.Date.toFloat(f))->Ok->Some
|
||||
| ("dateFromNumber", [IEvNumber(f)]) => T.IEvDate(DateTime.Date.fromFloat(f))->Ok->Some
|
||||
| ("toNumber", [IEvDate(f)]) => T.IEvNumber(DateTime.Date.toFloat(f))->Ok->Some
|
||||
| ("subtract", [IEvDate(d1), IEvDate(d2)]) =>
|
||||
switch DateTime.Date.subtract(d1, d2) {
|
||||
| Ok(d) => IEV.IEvTimeDuration(d)->Ok
|
||||
| Ok(d) => T.IEvTimeDuration(d)->Ok
|
||||
| Error(e) => Error(RETodo(e))
|
||||
}->Some
|
||||
| ("subtract", [IEvDate(d1), IEvTimeDuration(d2)]) =>
|
||||
IEV.IEvDate(DateTime.Date.subtractDuration(d1, d2))->Ok->Some
|
||||
T.IEvDate(DateTime.Date.subtractDuration(d1, d2))->Ok->Some
|
||||
| ("add", [IEvDate(d1), IEvTimeDuration(d2)]) =>
|
||||
IEV.IEvDate(DateTime.Date.addDuration(d1, d2))->Ok->Some
|
||||
T.IEvDate(DateTime.Date.addDuration(d1, d2))->Ok->Some
|
||||
| _ => None
|
||||
}
|
||||
}
|
||||
|
|
|
@ -1,36 +1,37 @@
|
|||
module IEV = ReducerInterface_InternalExpressionValue
|
||||
module T = Reducer_T
|
||||
type internalExpressionValue = IEV.t
|
||||
|
||||
let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
|
||||
result<internalExpressionValue, QuriSquiggleLang.Reducer_ErrorValue.errorValue>,
|
||||
let dispatch = (call: IEV.functionCall, _: T.environment): option<
|
||||
result<Reducer_T.value, Reducer_ErrorValue.errorValue>
|
||||
> => {
|
||||
switch call {
|
||||
| ("toString", [IEvTimeDuration(t)]) => IEV.IEvString(DateTime.Duration.toString(t))->Ok->Some
|
||||
| ("minutes", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
|
||||
| ("toString", [IEvTimeDuration(t)]) => T.IEvString(DateTime.Duration.toString(t))->Ok->Some
|
||||
| ("minutes", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
|
||||
| ("fromUnit_minutes", [IEvNumber(f)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
|
||||
| ("hours", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.fromMinutes(f))->Ok->Some
|
||||
| ("hours", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
|
||||
| ("fromUnit_hours", [IEvNumber(f)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
|
||||
| ("days", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.fromHours(f))->Ok->Some
|
||||
| ("days", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
|
||||
| ("fromUnit_days", [IEvNumber(f)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
|
||||
| ("years", [IEvNumber(f)]) => IEV.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.fromDays(f))->Ok->Some
|
||||
| ("years", [IEvNumber(f)]) => T.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
|
||||
| ("fromUnit_years", [IEvNumber(f)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
|
||||
| ("toHours", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toHours(f))->Ok->Some
|
||||
| ("toMinutes", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toMinutes(f))->Ok->Some
|
||||
| ("toDays", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toDays(f))->Ok->Some
|
||||
| ("toYears", [IEvTimeDuration(f)]) => IEV.IEvNumber(DateTime.Duration.toYears(f))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.fromYears(f))->Ok->Some
|
||||
| ("toHours", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toHours(f))->Ok->Some
|
||||
| ("toMinutes", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toMinutes(f))->Ok->Some
|
||||
| ("toDays", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toDays(f))->Ok->Some
|
||||
| ("toYears", [IEvTimeDuration(f)]) => T.IEvNumber(DateTime.Duration.toYears(f))->Ok->Some
|
||||
| ("add", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.add(d1, d2))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.add(d1, d2))->Ok->Some
|
||||
| ("subtract", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.subtract(d1, d2))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.subtract(d1, d2))->Ok->Some
|
||||
| ("multiply", [IEvTimeDuration(d1), IEvNumber(d2)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.multiply(d1, d2))->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.multiply(d1, d2))->Ok->Some
|
||||
| ("divide", [IEvTimeDuration(d1), IEvNumber(d2)]) =>
|
||||
IEV.IEvTimeDuration(DateTime.Duration.divide(d1, d2))->Ok->Some
|
||||
| ("divide", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) => IEV.IEvNumber(d1 /. d2)->Ok->Some
|
||||
T.IEvTimeDuration(DateTime.Duration.divide(d1, d2))->Ok->Some
|
||||
| ("divide", [IEvTimeDuration(d1), IEvTimeDuration(d2)]) => T.IEvNumber(d1 /. d2)->Ok->Some
|
||||
| _ => None
|
||||
}
|
||||
}
|
||||
|
|
|
@ -1,24 +1,21 @@
|
|||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectReducerFnT = ReducerProject_ReducerFn_T
|
||||
type internalExpressionValue = InternalExpressionValue.t
|
||||
|
||||
/*
|
||||
Map external calls of Reducer
|
||||
*/
|
||||
let dispatch = (
|
||||
call: InternalExpressionValue.functionCall,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
reducer: ProjectReducerFnT.t,
|
||||
environment: Reducer_T.environment,
|
||||
reducer: Reducer_T.reducerFn,
|
||||
chain,
|
||||
): result<internalExpressionValue, 'e> => {
|
||||
): result<Reducer_T.value, 'e> => {
|
||||
E.A.O.firstSomeFn([
|
||||
() => ReducerInterface_GenericDistribution.dispatch(call, accessors.environment),
|
||||
() => ReducerInterface_Date.dispatch(call, accessors.environment),
|
||||
() => ReducerInterface_Duration.dispatch(call, accessors.environment),
|
||||
() => ReducerInterface_Number.dispatch(call, accessors.environment),
|
||||
() => FunctionRegistry_Library.dispatch(call, accessors, reducer),
|
||||
])->E.O2.defaultFn(() => chain(call, accessors, reducer))
|
||||
() => ReducerInterface_GenericDistribution.dispatch(call, environment),
|
||||
() => ReducerInterface_Date.dispatch(call, environment),
|
||||
() => ReducerInterface_Duration.dispatch(call, environment),
|
||||
() => ReducerInterface_Number.dispatch(call, environment),
|
||||
() => FunctionRegistry_Library.dispatch(call, environment, reducer),
|
||||
])->E.O2.defaultFn(() => chain(call, environment, reducer))
|
||||
}
|
||||
|
||||
/*
|
||||
|
@ -26,7 +23,7 @@ If your dispatch is too big you can divide it into smaller dispatches and pass t
|
|||
|
||||
The final chain(call) invokes the builtin default functions of the interpreter.
|
||||
|
||||
Via chain(call), all MathJs operators and functions are available for string, number , boolean, array and record
|
||||
Via chain(call), all MathJs operators and functions are available for string, number, boolean, array and record
|
||||
.e.g + - / * > >= < <= == /= not and or sin cos log ln concat, etc.
|
||||
|
||||
// See https://mathjs.org/docs/expressions/syntax.html
|
||||
|
|
|
@ -297,12 +297,12 @@ let genericOutputToReducerValue = (o: DistributionOperation.outputType): result<
|
|||
Reducer_ErrorValue.errorValue,
|
||||
> =>
|
||||
switch o {
|
||||
| Dist(d) => Ok(ReducerInterface_InternalExpressionValue.IEvDistribution(d))
|
||||
| Dist(d) => Ok(Reducer_T.IEvDistribution(d))
|
||||
| Float(d) => Ok(IEvNumber(d))
|
||||
| String(d) => Ok(IEvString(d))
|
||||
| Bool(d) => Ok(IEvBool(d))
|
||||
| FloatArray(d) =>
|
||||
Ok(IEvArray(d |> E.A.fmap(r => ReducerInterface_InternalExpressionValue.IEvNumber(r))))
|
||||
Ok(IEvArray(d |> E.A.fmap(r => Reducer_T.IEvNumber(r))))
|
||||
| GenDistError(err) => Error(REDistributionError(err))
|
||||
}
|
||||
|
||||
|
|
|
@ -1,51 +1,26 @@
|
|||
// deprecated, use Reducer_T instead
|
||||
// (value methods should be moved to Reducer_Value.res)
|
||||
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module Extra_Array = Reducer_Extra_Array
|
||||
type internalCode = Object
|
||||
type environment = GenericDist.env
|
||||
module T = Reducer_T
|
||||
|
||||
let defaultEnvironment: environment = DistributionOperation.defaultEnv
|
||||
|
||||
@genType.opaque
|
||||
type rec t =
|
||||
| IEvArray(array<t>) // FIXME: Convert to MapInt
|
||||
| IEvArrayString(array<string>)
|
||||
| IEvBool(bool)
|
||||
| IEvCall(string) // External function call
|
||||
| IEvDate(Js.Date.t)
|
||||
| IEvDeclaration(lambdaDeclaration)
|
||||
| IEvDistribution(DistributionTypes.genericDist)
|
||||
| IEvLambda(lambdaValue)
|
||||
| IEvBindings(nameSpace)
|
||||
| IEvNumber(float)
|
||||
| IEvRecord(map)
|
||||
| IEvString(string)
|
||||
| IEvSymbol(string)
|
||||
| IEvTimeDuration(float)
|
||||
| IEvType(map)
|
||||
| IEvTypeIdentifier(string)
|
||||
| IEvVoid
|
||||
@genType.opaque and squiggleArray = array<t>
|
||||
@genType.opaque and map = Belt.Map.String.t<t>
|
||||
@genType.opaque and nameSpace = NameSpace(Belt.MutableMap.String.t<t>, option<nameSpace>)
|
||||
@genType.opaque
|
||||
and lambdaValue = {
|
||||
parameters: array<string>,
|
||||
context: nameSpace,
|
||||
body: internalCode,
|
||||
}
|
||||
@genType.opaque and lambdaDeclaration = Declaration.declaration<lambdaValue>
|
||||
type t = Reducer_T.value
|
||||
|
||||
type internalExpressionValue = t
|
||||
|
||||
type functionCall = (string, array<t>)
|
||||
|
||||
let rec toString = aValue =>
|
||||
let rec toString = (aValue: T.value) =>
|
||||
switch aValue {
|
||||
| IEvArray(anArray) => toStringArray(anArray)
|
||||
| IEvArrayString(anArray) => toStringArrayString(anArray)
|
||||
| IEvBindings(m) => toStringBindings(m)
|
||||
| IEvBool(aBool) => toStringBool(aBool)
|
||||
| IEvCall(fName) => toStringCall(fName)
|
||||
// | IEvCall(fName) => toStringCall(fName)
|
||||
| IEvDate(date) => toStringDate(date)
|
||||
| IEvDeclaration(d) => toStringDeclaration(d)
|
||||
| IEvDistribution(dist) => toStringDistribution(dist)
|
||||
|
@ -53,7 +28,7 @@ let rec toString = aValue =>
|
|||
| IEvNumber(aNumber) => toStringNumber(aNumber)
|
||||
| IEvRecord(aMap) => aMap->toStringRecord
|
||||
| IEvString(aString) => toStringString(aString)
|
||||
| IEvSymbol(aString) => toStringSymbol(aString)
|
||||
// | IEvSymbol(aString) => toStringSymbol(aString)
|
||||
| IEvTimeDuration(t) => toStringTimeDuration(t)
|
||||
| IEvType(aMap) => toStringType(aMap)
|
||||
| IEvTypeIdentifier(id) => toStringTypeIdentifier(id)
|
||||
|
@ -73,9 +48,12 @@ and toStringCall = fName => `:${fName}`
|
|||
and toStringDate = date => DateTime.Date.toString(date)
|
||||
and toStringDeclaration = d => Declaration.toString(d, r => toString(IEvLambda(r)))
|
||||
and toStringDistribution = dist => GenericDist.toString(dist)
|
||||
and toStringLambda = lambdaValue =>
|
||||
`lambda(${Js.Array2.toString(lambdaValue.parameters)}=>internal code)`
|
||||
and toStringFunction = lambdaValue => `function(${Js.Array2.toString(lambdaValue.parameters)})`
|
||||
and toStringLambda = (lambdaValue: T.lambdaValue) =>
|
||||
switch lambdaValue {
|
||||
| LNoFFI({ parameters }) => `lambda(${parameters->Js.Array2.toString}=>internal code)` // TODO - serialize code too?
|
||||
| LFFI(_) => `standard function` // TODO - serialize name, etc?
|
||||
}
|
||||
and toStringFunction = (lambdaValue: T.lambdaValue) => `function(${Js.Array2.toString(lambdaValue.parameters)})`
|
||||
and toStringNumber = aNumber => Js.String.make(aNumber)
|
||||
and toStringRecord = aMap => aMap->toStringMap
|
||||
and toStringString = aString => `'${aString}'`
|
||||
|
@ -94,17 +72,25 @@ and toStringMap = aMap => {
|
|||
`{${pairs}}`
|
||||
}
|
||||
and toStringNameSpace = nameSpace => {
|
||||
let NameSpace(container, parent) = nameSpace
|
||||
FIXME_CALL_PARENTS
|
||||
container->toStringMap
|
||||
let T.NameSpace(container, parent) = nameSpace
|
||||
let pairs =
|
||||
container
|
||||
->Belt.MutableMap.String.toArray
|
||||
->Js.Array2.map(((eachKey, eachValue)) => `${eachKey}: ${toString(eachValue)}`)
|
||||
->Js.Array2.toString
|
||||
|
||||
switch parent {
|
||||
| Some(p) => `{${pairs}} / ${toStringNameSpace(p)}`
|
||||
| None => `{${pairs}}`
|
||||
}
|
||||
}
|
||||
|
||||
let toStringWithType = aValue =>
|
||||
let toStringWithType = (aValue: T.value) =>
|
||||
switch aValue {
|
||||
| IEvArray(_) => `Array::${toString(aValue)}`
|
||||
| IEvArrayString(_) => `ArrayString::${toString(aValue)}`
|
||||
| IEvBool(_) => `Bool::${toString(aValue)}`
|
||||
| IEvCall(_) => `Call::${toString(aValue)}`
|
||||
// | IEvCall(_) => `Call::${toString(aValue)}`
|
||||
| IEvDate(_) => `Date::${toString(aValue)}`
|
||||
| IEvDeclaration(_) => `Declaration::${toString(aValue)}`
|
||||
| IEvDistribution(_) => `Distribution::${toString(aValue)}`
|
||||
|
@ -113,7 +99,7 @@ let toStringWithType = aValue =>
|
|||
| IEvNumber(_) => `Number::${toString(aValue)}`
|
||||
| IEvRecord(_) => `Record::${toString(aValue)}`
|
||||
| IEvString(_) => `String::${toString(aValue)}`
|
||||
| IEvSymbol(_) => `Symbol::${toString(aValue)}`
|
||||
// | IEvSymbol(_) => `Symbol::${toString(aValue)}`
|
||||
| IEvTimeDuration(_) => `Date::${toString(aValue)}`
|
||||
| IEvType(_) => `Type::${toString(aValue)}`
|
||||
| IEvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}`
|
||||
|
@ -154,7 +140,7 @@ type internalExpressionValueType =
|
|||
| EvtArray
|
||||
| EvtArrayString
|
||||
| EvtBool
|
||||
| EvtCall
|
||||
// | EvtCall
|
||||
| EvtDate
|
||||
| EvtDeclaration
|
||||
| EvtDistribution
|
||||
|
@ -163,7 +149,7 @@ type internalExpressionValueType =
|
|||
| EvtNumber
|
||||
| EvtRecord
|
||||
| EvtString
|
||||
| EvtSymbol
|
||||
// | EvtSymbol
|
||||
| EvtTimeDuration
|
||||
| EvtType
|
||||
| EvtTypeIdentifier
|
||||
|
@ -173,12 +159,12 @@ type functionCallSignature = CallSignature(string, array<internalExpressionValue
|
|||
type functionDefinitionSignature =
|
||||
FunctionDefinitionSignature(functionCallSignature, internalExpressionValueType)
|
||||
|
||||
let valueToValueType = value =>
|
||||
let valueToValueType = (value: T.value) =>
|
||||
switch value {
|
||||
| IEvArray(_) => EvtArray
|
||||
| IEvArrayString(_) => EvtArrayString
|
||||
| IEvBool(_) => EvtBool
|
||||
| IEvCall(_) => EvtCall
|
||||
// | IEvCall(_) => EvtCall
|
||||
| IEvDate(_) => EvtDate
|
||||
| IEvDeclaration(_) => EvtDeclaration
|
||||
| IEvDistribution(_) => EvtDistribution
|
||||
|
@ -187,7 +173,7 @@ let valueToValueType = value =>
|
|||
| IEvNumber(_) => EvtNumber
|
||||
| IEvRecord(_) => EvtRecord
|
||||
| IEvString(_) => EvtString
|
||||
| IEvSymbol(_) => EvtSymbol
|
||||
// | IEvSymbol(_) => EvtSymbol
|
||||
| IEvTimeDuration(_) => EvtTimeDuration
|
||||
| IEvType(_) => EvtType
|
||||
| IEvTypeIdentifier(_) => EvtTypeIdentifier
|
||||
|
@ -204,7 +190,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
|
|||
| EvtArray => `Array`
|
||||
| EvtArrayString => `ArrayString`
|
||||
| EvtBool => `Bool`
|
||||
| EvtCall => `Call`
|
||||
// | EvtCall => `Call`
|
||||
| EvtDate => `Date`
|
||||
| EvtDeclaration => `Declaration`
|
||||
| EvtDistribution => `Distribution`
|
||||
|
@ -213,7 +199,7 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
|
|||
| EvtNumber => `Number`
|
||||
| EvtRecord => `Record`
|
||||
| EvtString => `String`
|
||||
| EvtSymbol => `Symbol`
|
||||
// | EvtSymbol => `Symbol`
|
||||
| EvtTimeDuration => `Duration`
|
||||
| EvtType => `Type`
|
||||
| EvtTypeIdentifier => `TypeIdentifier`
|
||||
|
@ -227,10 +213,4 @@ let functionCallSignatureToString = (functionCallSignature: functionCallSignatur
|
|||
|
||||
let arrayToValueArray = (arr: array<t>): array<t> => arr
|
||||
|
||||
let recordToKeyValuePairs = (record: map): array<(string, t)> => record->Belt.Map.String.toArray
|
||||
|
||||
let nameSpaceToKeyValuePairs = (nameSpace: nameSpace): array<(string, t)> => {
|
||||
let NameSpace(container, parent) = nameSpace
|
||||
FIXME_CALL_PARENTS
|
||||
container->Belt.MutableMap.String.toArray
|
||||
}
|
||||
let recordToKeyValuePairs = (record: T.map): array<(string, t)> => record->Belt.Map.String.toArray
|
||||
|
|
|
@ -39,7 +39,7 @@ let dispatch = (call: IEV.functionCall, _: GenericDist.env): option<
|
|||
| "fromUnit_P") as op,
|
||||
[IEvNumber(f)],
|
||||
) =>
|
||||
op->ScientificUnit.getMultiplier->E.O2.fmap(multiplier => IEV.IEvNumber(f *. multiplier)->Ok)
|
||||
op->ScientificUnit.getMultiplier->E.O2.fmap(multiplier => Reducer_T.IEvNumber(f *. multiplier)->Ok)
|
||||
| _ => None
|
||||
}
|
||||
}
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
|
||||
let internalStdLib: Bindings.t =
|
||||
Bindings.emptyBindings->SquiggleLibrary_Math.makeBindings->SquiggleLibrary_Versions.makeBindings
|
||||
let internalStdLib: Reducer_Bindings.t =
|
||||
Reducer_Bindings.makeEmptyBindings()
|
||||
->SquiggleLibrary_Math.makeBindings
|
||||
->SquiggleLibrary_Versions.makeBindings
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
|
||||
type t = InternalExpressionValue.nameSpace
|
||||
type t = Reducer_T.nameSpace
|
||||
|
||||
let toValue = nameSpace => InternalExpressionValue.IEvBindings(nameSpace)
|
||||
let toValue = nameSpace => Reducer_T.IEvBindings(nameSpace)
|
||||
let toString = nameSpace => InternalExpressionValue.toString(toValue(nameSpace))
|
||||
let toStringResult = rNameSpace =>
|
||||
Belt.Result.map(rNameSpace, toValue(_))->InternalExpressionValue.toStringResult
|
||||
|
@ -19,9 +19,3 @@ let inspectOption = (oNameSpace, label: string) =>
|
|||
| Some(nameSpace) => inspect(nameSpace, label)
|
||||
| None => Js.log(`${label}: None`)
|
||||
}
|
||||
|
||||
let minus = (NameSpace(thisContainer): t, NameSpace(thatContainer): t) => {
|
||||
InternalExpressionValue.NameSpace(
|
||||
Belt.Map.String.removeMany(thisContainer, Belt.Map.String.keysToArray(thatContainer)),
|
||||
)
|
||||
}
|
||||
|
|
|
@ -4,263 +4,247 @@ module Bindings = Reducer_Bindings
|
|||
module Continuation = ReducerInterface_Value_Continuation
|
||||
module ErrorValue = Reducer_ErrorValue
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ProjectItem = ReducerProject_ProjectItem
|
||||
module T = ReducerProject_T
|
||||
module Topology = ReducerProject_Topology
|
||||
|
||||
type t = T.t
|
||||
|
||||
module Private = {
|
||||
type internalProject = T.Private.t
|
||||
type t = T.Private.t
|
||||
let getItem = T.getItem
|
||||
let getSourceIds = T.getSourceIds
|
||||
let getDependents = Topology.getDependents
|
||||
let getDependencies = Topology.getDependencies
|
||||
let getRunOrder = Topology.getRunOrder
|
||||
let getRunOrderFor = Topology.getRunOrderFor
|
||||
|
||||
let getSourceIds = T.Private.getSourceIds
|
||||
let getItem = T.Private.getItem
|
||||
let getDependents = Topology.getDependents
|
||||
let getDependencies = Topology.getDependencies
|
||||
let getRunOrder = Topology.getRunOrder
|
||||
let getRunOrderFor = Topology.getRunOrderFor
|
||||
let createProject = () => {
|
||||
let project: t = {
|
||||
items: Belt.MutableMap.String.make(),
|
||||
stdLib: ReducerInterface_StdLib.internalStdLib,
|
||||
environment: InternalExpressionValue.defaultEnvironment,
|
||||
previousRunOrder: [],
|
||||
}
|
||||
project
|
||||
}
|
||||
|
||||
let createProject = () => {
|
||||
let project: t = {
|
||||
"iAmProject": true,
|
||||
"items": Belt.Map.String.empty,
|
||||
"stdLib": ReducerInterface_StdLib.internalStdLib,
|
||||
"environment": InternalExpressionValue.defaultEnvironment,
|
||||
"previousRunOrder": [],
|
||||
}
|
||||
project
|
||||
// will not be necessary when ProjectItem becomes mutable
|
||||
let setItem = (project: t, sourceId: string, item: ProjectItem.t): unit => {
|
||||
let _ = Belt.MutableMap.String.set(project.items, sourceId, item)
|
||||
}
|
||||
|
||||
let rec touchSource_ = (project: t, sourceId: string): unit => {
|
||||
let item = project->getItem(sourceId)
|
||||
let newItem = ProjectItem.touchSource(item)
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
and touchDependents = (project: t, sourceId: string): unit => {
|
||||
let _ = getDependents(project, sourceId)->Belt.Array.forEach(_, touchSource_(project, _))
|
||||
}
|
||||
|
||||
let touchSource = (project: t, sourceId: string): unit => {
|
||||
touchSource_(project, sourceId)
|
||||
touchDependents(project, sourceId)
|
||||
}
|
||||
|
||||
let handleNewTopology = (project: t): unit => {
|
||||
let previousRunOrder = project.previousRunOrder
|
||||
let currentRunOrder = Topology.getRunOrder(project)
|
||||
let diff = Topology.runOrderDiff(currentRunOrder, previousRunOrder)
|
||||
Belt.Array.forEach(diff, touchSource(project, _))
|
||||
project.previousRunOrder = currentRunOrder
|
||||
}
|
||||
|
||||
let getSource = (project: t, sourceId: string): option<string> =>
|
||||
Belt.MutableMap.String.get(project.items, sourceId)->Belt.Option.map(ProjectItem.getSource)
|
||||
|
||||
let setSource = (project: t, sourceId: string, value: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setSource(value)
|
||||
project->setItem(sourceId, newItem)
|
||||
touchDependents(project, sourceId)
|
||||
}
|
||||
|
||||
let clean = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.clean
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
let cleanAll = (project: t): unit =>
|
||||
project->getSourceIds->Belt.Array.forEach(sourceId => clean(project, sourceId))
|
||||
|
||||
let cleanResults = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.cleanResults
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
let cleanAllResults = (project: t): unit =>
|
||||
project->getSourceIds->Belt.Array.forEach(sourceId => project->cleanResults(sourceId))
|
||||
|
||||
let getIncludes = (project: t, sourceId: string): ProjectItem.T.includesType =>
|
||||
project->getItem(sourceId)->ProjectItem.getIncludes
|
||||
|
||||
let getPastChain = (project: t, sourceId: string): array<string> =>
|
||||
project->getItem(sourceId)->ProjectItem.getPastChain
|
||||
|
||||
let getIncludesAsVariables = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
): ProjectItem.T.importAsVariablesType =>
|
||||
project->getItem(sourceId)->ProjectItem.getIncludesAsVariables
|
||||
|
||||
let getDirectIncludes = (project: t, sourceId: string): array<string> =>
|
||||
project->getItem(sourceId)->ProjectItem.getDirectIncludes
|
||||
|
||||
let setContinues = (project: t, sourceId: string, continues: array<string>): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setContinues(continues)
|
||||
project->setItem(sourceId, newItem)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
let getContinues = (project: t, sourceId: string): array<string> =>
|
||||
ProjectItem.getContinues(project->getItem(sourceId))
|
||||
|
||||
let removeContinues = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.removeContinues
|
||||
project->setItem(sourceId, newItem)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
|
||||
let getContinuation = (project: t, sourceId: string): ProjectItem.T.continuationArgumentType =>
|
||||
project->getItem(sourceId)->ProjectItem.getContinuation
|
||||
|
||||
let setContinuation = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
continuation: ProjectItem.T.continuationArgumentType,
|
||||
): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setContinuation(continuation)
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
let getResultOption = (project: t, sourceId: string): ProjectItem.T.resultType =>
|
||||
project->getItem(sourceId)->ProjectItem.getResult
|
||||
|
||||
let getResult = (project: t, sourceId: string): ProjectItem.T.resultArgumentType =>
|
||||
switch getResultOption(project, sourceId) {
|
||||
| None => RENeedToRun->Error
|
||||
| Some(result) => result
|
||||
}
|
||||
|
||||
let rec touchSource_ = (project: t, sourceId: string): unit => {
|
||||
let item = project->getItem(sourceId)
|
||||
let newItem = ProjectItem.touchSource(item)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
and touchDependents = (project: t, sourceId: string): unit => {
|
||||
let _ = getDependents(project, sourceId)->Belt.Array.forEach(_, touchSource_(project, _))
|
||||
let setResult = (project: t, sourceId: string, value: ProjectItem.T.resultArgumentType): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setResult(value)
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
let parseIncludes = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.parseIncludes
|
||||
project->setItem(sourceId, newItem)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
|
||||
let rawParse = (project: t, sourceId): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.rawParse
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
let getStdLib = (project: t): Reducer_Bindings.t => project.stdLib
|
||||
let setStdLib = (project: t, value: Reducer_Bindings.t): unit => {
|
||||
project.stdLib = value
|
||||
}
|
||||
|
||||
let getEnvironment = (project: t): InternalExpressionValue.environment => project.environment
|
||||
let setEnvironment = (project: t, value: InternalExpressionValue.environment): unit => {
|
||||
project.environment = value
|
||||
}
|
||||
|
||||
let getBindings = (project: t, sourceId: string): ProjectItem.T.bindingsArgumentType => {
|
||||
project->getContinuation(sourceId) // TODO - locals method for cleaning parent?
|
||||
}
|
||||
|
||||
let getContinuationsBefore = (project: t, sourceId: string): array<
|
||||
ProjectItem.T.continuation,
|
||||
> => {
|
||||
let pastNameSpaces = project->getPastChain(sourceId)->Js.Array2.map(getBindings(project, _))
|
||||
let theLength = pastNameSpaces->Js.Array2.length
|
||||
if theLength == 0 {
|
||||
// `getContinuationBefore ${sourceId}: stdLib`->Js.log
|
||||
[project->getStdLib]
|
||||
} else {
|
||||
// `getContinuationBefore ${sourceId}: ${lastOne} = ${InternalExpressionValue.toStringBindings(
|
||||
// project->getBindings(lastOne),
|
||||
// )}`->Js.log
|
||||
pastNameSpaces
|
||||
}
|
||||
}
|
||||
|
||||
let touchSource = (project: t, sourceId: string): unit => {
|
||||
touchSource_(project, sourceId)
|
||||
touchDependents(project, sourceId)
|
||||
}
|
||||
|
||||
let handleNewTopology = (project: t): unit => {
|
||||
let previousRunOrder = project["previousRunOrder"]
|
||||
let currentRunOrder = Topology.getRunOrder(project)
|
||||
let diff = Topology.runOrderDiff(currentRunOrder, previousRunOrder)
|
||||
Belt.Array.forEach(diff, touchSource(project, _))
|
||||
T.Private.setFieldPreviousRunOrder(project, currentRunOrder)
|
||||
}
|
||||
|
||||
let getSource = (project: t, sourceId: string): option<string> =>
|
||||
Belt.Map.String.get(project["items"], sourceId)->Belt.Option.map(ProjectItem.getSource)
|
||||
|
||||
let setSource = (project: t, sourceId: string, value: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setSource(value)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
touchDependents(project, sourceId)
|
||||
}
|
||||
|
||||
let clean = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.clean
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
|
||||
let cleanAll = (project: t): unit =>
|
||||
getSourceIds(project)->Belt.Array.forEach(sourceId => clean(project, sourceId))
|
||||
|
||||
let cleanResults = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.cleanResults
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
|
||||
let cleanAllResults = (project: t): unit =>
|
||||
getSourceIds(project)->Belt.Array.forEach(sourceId => cleanResults(project, sourceId))
|
||||
|
||||
let getIncludes = (project: t, sourceId: string): ProjectItem.T.includesType =>
|
||||
project->getItem(sourceId)->ProjectItem.getIncludes
|
||||
|
||||
// let getDirectIncludes = (project: t, sourceId: string): array<string> =>
|
||||
// project->getItem(sourceId)->ProjectItem.getDirectIncludes
|
||||
|
||||
let getPastChain = (project: t, sourceId: string): array<string> =>
|
||||
project->getItem(sourceId)->ProjectItem.getPastChain
|
||||
|
||||
let getIncludesAsVariables = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
): ProjectItem.T.importAsVariablesType =>
|
||||
project->getItem(sourceId)->ProjectItem.getIncludesAsVariables
|
||||
|
||||
let getDirectIncludes = (project: t, sourceId: string): array<string> =>
|
||||
project->getItem(sourceId)->ProjectItem.getDirectIncludes
|
||||
|
||||
let setContinues = (project: t, sourceId: string, continues: array<string>): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setContinues(continues)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
let getContinues = (project: t, sourceId: string): array<string> =>
|
||||
ProjectItem.getContinues(project->getItem(sourceId))
|
||||
|
||||
let removeContinues = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.removeContinues
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
|
||||
let getContinuation = (project: t, sourceId: string): ProjectItem.T.continuationArgumentType =>
|
||||
project->getItem(sourceId)->ProjectItem.getContinuation
|
||||
|
||||
let setContinuation = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
continuation: ProjectItem.T.continuationArgumentType,
|
||||
): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setContinuation(continuation)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
|
||||
let getResultOption = (project: t, sourceId: string): ProjectItem.T.resultType =>
|
||||
project->getItem(sourceId)->ProjectItem.getResult
|
||||
|
||||
let getResult = (project: t, sourceId: string): ProjectItem.T.resultArgumentType =>
|
||||
switch getResultOption(project, sourceId) {
|
||||
| None => RENeedToRun->Error
|
||||
| Some(result) => result
|
||||
}
|
||||
|
||||
let setResult = (project: t, sourceId: string, value: ProjectItem.T.resultArgumentType): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.setResult(value)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
|
||||
let parseIncludes = (project: t, sourceId: string): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.parseIncludes
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
handleNewTopology(project)
|
||||
}
|
||||
|
||||
let rawParse = (project: t, sourceId): unit => {
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.rawParse
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
}
|
||||
|
||||
let getStdLib = (project: t): Reducer_Bindings.t => project["stdLib"]
|
||||
let setStdLib = (project: t, value: Reducer_Bindings.t): unit =>
|
||||
T.Private.setFieldStdLib(project, value)
|
||||
|
||||
let getEnvironment = (project: t): InternalExpressionValue.environment => project["environment"]
|
||||
let setEnvironment = (project: t, value: InternalExpressionValue.environment): unit =>
|
||||
T.Private.setFieldEnvironment(project, value)
|
||||
|
||||
let getBindings = (project: t, sourceId: string): ProjectItem.T.bindingsArgumentType => {
|
||||
let those = project->getContinuation(sourceId)
|
||||
let these = project->getStdLib
|
||||
let ofUser = Continuation.minus(those, these)
|
||||
ofUser
|
||||
}
|
||||
|
||||
let buildProjectAccessors = (project: t): ProjectAccessorsT.t => {
|
||||
states: {continuation: Bindings.emptyBindings},
|
||||
stdLib: getStdLib(project),
|
||||
environment: getEnvironment(project),
|
||||
}
|
||||
|
||||
let getContinuationsBefore = (project: t, sourceId: string): array<
|
||||
ProjectItem.T.continuation,
|
||||
> => {
|
||||
let pastNameSpaces = project->getPastChain(sourceId)->Belt.Array.map(getBindings(project, _))
|
||||
let theLength = Belt.Array.length(pastNameSpaces)
|
||||
if theLength == 0 {
|
||||
// `getContinuationBefore ${sourceId}: stdLib`->Js.log
|
||||
[project->getStdLib]
|
||||
} else {
|
||||
// `getContinuationBefore ${sourceId}: ${lastOne} = ${InternalExpressionValue.toStringBindings(
|
||||
// project->getBindings(lastOne),
|
||||
// )}`->Js.log
|
||||
pastNameSpaces
|
||||
}
|
||||
}
|
||||
|
||||
let linkDependencies = (project: t, sourceId: string): ProjectItem.T.continuation => {
|
||||
module NameSpace = Reducer_Bindings
|
||||
let continuationsBefore = project->getContinuationsBefore(sourceId)
|
||||
let nameSpace = NameSpace.emptyNameSpace->NameSpace.chainTo(continuationsBefore)
|
||||
let includesAsVariables = project->getIncludesAsVariables(sourceId)
|
||||
Belt.Array.reduce(includesAsVariables, nameSpace, (currentNameSpace, (variable, includeFile)) =>
|
||||
Bindings.set(
|
||||
currentNameSpace,
|
||||
variable,
|
||||
getBindings(project, includeFile)->InternalExpressionValue.IEvBindings,
|
||||
)
|
||||
let linkDependencies = (project: t, sourceId: string): ProjectItem.T.continuation => {
|
||||
let continuationsBefore = project->getContinuationsBefore(sourceId)
|
||||
let nameSpace = Reducer_Bindings.makeEmptyBindings()->Reducer_Bindings.chainTo(continuationsBefore)
|
||||
let includesAsVariables = project->getIncludesAsVariables(sourceId)
|
||||
Belt.Array.reduce(includesAsVariables, nameSpace, (currentNameSpace, (variable, includeFile)) =>
|
||||
Bindings.set(
|
||||
currentNameSpace,
|
||||
variable,
|
||||
getBindings(project, includeFile)->Reducer_T.IEvBindings,
|
||||
)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
let doLinkAndRun = (project: t, sourceId: string): unit => {
|
||||
let accessors = buildProjectAccessors(project)
|
||||
let states = accessors.states
|
||||
let continuation = linkDependencies(project, sourceId)
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.run(continuation, accessors)
|
||||
Belt.Map.String.set(project["items"], sourceId, newItem)->T.Private.setFieldItems(project, _)
|
||||
setContinuation(project, sourceId, states.continuation)
|
||||
}
|
||||
let doLinkAndRun = (project: t, sourceId: string): unit => {
|
||||
let context = Reducer_Context.createContext(project->getStdLib, project->getEnvironment)
|
||||
// FIXME: fill context with dependencies
|
||||
// let continuation = linkDependencies(project, sourceId)
|
||||
let newItem = project->getItem(sourceId)->ProjectItem.run(context)
|
||||
Js.log("after run " ++ newItem.continuation->Reducer_Bindings.toString)
|
||||
project->setItem(sourceId, newItem)
|
||||
}
|
||||
|
||||
type runState = ProjectItem.T.resultArgumentType
|
||||
type runState = ProjectItem.T.resultArgumentType
|
||||
|
||||
let tryRunWithResult = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
rPrevResult: ProjectItem.T.resultArgumentType,
|
||||
): ProjectItem.T.resultArgumentType => {
|
||||
switch getResultOption(project, sourceId) {
|
||||
| Some(result) => result // already ran
|
||||
| None =>
|
||||
switch rPrevResult {
|
||||
| Error(error) => {
|
||||
setResult(project, sourceId, Error(error))
|
||||
Error(error)
|
||||
}
|
||||
| Ok(_prevResult) => {
|
||||
doLinkAndRun(project, sourceId)
|
||||
getResultOption(project, sourceId)->Belt.Option.getWithDefault(rPrevResult)
|
||||
}
|
||||
let tryRunWithResult = (
|
||||
project: t,
|
||||
sourceId: string,
|
||||
rPrevResult: ProjectItem.T.resultArgumentType,
|
||||
): ProjectItem.T.resultArgumentType => {
|
||||
switch getResultOption(project, sourceId) {
|
||||
| Some(result) => result // already ran
|
||||
| None =>
|
||||
switch rPrevResult {
|
||||
| Error(error) => {
|
||||
setResult(project, sourceId, Error(error))
|
||||
Error(error)
|
||||
}
|
||||
| Ok(_prevResult) => {
|
||||
doLinkAndRun(project, sourceId)
|
||||
getResultOption(project, sourceId)->Belt.Option.getWithDefault(rPrevResult)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
let runAll = (project: t): unit => {
|
||||
let runOrder = Topology.getRunOrder(project)
|
||||
let initialState = Ok(InternalExpressionValue.IEvVoid)
|
||||
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
|
||||
tryRunWithResult(project, currId, currState)
|
||||
)
|
||||
}
|
||||
|
||||
let run = (project: t, sourceId: string): unit => {
|
||||
let runOrder = Topology.getRunOrderFor(project, sourceId)
|
||||
let initialState = Ok(InternalExpressionValue.IEvVoid)
|
||||
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
|
||||
tryRunWithResult(project, currId, currState)
|
||||
)
|
||||
}
|
||||
|
||||
let evaluate = (sourceCode: string) => {
|
||||
let project = createProject()
|
||||
setSource(project, "main", sourceCode)
|
||||
runAll(project)
|
||||
let those = project->getContinuation("main")
|
||||
let these = project->getStdLib
|
||||
let ofUser = Continuation.minus(those, these)
|
||||
|
||||
(
|
||||
getResultOption(project, "main")->Belt.Option.getWithDefault(
|
||||
InternalExpressionValue.IEvVoid->Ok,
|
||||
),
|
||||
ofUser,
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
let runAll = (project: t): unit => {
|
||||
let runOrder = Topology.getRunOrder(project)
|
||||
let initialState = Ok(Reducer_T.IEvVoid)
|
||||
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
|
||||
tryRunWithResult(project, currId, currState)
|
||||
)
|
||||
}
|
||||
|
||||
let run = (project: t, sourceId: string): unit => {
|
||||
let runOrder = Topology.getRunOrderFor(project, sourceId)
|
||||
let initialState = Ok(Reducer_T.IEvVoid)
|
||||
let _finalState = Belt.Array.reduce(runOrder, initialState, (currState, currId) =>
|
||||
tryRunWithResult(project, currId, currState)
|
||||
)
|
||||
}
|
||||
|
||||
let evaluate = (sourceCode: string) => {
|
||||
let project = createProject()
|
||||
setSource(project, "main", sourceCode)
|
||||
runAll(project)
|
||||
|
||||
(
|
||||
getResultOption(project, "main")->Belt.Option.getWithDefault(
|
||||
Reducer_T.IEvVoid->Ok,
|
||||
),
|
||||
project->getBindings("main")
|
||||
)
|
||||
}
|
||||
|
|
|
@ -1,40 +1,30 @@
|
|||
module ProjectItemT = ReducerProject_ProjectItem_T
|
||||
module Bindings = Reducer_Bindings
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
// module ProjectItemT = ReducerProject_ProjectItem_T
|
||||
// module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
|
||||
type states = {mutable continuation: ProjectItemT.continuationArgumentType}
|
||||
// type states = {mutable continuation: ProjectItemT.continuationArgumentType}
|
||||
|
||||
type projectAccessors = {
|
||||
stdLib: Reducer_Bindings.t,
|
||||
environment: ExpressionT.environment,
|
||||
states: states,
|
||||
}
|
||||
// type projectAccessors = {
|
||||
// stdLib: Reducer_Bindings.t,
|
||||
// environment: Reducer_T.environment,
|
||||
// states: states,
|
||||
// }
|
||||
|
||||
type t = projectAccessors
|
||||
// type t = projectAccessors
|
||||
|
||||
let identityAccessors: t = {
|
||||
// We need the states at the end of the runtime.
|
||||
// Accessors can be modified but states will stay as the same pointer
|
||||
states: {
|
||||
continuation: Bindings.emptyBindings,
|
||||
},
|
||||
stdLib: ReducerInterface_StdLib.internalStdLib,
|
||||
environment: InternalExpressionValue.defaultEnvironment,
|
||||
}
|
||||
// let identityAccessors: t = {
|
||||
// // We need the states at the end of the runtime.
|
||||
// // Accessors can be modified but states will stay as the same pointer
|
||||
// states: {
|
||||
// continuation: Reducer_Bindings.emptyBindings,
|
||||
// },
|
||||
// stdLib: ReducerInterface_StdLib.internalStdLib,
|
||||
// environment: InternalExpressionValue.defaultEnvironment,
|
||||
// }
|
||||
|
||||
let identityAccessorsWithEnvironment = (environment): t => {
|
||||
states: {
|
||||
continuation: Bindings.emptyBindings,
|
||||
},
|
||||
stdLib: ReducerInterface_StdLib.internalStdLib,
|
||||
environment: environment,
|
||||
}
|
||||
|
||||
// to support change of environment in runtime
|
||||
let setEnvironment = (this: t, environment: ExpressionT.environment): t => {
|
||||
{
|
||||
...this,
|
||||
environment: environment,
|
||||
}
|
||||
}
|
||||
// // to support change of environment in runtime
|
||||
// let setEnvironment = (this: t, environment: Reducer_T.environment): t => {
|
||||
// {
|
||||
// ...this,
|
||||
// environment: environment,
|
||||
// }
|
||||
// }
|
||||
|
|
|
@ -1,69 +1,60 @@
|
|||
// TODO: Use actual types instead of aliases in public functions
|
||||
// TODO: Use topological sorting to prevent unnecessary runs
|
||||
module Bindings = Reducer_Bindings
|
||||
module Continuation = ReducerInterface_Value_Continuation
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
module ReducerFnT = ReducerProject_ReducerFn_T
|
||||
module T = ReducerProject_ProjectItem_T
|
||||
|
||||
type projectItem = T.projectItem
|
||||
type t = T.t
|
||||
|
||||
let emptyItem = T.ProjectItem({
|
||||
let emptyItem: projectItem = {
|
||||
source: "",
|
||||
rawParse: None,
|
||||
expression: None,
|
||||
continuation: Bindings.emptyBindings,
|
||||
continuation: Reducer_Bindings.makeEmptyBindings(),
|
||||
result: None,
|
||||
continues: [],
|
||||
includes: []->Ok,
|
||||
directIncludes: [],
|
||||
includeAsVariables: [],
|
||||
})
|
||||
}
|
||||
// source -> rawParse -> includes -> expression -> continuation -> result
|
||||
|
||||
let getSource = (T.ProjectItem(r)): T.sourceType => r.source
|
||||
let getRawParse = (T.ProjectItem(r)): T.rawParseType => r.rawParse
|
||||
let getExpression = (T.ProjectItem(r)): T.expressionType => r.expression
|
||||
let getContinuation = (T.ProjectItem(r)): T.continuationArgumentType => r.continuation
|
||||
let getResult = (T.ProjectItem(r)): T.resultType => r.result
|
||||
let getSource = (r: t): T.sourceType => r.source
|
||||
let getRawParse = (r: t): T.rawParseType => r.rawParse
|
||||
let getExpression = (r: t): T.expressionType => r.expression
|
||||
let getContinuation = (r: t): T.continuationArgumentType => r.continuation
|
||||
let getResult = (r: t): T.resultType => r.result
|
||||
|
||||
let getContinues = (T.ProjectItem(r)): T.continuesType => r.continues
|
||||
let getIncludes = (T.ProjectItem(r)): T.includesType => r.includes
|
||||
let getDirectIncludes = (T.ProjectItem(r)): array<string> => r.directIncludes
|
||||
let getIncludesAsVariables = (T.ProjectItem(r)): T.importAsVariablesType => r.includeAsVariables
|
||||
let getContinues = (r: t): T.continuesType => r.continues
|
||||
let getIncludes = (r: t): T.includesType => r.includes
|
||||
let getDirectIncludes = (r: t): array<string> => r.directIncludes
|
||||
let getIncludesAsVariables = (r: t): T.importAsVariablesType => r.includeAsVariables
|
||||
|
||||
let touchSource = (this: t): t => {
|
||||
let T.ProjectItem(r) = emptyItem
|
||||
T.ProjectItem({
|
||||
let r = emptyItem
|
||||
{
|
||||
...r,
|
||||
source: getSource(this),
|
||||
continues: getContinues(this),
|
||||
includes: getIncludes(this),
|
||||
includeAsVariables: getIncludesAsVariables(this),
|
||||
directIncludes: getDirectIncludes(this),
|
||||
})
|
||||
}
|
||||
}
|
||||
|
||||
let touchRawParse = (this: t): t => {
|
||||
let T.ProjectItem(r) = emptyItem
|
||||
T.ProjectItem({
|
||||
...r,
|
||||
{
|
||||
...emptyItem,
|
||||
source: getSource(this),
|
||||
continues: getContinues(this),
|
||||
includes: getIncludes(this),
|
||||
includeAsVariables: getIncludesAsVariables(this),
|
||||
directIncludes: getDirectIncludes(this),
|
||||
rawParse: getRawParse(this),
|
||||
})
|
||||
}
|
||||
}
|
||||
|
||||
let touchExpression = (this: t): t => {
|
||||
let T.ProjectItem(r) = emptyItem
|
||||
T.ProjectItem({
|
||||
...r,
|
||||
{
|
||||
...this,
|
||||
source: getSource(this),
|
||||
continues: getContinues(this),
|
||||
includes: getIncludes(this),
|
||||
|
@ -71,46 +62,40 @@ let touchExpression = (this: t): t => {
|
|||
directIncludes: getDirectIncludes(this),
|
||||
rawParse: getRawParse(this),
|
||||
expression: getExpression(this),
|
||||
})
|
||||
}
|
||||
}
|
||||
|
||||
let resetIncludes = (T.ProjectItem(r): t): t => {
|
||||
T.ProjectItem({
|
||||
...r,
|
||||
includes: []->Ok,
|
||||
includeAsVariables: [],
|
||||
directIncludes: [],
|
||||
})
|
||||
let resetIncludes = (r: t): t => {
|
||||
...r,
|
||||
includes: []->Ok,
|
||||
includeAsVariables: [],
|
||||
directIncludes: [],
|
||||
}
|
||||
|
||||
let setSource = (T.ProjectItem(r): t, source: T.sourceArgumentType): t =>
|
||||
T.ProjectItem({...r, source: source})->resetIncludes->touchSource
|
||||
let setSource = (r: t, source: T.sourceArgumentType): t =>
|
||||
{...r, source: source}->resetIncludes->touchSource
|
||||
|
||||
let setRawParse = (T.ProjectItem(r): t, rawParse: T.rawParseArgumentType): t =>
|
||||
T.ProjectItem({...r, rawParse: Some(rawParse)})->touchRawParse
|
||||
let setRawParse = (r: t, rawParse: T.rawParseArgumentType): t =>
|
||||
{...r, rawParse: Some(rawParse)}->touchRawParse
|
||||
|
||||
let setExpression = (T.ProjectItem(r): t, expression: T.expressionArgumentType): t =>
|
||||
T.ProjectItem({...r, expression: Some(expression)})->touchExpression
|
||||
let setExpression = (r: t, expression: T.expressionArgumentType): t =>
|
||||
{...r, expression: Some(expression)}->touchExpression
|
||||
|
||||
let setContinuation = (T.ProjectItem(r): t, continuation: T.continuationArgumentType): t => {
|
||||
T.ProjectItem({...r, continuation: continuation})
|
||||
}
|
||||
let setContinuation = (r: t, continuation: T.continuationArgumentType): t =>
|
||||
{...r, continuation: continuation}
|
||||
|
||||
let setResult = (T.ProjectItem(r): t, result: T.resultArgumentType): t => T.ProjectItem({
|
||||
let setResult = (r: t, result: T.resultArgumentType): t => {
|
||||
...r,
|
||||
result: Some(result),
|
||||
})
|
||||
}
|
||||
|
||||
let cleanResults = touchExpression
|
||||
|
||||
let clean = (this: t): t => {
|
||||
let T.ProjectItem(r) = emptyItem
|
||||
T.ProjectItem({
|
||||
...r,
|
||||
source: getSource(this),
|
||||
continuation: getContinuation(this),
|
||||
result: getResult(this),
|
||||
})
|
||||
...this,
|
||||
source: getSource(this),
|
||||
continuation: getContinuation(this),
|
||||
result: getResult(this),
|
||||
}
|
||||
|
||||
let getImmediateDependencies = (this: t): T.includesType =>
|
||||
|
@ -120,27 +105,27 @@ let getPastChain = (this: t): array<string> => {
|
|||
Js.Array2.concat(getDirectIncludes(this), getContinues(this))
|
||||
}
|
||||
|
||||
let setContinues = (T.ProjectItem(r): t, continues: array<string>): t =>
|
||||
T.ProjectItem({...r, continues: continues})->touchSource
|
||||
let removeContinues = (T.ProjectItem(r): t): t => T.ProjectItem({...r, continues: []})->touchSource
|
||||
let setContinues = (this: t, continues: array<string>): t =>
|
||||
{...this, continues: continues}->touchSource
|
||||
|
||||
let setIncludes = (T.ProjectItem(r): t, includes: T.includesType): t => T.ProjectItem({
|
||||
...r,
|
||||
let removeContinues = (this: t): t => {...this, continues: []}->touchSource
|
||||
|
||||
let setIncludes = (this: t, includes: T.includesType): t => {
|
||||
...this,
|
||||
includes: includes,
|
||||
})
|
||||
}
|
||||
|
||||
let setImportAsVariables = (
|
||||
T.ProjectItem(r): t,
|
||||
this: t,
|
||||
includeAsVariables: T.importAsVariablesType,
|
||||
): t => T.ProjectItem({...r, includeAsVariables: includeAsVariables})
|
||||
): t => {...this, includeAsVariables: includeAsVariables}
|
||||
|
||||
let setDirectImports = (T.ProjectItem(r): t, directIncludes: array<string>): t => T.ProjectItem({
|
||||
...r,
|
||||
let setDirectImports = (this: t, directIncludes: array<string>): t => {
|
||||
...this,
|
||||
directIncludes: directIncludes,
|
||||
})
|
||||
}
|
||||
|
||||
let parseIncludes = (this: t): t => {
|
||||
let T.ProjectItem(r) = this
|
||||
let rRawImportAsVariables = getSource(this)->ReducerProject_ParseIncludes.parseIncludes
|
||||
switch rRawImportAsVariables {
|
||||
| Error(e) => resetIncludes(this)->setIncludes(Error(e))
|
||||
|
@ -152,12 +137,12 @@ let parseIncludes = (this: t): t => {
|
|||
rawImportAsVariables
|
||||
->Belt.Array.keep(((variable, _file)) => variable == "")
|
||||
->Belt.Array.map(((_variable, file)) => file)
|
||||
T.ProjectItem({
|
||||
...r,
|
||||
{
|
||||
...this,
|
||||
includes: includes,
|
||||
includeAsVariables: includeAsVariables,
|
||||
directIncludes: directIncludes,
|
||||
})
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -172,45 +157,48 @@ let doBuildExpression = (this: t): T.expressionType =>
|
|||
->Belt.Option.map(o => o->Belt.Result.map(r => r->Reducer_Peggy_ToExpression.fromNode))
|
||||
|
||||
let buildExpression = (this: t): t => {
|
||||
let withRawParse: t = this->rawParse
|
||||
switch withRawParse->getExpression {
|
||||
| Some(_) => withRawParse
|
||||
let this = this->rawParse
|
||||
switch this->getExpression {
|
||||
| Some(_) => this // cached
|
||||
| None =>
|
||||
withRawParse
|
||||
this
|
||||
->doBuildExpression
|
||||
->Belt.Option.map(setExpression(withRawParse, _))
|
||||
->E.O2.defaultFn(() => withRawParse)
|
||||
->Belt.Option.map(setExpression(this, _))
|
||||
->E.O2.defaultFn(() => this)
|
||||
}
|
||||
}
|
||||
|
||||
let doBuildResult = (
|
||||
let failRun = (
|
||||
this: t,
|
||||
aContinuation: T.continuation,
|
||||
accessors: ProjectAccessorsT.t,
|
||||
): T.resultType =>
|
||||
this
|
||||
->getExpression
|
||||
->Belt.Option.map(
|
||||
Belt.Result.flatMap(_, expression =>
|
||||
try {
|
||||
Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
|
||||
} catch {
|
||||
| Reducer_ErrorValue.ErrorException(e) => e->Error
|
||||
| _ => RETodo("unhandled rescript exception")->Error
|
||||
}
|
||||
),
|
||||
)
|
||||
e: Reducer_ErrorValue.errorValue
|
||||
): t => this->setResult(e->Error)->setContinuation(Reducer_Bindings.makeEmptyBindings())
|
||||
|
||||
let buildResult = (this: t, aContinuation: T.continuation, accessors: ProjectAccessorsT.t): t => {
|
||||
let withExpression: t = this->buildExpression
|
||||
switch withExpression->getResult {
|
||||
| Some(_) => withExpression
|
||||
| None =>
|
||||
withExpression
|
||||
->doBuildResult(aContinuation, accessors)
|
||||
->Belt.Option.map(setResult(withExpression, _))
|
||||
->E.O2.defaultFn(() => withExpression)
|
||||
let doRun = (
|
||||
this: t,
|
||||
context: Reducer_T.context
|
||||
): t =>
|
||||
switch this->getExpression {
|
||||
| Some(expressionResult) => {
|
||||
switch expressionResult {
|
||||
| Ok(expression) => {
|
||||
try {
|
||||
let result = Reducer_Expression.evaluate(expression, context)
|
||||
this->setResult(result->Ok)->setContinuation(context.bindings)
|
||||
} catch {
|
||||
| Reducer_ErrorValue.ErrorException(e) => this->failRun(e)
|
||||
| _ => this->failRun(RETodo("unhandled rescript exception"))
|
||||
}
|
||||
}
|
||||
| Error(e) => this->failRun(e)
|
||||
}
|
||||
}
|
||||
| None => this->failRun(RETodo("attempt to run without expression"))
|
||||
}
|
||||
|
||||
let run = (this: t, context: Reducer_T.context): t => {
|
||||
let this = this->buildExpression
|
||||
switch this->getResult {
|
||||
| Some(_) => this
|
||||
| None => this->doRun(context)
|
||||
}
|
||||
}
|
||||
|
||||
let run = buildResult
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
module Parse = Reducer_Peggy_Parse
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
open Reducer_ErrorValue
|
||||
|
||||
type sourceArgumentType = string
|
||||
|
@ -9,13 +8,13 @@ type rawParseArgumentType = result<Parse.node, errorValue>
|
|||
type rawParseType = option<rawParseArgumentType>
|
||||
type expressionArgumentType = result<ExpressionT.t, errorValue>
|
||||
type expressionType = option<expressionArgumentType>
|
||||
type continuation = InternalExpressionValue.nameSpace
|
||||
type continuationArgumentType = InternalExpressionValue.nameSpace
|
||||
type continuation = Reducer_T.nameSpace
|
||||
type continuationArgumentType = Reducer_T.nameSpace
|
||||
type continuationType = option<continuationArgumentType>
|
||||
type continuationResultType = option<result<continuationArgumentType, errorValue>>
|
||||
type bindingsArgumentType = InternalExpressionValue.nameSpace
|
||||
type bindingsArgumentType = Reducer_T.nameSpace
|
||||
type bindingsType = option<bindingsArgumentType>
|
||||
type resultArgumentType = result<InternalExpressionValue.t, errorValue>
|
||||
type resultArgumentType = result<Reducer_T.value, errorValue>
|
||||
type resultType = option<resultArgumentType>
|
||||
type continuesArgumentType = array<string>
|
||||
type continuesType = array<string>
|
||||
|
@ -23,17 +22,16 @@ type includesArgumentType = string
|
|||
type includesType = result<array<string>, errorValue>
|
||||
type importAsVariablesType = array<(string, string)>
|
||||
|
||||
type projectItem =
|
||||
| ProjectItem({
|
||||
source: sourceType,
|
||||
rawParse: rawParseType,
|
||||
expression: expressionType,
|
||||
continuation: continuationArgumentType,
|
||||
result: resultType,
|
||||
continues: continuesType,
|
||||
includes: includesType, //For loader
|
||||
includeAsVariables: importAsVariablesType, //For linker
|
||||
directIncludes: array<string>,
|
||||
}) //For linker
|
||||
type projectItem = {
|
||||
source: sourceType,
|
||||
rawParse: rawParseType,
|
||||
expression: expressionType,
|
||||
continuation: continuationArgumentType,
|
||||
result: resultType,
|
||||
continues: continuesType,
|
||||
includes: includesType, //For loader
|
||||
includeAsVariables: importAsVariablesType, //For linker
|
||||
directIncludes: array<string>,
|
||||
}
|
||||
|
||||
type t = projectItem
|
||||
|
|
|
@ -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
|
|
@ -1,37 +1,17 @@
|
|||
module ProjectItem = ReducerProject_ProjectItem
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
|
||||
|
||||
@genType.opaque
|
||||
type project = {"iAmProject": bool}
|
||||
//re-export
|
||||
@genType
|
||||
type project = {
|
||||
items: Belt.MutableMap.String.t<ProjectItem.t>,
|
||||
mutable stdLib: Reducer_Bindings.t,
|
||||
mutable environment: ExpressionT.environment,
|
||||
mutable previousRunOrder: array<string>,
|
||||
}
|
||||
type t = project
|
||||
|
||||
module Private = {
|
||||
type internalProject = {
|
||||
"iAmProject": bool,
|
||||
"items": Belt.Map.String.t<ProjectItem.t>,
|
||||
"stdLib": Reducer_Bindings.t,
|
||||
"environment": ExpressionT.environment,
|
||||
"previousRunOrder": array<string>,
|
||||
}
|
||||
type t = internalProject
|
||||
// these functions are used in ReducerProject_Topology, so they are defined here to avoid circular dependencies
|
||||
let getSourceIds = (project: t): array<string> => Belt.MutableMap.String.keysToArray(project.items)
|
||||
|
||||
@set
|
||||
external setFieldItems: (t, Belt.Map.String.t<ProjectItem.t>) => unit = "items"
|
||||
@set
|
||||
external setFieldStdLib: (t, Reducer_Bindings.t) => unit = "stdLib"
|
||||
@set
|
||||
external setFieldEnvironment: (t, ExpressionT.environment) => unit = "environment"
|
||||
@set
|
||||
external setFieldPreviousRunOrder: (t, array<string>) => unit = "previousRunOrder"
|
||||
|
||||
external castFromInternalProject: t => project = "%identity"
|
||||
external castToInternalProject: project => t = "%identity"
|
||||
|
||||
let getSourceIds = (this: t): array<string> => Belt.Map.String.keysToArray(this["items"])
|
||||
|
||||
let getItem = (this: t, sourceId: string) =>
|
||||
Belt.Map.String.getWithDefault(this["items"], sourceId, ProjectItem.emptyItem)
|
||||
}
|
||||
let getItem = (project: t, sourceId: string) =>
|
||||
Belt.MutableMap.String.getWithDefault(project.items, sourceId, ProjectItem.emptyItem)
|
||||
|
|
|
@ -1,12 +1,12 @@
|
|||
module ProjectItem = ReducerProject_ProjectItem
|
||||
module T = ReducerProject_T
|
||||
type t = T.Private.t
|
||||
type t = T.t
|
||||
|
||||
let getSourceIds = T.Private.getSourceIds
|
||||
let getItem = T.Private.getItem
|
||||
let getSourceIds = T.getSourceIds
|
||||
let getItem = T.getItem
|
||||
|
||||
let getImmediateDependencies = (this: t, sourceId: string): ProjectItem.T.includesType =>
|
||||
getItem(this, sourceId)->ProjectItem.getImmediateDependencies
|
||||
this->getItem(sourceId)->ProjectItem.getImmediateDependencies
|
||||
|
||||
type topologicalSortState = (Belt.Map.String.t<bool>, list<string>)
|
||||
let rec topologicalSortUtil = (
|
||||
|
@ -31,7 +31,7 @@ let rec topologicalSortUtil = (
|
|||
}
|
||||
|
||||
let getTopologicalSort = (this: t): array<string> => {
|
||||
let (_visited, stack) = getSourceIds(this)->Belt.Array.reduce((Belt.Map.String.empty, list{}), (
|
||||
let (_visited, stack) = this->getSourceIds->Belt.Array.reduce((Belt.Map.String.empty, list{}), (
|
||||
(currVisited, currStack),
|
||||
currId,
|
||||
) =>
|
||||
|
|
|
@ -15,7 +15,7 @@ let availableNumbers: array<(string, float)> = [
|
|||
|
||||
let mathBindings: Bindings.t =
|
||||
availableNumbers
|
||||
->E.A2.fmap(((name, v)) => (name, ReducerInterface_InternalExpressionValue.IEvNumber(v)))
|
||||
->E.A2.fmap(((name, v)) => (name, Reducer_T.IEvNumber(v)))
|
||||
->Bindings.fromArray
|
||||
|
||||
let makeBindings = (previousBindings: Bindings.t): Bindings.t =>
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
module Bindings = Reducer_Bindings
|
||||
|
||||
let bindings: Bindings.t =
|
||||
let bindings: Reducer_T.nameSpace =
|
||||
[
|
||||
("System.version", ReducerInterface_InternalExpressionValue.IEvString("0.4.0-dev")),
|
||||
("System.version", Reducer_T.IEvString("0.4.0-dev")),
|
||||
]->Bindings.fromArray
|
||||
|
||||
let makeBindings = (previousBindings: Bindings.t): Bindings.t =>
|
||||
let makeBindings = (previousBindings: Reducer_T.nameSpace): Reducer_T.nameSpace =>
|
||||
previousBindings->Bindings.mergeFrom(bindings)
|
||||
|
|
Loading…
Reference in New Issue
Block a user