Merge branch 'overhaul' into project-component

This commit is contained in:
Sam Nolan 2022-09-26 13:35:12 +10:00
commit 64f9c9ddfc
144 changed files with 2943 additions and 5260 deletions

View File

@ -1,6 +1,6 @@
{
"name": "@quri/squiggle-components",
"version": "0.4.3",
"version": "0.5.0-alpha.2",
"license": "MIT",
"dependencies": {
"@floating-ui/react-dom": "^1.0.0",
@ -8,7 +8,7 @@
"@headlessui/react": "^1.7.2",
"@heroicons/react": "^1.0.6",
"@hookform/resolvers": "^2.9.8",
"@quri/squiggle-lang": "^0.4.2",
"@quri/squiggle-lang": "^0.5.0-alpha.2",
"@react-hook/size": "^2.1.2",
"@types/uuid": "^8.3.4",
"clsx": "^1.2.1",

View File

@ -135,29 +135,6 @@ export const ExpressionViewer: React.FC<Props> = ({ value, width }) => {
{() => value.value.toString()}
</VariableBox>
);
case SqValueTag.Symbol:
return (
<VariableBox value={value} heading="Symbol">
{() => (
<>
<span className="text-slate-500 mr-2">Undefined Symbol:</span>
<span className="text-slate-600">{value.value}</span>
</>
)}
</VariableBox>
);
case SqValueTag.Call:
return (
<VariableBox value={value} heading="Call">
{() => value.value}
</VariableBox>
);
case SqValueTag.ArrayString:
return (
<VariableBox value={value} heading="Array String">
{() => value.value.map((r) => `"${r}"`).join(", ")}
</VariableBox>
);
case SqValueTag.Date:
return (
<VariableBox value={value} heading="Date">
@ -242,24 +219,6 @@ export const ExpressionViewer: React.FC<Props> = ({ value, width }) => {
</VariableBox>
);
}
case SqValueTag.Module: {
return (
<VariableList value={value} heading="Module">
{(_) =>
value.value
.entries()
.filter(([key, _]) => !key.match(/^(__result__)$/))
.map(([key, r]) => (
<ExpressionViewer
key={key}
value={r}
width={width !== undefined ? width - 20 : width}
/>
))
}
</VariableList>
);
}
case SqValueTag.Record:
const plot = makePlot(value.value);
if (plot) {

View File

@ -1,20 +0,0 @@
open Jest
open Expect
let makeTest = (~only=false, str, item1, item2) =>
only
? Only.test(str, () => expect(item1)->toEqual(item2))
: test(str, () => expect(item1)->toEqual(item2))
describe("Lodash", () =>
describe("Lodash", () => {
makeTest("min", Lodash.min([1, 3, 4]), 1)
makeTest("max", Lodash.max([1, 3, 4]), 4)
makeTest("uniq", Lodash.uniq([1, 3, 4, 4]), [1, 3, 4])
makeTest(
"countBy",
Lodash.countBy([1, 3, 4, 4], r => r),
Js.Dict.fromArray([("1", 1), ("3", 1), ("4", 2)]),
)
})
)

View File

@ -1,27 +1,44 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Bindings = Reducer_Bindings
module Namespace = Reducer_Namespace
open Jest
open Expect
open Expect.Operators
describe("Name Space", () => {
let value = InternalExpressionValue.IEvNumber(1967.0)
let nameSpace = Bindings.emptyNameSpace->Bindings.set("value", value)
describe("Bindings", () => {
let value = Reducer_T.IEvNumber(1967.0)
let bindings = Bindings.make()->Bindings.set("value", value)
test("get", () => {
expect(Bindings.get(nameSpace, "value")) == Some(value)
expect(bindings->Bindings.get("value")) == Some(value)
})
test("chain and get", () => {
let mainNameSpace = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
expect(Bindings.get(mainNameSpace, "value")) == Some(value)
test("get nonexisting value", () => {
expect(bindings->Bindings.get("nosuchvalue")) == None
})
test("chain and set", () => {
let mainNameSpace0 = Bindings.emptyNameSpace->Bindings.chainTo([nameSpace])
let mainNameSpace =
mainNameSpace0->Bindings.set("value", InternalExpressionValue.IEvNumber(1968.0))
expect(Bindings.get(mainNameSpace, "value")) == Some(InternalExpressionValue.IEvNumber(1968.0))
test("get on extended", () => {
expect(bindings->Bindings.extend->Bindings.get("value")) == Some(value)
})
test("locals", () => {
expect(bindings->Bindings.locals->Namespace.get("value")) == Some(value)
})
test("locals on extendeed", () => {
expect(bindings->Bindings.extend->Bindings.locals->Namespace.get("value")) == None
})
describe("extend", () => {
let value2 = Reducer_T.IEvNumber(5.)
let extendedBindings = bindings->Bindings.extend->Bindings.set("value", value2)
test("get on extended", () => {
expect(extendedBindings->Bindings.get("value")) == Some(value2)
})
test("get on original", () => {
expect(bindings->Bindings.get("value")) == Some(value)
})
})
})

View File

@ -1,146 +0,0 @@
open Jest
// open Expect
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"))
// 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("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("lambda", () => {
// assign a lambda to a variable
let lambdaExpression = eFunction("$$_lambda_$$", list{eArrayString(["y"]), exampleExpressionY})
testMacro([], lambdaExpression, "Ok(lambda(y=>internal code))")
// call a lambda
let callLambdaExpression = list{lambdaExpression, eNumber(1.)}->ExpressionT.EList
testMacro([], callLambdaExpression, "Ok(((:$$_lambda_$$ [y] :y) 1))")
testMacroEval([], callLambdaExpression, "Ok(1)")
// Parameters shadow the outer scope
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(1)")
// When not shadowed by the parameters, the outer scope variables are available
let lambdaExpression = eFunction(
"$$_lambda_$$",
list{eArrayString(["z"]), eFunction("add", list{eSymbol("y"), eSymbol("z")})},
)
let callLambdaExpression = eList(list{lambdaExpression, eNumber(1.)})
testMacroEval([("y", IEvNumber(666.))], callLambdaExpression, "Ok(667)")
})

View File

@ -1,41 +0,0 @@
module ExpressionValue = ReducerInterface.InternalExpressionValue
module Expression = Reducer_Expression
open Jest
open Expect
let expectEvalToBe = (sourceCode: string, answer: string) =>
Expression.BackCompatible.evaluateString(sourceCode)
->ExpressionValue.toStringResult
->expect
->toBe(answer)
let testEval = (expr, answer) => test(expr, () => expectEvalToBe(expr, answer))
describe("builtin", () => {
// All MathJs operators and functions are available for string, number and boolean
// .e.g + - / * > >= < <= == /= not and or
// See https://mathjs.org/docs/expressions/syntax.html
// See https://mathjs.org/docs/reference/functions.html
testEval("-1", "Ok(-1)")
testEval("1-1", "Ok(0)")
testEval("2>1", "Ok(true)")
testEval("concat('a','b')", "Ok('ab')")
})
describe("builtin exception", () => {
//It's a pity that MathJs does not return error position
test("MathJs Exception", () =>
expectEvalToBe("testZadanga(1)", "Error(JS Exception: Error: Undefined function testZadanga)")
)
})
describe("error reporting from collection functions", () => {
testEval("arr=[1,2,3]; map(arr, {|x| x*2})", "Ok([2,4,6])")
testEval(
"arr = [normal(3,2)]; map(arr, zarathsuzaWasHere)",
"Error(zarathsuzaWasHere is not defined)",
)
// FIXME: returns "Error(Function not found: map(Array,Symbol))"
// Actually this error is correct but not informative
})

View File

@ -1,17 +0,0 @@
// 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
}
}
let rRemoveDefaultsInternal = r => Belt.Result.map(r, removeDefaultsInternal)

View File

@ -1,31 +0,0 @@
module MathJs = Reducer_MathJs
module ErrorValue = Reducer_ErrorValue
open Jest
open ExpectJs
describe("eval", () => {
test("Number", () => expect(MathJs.Eval.eval("1"))->toEqual(Ok(IEvNumber(1.))))
test("Number expr", () => expect(MathJs.Eval.eval("1-1"))->toEqual(Ok(IEvNumber(0.))))
test("String", () => expect(MathJs.Eval.eval("'hello'"))->toEqual(Ok(IEvString("hello"))))
test("String expr", () =>
expect(MathJs.Eval.eval("concat('hello ','world')"))->toEqual(Ok(IEvString("hello world")))
)
test("Boolean", () => expect(MathJs.Eval.eval("true"))->toEqual(Ok(IEvBool(true))))
test("Boolean expr", () => expect(MathJs.Eval.eval("2>1"))->toEqual(Ok(IEvBool(true))))
})
describe("errors", () => {
// All those errors propagete up and are returned by the resolver
test("unknown function", () =>
expect(MathJs.Eval.eval("testZadanga()"))->toEqual(
Error(ErrorValue.REJavaScriptExn(Some("Undefined function testZadanga"), Some("Error"))),
)
)
test("unknown answer type", () =>
expect(MathJs.Eval.eval("1+1i"))->toEqual(
Error(ErrorValue.RETodo("Unhandled MathJs literal type: object")),
)
)
})

View File

@ -0,0 +1,53 @@
@@warning("-44")
module Namespace = Reducer_Namespace
open Jest
open Expect
open Expect.Operators
let makeValue = (v: float) => v->Reducer_T.IEvNumber
describe("Namespace", () => {
let value = makeValue(5.)
let v2 = makeValue(2.)
let ns = Namespace.make()->Namespace.set("value", value)
test("get", () => {
expect(ns->Namespace.get("value")) == Some(value)
})
test("get nonexisting value", () => {
expect(ns->Namespace.get("nosuchvalue")) == None
})
test("set", () => {
let ns2 = ns->Namespace.set("v2", v2)
expect(ns2->Namespace.get("v2")) == Some(v2)
})
test("immutable", () => {
let _ = ns->Namespace.set("v2", Reducer_T.IEvNumber(2.))
expect(ns->Namespace.get("v2")) == None
})
describe("merge many", () => {
let x1 = makeValue(10.)
let x2 = makeValue(20.)
let x3 = makeValue(30.)
let x4 = makeValue(40.)
let ns1 = Namespace.make()->Namespace.set("x1", x1)->Namespace.set("x2", x2)
let ns2 = Namespace.make()->Namespace.set("x3", x3)->Namespace.set("x4", x4)
let nsMerged = Namespace.mergeMany([ns, ns1, ns2])
test("merge many 1", () => {
expect(nsMerged->Namespace.get("x1")) == Some(x1)
})
test("merge many 2", () => {
expect(nsMerged->Namespace.get("x4")) == Some(x4)
})
test("merge many 3", () => {
expect(nsMerged->Namespace.get("value")) == Some(value)
})
})
})

View File

@ -3,346 +3,231 @@ open Reducer_Peggy_TestHelpers
describe("Peggy parse", () => {
describe("float", () => {
testParse("1.", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("1.1", "{(::$_endOfOuterBlock_$ () 1.1)}")
testParse(".1", "{(::$_endOfOuterBlock_$ () 0.1)}")
testParse("0.1", "{(::$_endOfOuterBlock_$ () 0.1)}")
testParse("1e1", "{(::$_endOfOuterBlock_$ () 10)}")
testParse("1e-1", "{(::$_endOfOuterBlock_$ () 0.1)}")
testParse(".1e1", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("0.1e1", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("1.", "{1}")
testParse("1.1", "{1.1}")
testParse(".1", "{0.1}")
testParse("0.1", "{0.1}")
testParse("1e1", "{10}")
testParse("1e-1", "{0.1}")
testParse(".1e1", "{1}")
testParse("0.1e1", "{1}")
})
describe("literals operators parenthesis", () => {
// Note that there is always an outer block. Otherwise, external bindings are ignrored at the first statement
testParse("1", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("'hello'", "{(::$_endOfOuterBlock_$ () 'hello')}")
testParse("true", "{(::$_endOfOuterBlock_$ () true)}")
testParse("1+2", "{(::$_endOfOuterBlock_$ () (::add 1 2))}")
testParse("add(1,2)", "{(::$_endOfOuterBlock_$ () (::add 1 2))}")
testParse("(1)", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("(1+2)", "{(::$_endOfOuterBlock_$ () (::add 1 2))}")
testParse("1", "{1}")
testParse("'hello'", "{'hello'}")
testParse("true", "{true}")
testParse("1+2", "{(:add 1 2)}")
testParse("add(1,2)", "{(:add 1 2)}")
testParse("(1)", "{1}")
testParse("(1+2)", "{(:add 1 2)}")
})
describe("unary", () => {
testParse("-1", "{(::$_endOfOuterBlock_$ () (::unaryMinus 1))}")
testParse("!true", "{(::$_endOfOuterBlock_$ () (::not true))}")
testParse("1 + -1", "{(::$_endOfOuterBlock_$ () (::add 1 (::unaryMinus 1)))}")
testParse("-a[0]", "{(::$_endOfOuterBlock_$ () (::unaryMinus (::$_atIndex_$ :a 0)))}")
testParse("!a[0]", "{(::$_endOfOuterBlock_$ () (::not (::$_atIndex_$ :a 0)))}")
testParse("-1", "{(:unaryMinus 1)}")
testParse("!true", "{(:not true)}")
testParse("1 + -1", "{(:add 1 (:unaryMinus 1))}")
testParse("-a[0]", "{(:unaryMinus (:$_atIndex_$ :a 0))}")
testParse("!a[0]", "{(:not (:$_atIndex_$ :a 0))}")
})
describe("multiplicative", () => {
testParse("1 * 2", "{(::$_endOfOuterBlock_$ () (::multiply 1 2))}")
testParse("1 / 2", "{(::$_endOfOuterBlock_$ () (::divide 1 2))}")
testParse("1 * 2 * 3", "{(::$_endOfOuterBlock_$ () (::multiply (::multiply 1 2) 3))}")
testParse("1 * 2 / 3", "{(::$_endOfOuterBlock_$ () (::divide (::multiply 1 2) 3))}")
testParse("1 / 2 * 3", "{(::$_endOfOuterBlock_$ () (::multiply (::divide 1 2) 3))}")
testParse("1 / 2 / 3", "{(::$_endOfOuterBlock_$ () (::divide (::divide 1 2) 3))}")
testParse(
"1 * 2 + 3 * 4",
"{(::$_endOfOuterBlock_$ () (::add (::multiply 1 2) (::multiply 3 4)))}",
)
testParse(
"1 * 2 - 3 * 4",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::multiply 3 4)))}",
)
testParse(
"1 * 2 .+ 3 * 4",
"{(::$_endOfOuterBlock_$ () (::dotAdd (::multiply 1 2) (::multiply 3 4)))}",
)
testParse(
"1 * 2 .- 3 * 4",
"{(::$_endOfOuterBlock_$ () (::dotSubtract (::multiply 1 2) (::multiply 3 4)))}",
)
testParse(
"1 * 2 + 3 .* 4",
"{(::$_endOfOuterBlock_$ () (::add (::multiply 1 2) (::dotMultiply 3 4)))}",
)
testParse(
"1 * 2 + 3 / 4",
"{(::$_endOfOuterBlock_$ () (::add (::multiply 1 2) (::divide 3 4)))}",
)
testParse(
"1 * 2 + 3 ./ 4",
"{(::$_endOfOuterBlock_$ () (::add (::multiply 1 2) (::dotDivide 3 4)))}",
)
testParse(
"1 * 2 - 3 .* 4",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::dotMultiply 3 4)))}",
)
testParse(
"1 * 2 - 3 / 4",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::divide 3 4)))}",
)
testParse(
"1 * 2 - 3 ./ 4",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::dotDivide 3 4)))}",
)
testParse(
"1 * 2 - 3 * 4^5",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::multiply 3 (::pow 4 5))))}",
)
testParse("1 * 2", "{(:multiply 1 2)}")
testParse("1 / 2", "{(:divide 1 2)}")
testParse("1 * 2 * 3", "{(:multiply (:multiply 1 2) 3)}")
testParse("1 * 2 / 3", "{(:divide (:multiply 1 2) 3)}")
testParse("1 / 2 * 3", "{(:multiply (:divide 1 2) 3)}")
testParse("1 / 2 / 3", "{(:divide (:divide 1 2) 3)}")
testParse("1 * 2 + 3 * 4", "{(:add (:multiply 1 2) (:multiply 3 4))}")
testParse("1 * 2 - 3 * 4", "{(:subtract (:multiply 1 2) (:multiply 3 4))}")
testParse("1 * 2 .+ 3 * 4", "{(:dotAdd (:multiply 1 2) (:multiply 3 4))}")
testParse("1 * 2 .- 3 * 4", "{(:dotSubtract (:multiply 1 2) (:multiply 3 4))}")
testParse("1 * 2 + 3 .* 4", "{(:add (:multiply 1 2) (:dotMultiply 3 4))}")
testParse("1 * 2 + 3 / 4", "{(:add (:multiply 1 2) (:divide 3 4))}")
testParse("1 * 2 + 3 ./ 4", "{(:add (:multiply 1 2) (:dotDivide 3 4))}")
testParse("1 * 2 - 3 .* 4", "{(:subtract (:multiply 1 2) (:dotMultiply 3 4))}")
testParse("1 * 2 - 3 / 4", "{(:subtract (:multiply 1 2) (:divide 3 4))}")
testParse("1 * 2 - 3 ./ 4", "{(:subtract (:multiply 1 2) (:dotDivide 3 4))}")
testParse("1 * 2 - 3 * 4^5", "{(:subtract (:multiply 1 2) (:multiply 3 (:pow 4 5)))}")
testParse(
"1 * 2 - 3 * 4^5^6",
"{(::$_endOfOuterBlock_$ () (::subtract (::multiply 1 2) (::multiply 3 (::pow (::pow 4 5) 6))))}",
)
testParse(
"1 * -a[-2]",
"{(::$_endOfOuterBlock_$ () (::multiply 1 (::unaryMinus (::$_atIndex_$ :a (::unaryMinus 2)))))}",
"{(:subtract (:multiply 1 2) (:multiply 3 (:pow (:pow 4 5) 6)))}",
)
testParse("1 * -a[-2]", "{(:multiply 1 (:unaryMinus (:$_atIndex_$ :a (:unaryMinus 2))))}")
})
describe("multi-line", () => {
testParse("x=1; 2", "{:x = {1}; (::$_endOfOuterBlock_$ () 2)}")
testParse("x=1; y=2", "{:x = {1}; :y = {2}; (::$_endOfOuterBlock_$ () ())}")
testParse("x=1; 2", "{:x = {1}; 2}")
testParse("x=1; y=2", "{:x = {1}; :y = {2}}")
})
describe("variables", () => {
testParse("x = 1", "{:x = {1}; (::$_endOfOuterBlock_$ () ())}")
testParse("x", "{(::$_endOfOuterBlock_$ () :x)}")
testParse("x = 1; x", "{:x = {1}; (::$_endOfOuterBlock_$ () :x)}")
testParse("x = 1", "{:x = {1}}")
testParse("x", "{:x}")
testParse("x = 1; x", "{:x = {1}; :x}")
})
describe("functions", () => {
testParse("identity(x) = x", "{:identity = {|:x| {:x}}; (::$_endOfOuterBlock_$ () ())}") // Function definitions become lambda assignments
testParse("identity(x)", "{(::$_endOfOuterBlock_$ () (::identity :x))}")
testParse("identity(x) = x", "{:identity = {|:x| {:x}}}") // Function definitions become lambda assignments
testParse("identity(x)", "{(:identity :x)}")
})
describe("arrays", () => {
testParse("[]", "{(::$_endOfOuterBlock_$ () (::$_constructArray_$))}")
testParse("[0, 1, 2]", "{(::$_endOfOuterBlock_$ () (::$_constructArray_$ 0 1 2))}")
testParse(
"['hello', 'world']",
"{(::$_endOfOuterBlock_$ () (::$_constructArray_$ 'hello' 'world'))}",
)
testParse(
"([0,1,2])[1]",
"{(::$_endOfOuterBlock_$ () (::$_atIndex_$ (::$_constructArray_$ 0 1 2) 1))}",
)
testParse("[]", "{[]}")
testParse("[0, 1, 2]", "{[0; 1; 2]}")
testParse("['hello', 'world']", "{['hello'; 'world']}")
testParse("([0,1,2])[1]", "{(:$_atIndex_$ [0; 1; 2] 1)}")
})
describe("records", () => {
testParse(
"{a: 1, b: 2}",
"{(::$_endOfOuterBlock_$ () (::$_constructRecord_$ ('a': 1 'b': 2)))}",
)
testParse(
"{1+0: 1, 2+0: 2}",
"{(::$_endOfOuterBlock_$ () (::$_constructRecord_$ ((::add 1 0): 1 (::add 2 0): 2)))}",
) // key can be any expression
testParse("record.property", "{(::$_endOfOuterBlock_$ () (::$_atIndex_$ :record 'property'))}")
testParse("{a: 1, b: 2}", "{{'a': 1, 'b': 2}}")
testParse("{1+0: 1, 2+0: 2}", "{{(:add 1 0): 1, (:add 2 0): 2}}") // key can be any expression
testParse("record.property", "{(:$_atIndex_$ :record 'property')}")
})
describe("post operators", () => {
//function call, array and record access are post operators with higher priority than unary operators
testParse("a==!b(1)", "{(::$_endOfOuterBlock_$ () (::equal :a (::not (::b 1))))}")
testParse("a==!b[1]", "{(::$_endOfOuterBlock_$ () (::equal :a (::not (::$_atIndex_$ :b 1))))}")
testParse(
"a==!b.one",
"{(::$_endOfOuterBlock_$ () (::equal :a (::not (::$_atIndex_$ :b 'one'))))}",
)
testParse("a==!b(1)", "{(:equal :a (:not (:b 1)))}")
testParse("a==!b[1]", "{(:equal :a (:not (:$_atIndex_$ :b 1)))}")
testParse("a==!b.one", "{(:equal :a (:not (:$_atIndex_$ :b 'one')))}")
})
describe("comments", () => {
testParse("1 # This is a line comment", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("1 // This is a line comment", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("1 /* This is a multi line comment */", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("/* This is a multi line comment */ 1", "{(::$_endOfOuterBlock_$ () 1)}")
testParse("1 # This is a line comment", "{1}")
testParse("1 // This is a line comment", "{1}")
testParse("1 /* This is a multi line comment */", "{1}")
testParse("/* This is a multi line comment */ 1", "{1}")
testParse(
`
/* This is
a multi line
comment */
1`,
"{(::$_endOfOuterBlock_$ () 1)}",
"{1}",
)
})
describe("ternary operator", () => {
testParse("true ? 2 : 3", "{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ true 2 3))}")
testParse("true ? 2 : 3", "{(::$$_ternary_$$ true 2 3)}")
testParse(
"false ? 2 : false ? 4 : 5",
"{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ false 2 (::$$_ternary_$$ false 4 5)))}",
"{(::$$_ternary_$$ false 2 (::$$_ternary_$$ false 4 5))}",
) // nested ternary
})
describe("if then else", () => {
testParse(
"if true then 2 else 3",
"{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ true {2} {3}))}",
)
testParse(
"if false then {2} else {3}",
"{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ false {2} {3}))}",
)
testParse("if true then 2 else 3", "{(::$$_ternary_$$ true {2} {3})}")
testParse("if false then {2} else {3}", "{(::$$_ternary_$$ false {2} {3})}")
testParse(
"if false then {2} else if false then {4} else {5}",
"{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ false {2} (::$$_ternary_$$ false {4} {5})))}",
"{(::$$_ternary_$$ false {2} (::$$_ternary_$$ false {4} {5}))}",
) //nested if
})
describe("logical", () => {
testParse("true || false", "{(::$_endOfOuterBlock_$ () (::or true false))}")
testParse("true && false", "{(::$_endOfOuterBlock_$ () (::and true false))}")
testParse("a * b + c", "{(::$_endOfOuterBlock_$ () (::add (::multiply :a :b) :c))}") // for comparison
testParse("a && b || c", "{(::$_endOfOuterBlock_$ () (::or (::and :a :b) :c))}")
testParse("a && b || c && d", "{(::$_endOfOuterBlock_$ () (::or (::and :a :b) (::and :c :d)))}")
testParse("a && !b || c", "{(::$_endOfOuterBlock_$ () (::or (::and :a (::not :b)) :c))}")
testParse("a && b==c || d", "{(::$_endOfOuterBlock_$ () (::or (::and :a (::equal :b :c)) :d))}")
testParse(
"a && b!=c || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::unequal :b :c)) :d))}",
)
testParse(
"a && !(b==c) || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::not (::equal :b :c))) :d))}",
)
testParse(
"a && b>=c || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::largerEq :b :c)) :d))}",
)
testParse(
"a && !(b>=c) || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::not (::largerEq :b :c))) :d))}",
)
testParse(
"a && b<=c || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smallerEq :b :c)) :d))}",
)
testParse("a && b>c || d", "{(::$_endOfOuterBlock_$ () (::or (::and :a (::larger :b :c)) :d))}")
testParse(
"a && b<c || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b :c)) :d))}",
)
testParse(
"a && b<c[i] || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::$_atIndex_$ :c :i))) :d))}",
)
testParse(
"a && b<c.i || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::$_atIndex_$ :c 'i'))) :d))}",
)
testParse(
"a && b<c(i) || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::c :i))) :d))}",
)
testParse(
"a && b<1+2 || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::add 1 2))) :d))}",
)
testParse(
"a && b<1+2*3 || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::add 1 (::multiply 2 3)))) :d))}",
)
testParse("true || false", "{(:or true false)}")
testParse("true && false", "{(:and true false)}")
testParse("a * b + c", "{(:add (:multiply :a :b) :c)}") // for comparison
testParse("a && b || c", "{(:or (:and :a :b) :c)}")
testParse("a && b || c && d", "{(:or (:and :a :b) (:and :c :d))}")
testParse("a && !b || c", "{(:or (:and :a (:not :b)) :c)}")
testParse("a && b==c || d", "{(:or (:and :a (:equal :b :c)) :d)}")
testParse("a && b!=c || d", "{(:or (:and :a (:unequal :b :c)) :d)}")
testParse("a && !(b==c) || d", "{(:or (:and :a (:not (:equal :b :c))) :d)}")
testParse("a && b>=c || d", "{(:or (:and :a (:largerEq :b :c)) :d)}")
testParse("a && !(b>=c) || d", "{(:or (:and :a (:not (:largerEq :b :c))) :d)}")
testParse("a && b<=c || d", "{(:or (:and :a (:smallerEq :b :c)) :d)}")
testParse("a && b>c || d", "{(:or (:and :a (:larger :b :c)) :d)}")
testParse("a && b<c || d", "{(:or (:and :a (:smaller :b :c)) :d)}")
testParse("a && b<c[i] || d", "{(:or (:and :a (:smaller :b (:$_atIndex_$ :c :i))) :d)}")
testParse("a && b<c.i || d", "{(:or (:and :a (:smaller :b (:$_atIndex_$ :c 'i'))) :d)}")
testParse("a && b<c(i) || d", "{(:or (:and :a (:smaller :b (:c :i))) :d)}")
testParse("a && b<1+2 || d", "{(:or (:and :a (:smaller :b (:add 1 2))) :d)}")
testParse("a && b<1+2*3 || d", "{(:or (:and :a (:smaller :b (:add 1 (:multiply 2 3)))) :d)}")
testParse(
"a && b<1+2*-3+4 || d",
"{(::$_endOfOuterBlock_$ () (::or (::and :a (::smaller :b (::add (::add 1 (::multiply 2 (::unaryMinus 3))) 4))) :d))}",
"{(:or (:and :a (:smaller :b (:add (:add 1 (:multiply 2 (:unaryMinus 3))) 4))) :d)}",
)
testParse(
"a && b<1+2*3 || d ? true : false",
"{(::$_endOfOuterBlock_$ () (::$$_ternary_$$ (::or (::and :a (::smaller :b (::add 1 (::multiply 2 3)))) :d) true false))}",
"{(::$$_ternary_$$ (:or (:and :a (:smaller :b (:add 1 (:multiply 2 3)))) :d) true false)}",
)
})
describe("pipe", () => {
testParse("1 -> add(2)", "{(::$_endOfOuterBlock_$ () (::add 1 2))}")
testParse("-1 -> add(2)", "{(::$_endOfOuterBlock_$ () (::add (::unaryMinus 1) 2))}")
testParse(
"-a[1] -> add(2)",
"{(::$_endOfOuterBlock_$ () (::add (::unaryMinus (::$_atIndex_$ :a 1)) 2))}",
)
testParse("-f(1) -> add(2)", "{(::$_endOfOuterBlock_$ () (::add (::unaryMinus (::f 1)) 2))}")
testParse("1 + 2 -> add(3)", "{(::$_endOfOuterBlock_$ () (::add 1 (::add 2 3)))}")
testParse("1 -> add(2) * 3", "{(::$_endOfOuterBlock_$ () (::multiply (::add 1 2) 3))}")
testParse("1 -> subtract(2)", "{(::$_endOfOuterBlock_$ () (::subtract 1 2))}")
testParse("-1 -> subtract(2)", "{(::$_endOfOuterBlock_$ () (::subtract (::unaryMinus 1) 2))}")
testParse(
"1 -> subtract(2) * 3",
"{(::$_endOfOuterBlock_$ () (::multiply (::subtract 1 2) 3))}",
)
testParse("1 -> add(2)", "{(:add 1 2)}")
testParse("-1 -> add(2)", "{(:add (:unaryMinus 1) 2)}")
testParse("-a[1] -> add(2)", "{(:add (:unaryMinus (:$_atIndex_$ :a 1)) 2)}")
testParse("-f(1) -> add(2)", "{(:add (:unaryMinus (:f 1)) 2)}")
testParse("1 + 2 -> add(3)", "{(:add 1 (:add 2 3))}")
testParse("1 -> add(2) * 3", "{(:multiply (:add 1 2) 3)}")
testParse("1 -> subtract(2)", "{(:subtract 1 2)}")
testParse("-1 -> subtract(2)", "{(:subtract (:unaryMinus 1) 2)}")
testParse("1 -> subtract(2) * 3", "{(:multiply (:subtract 1 2) 3)}")
})
describe("elixir pipe", () => {
//handled together with -> so there is no need for seperate tests
testParse("1 |> add(2)", "{(::$_endOfOuterBlock_$ () (::add 1 2))}")
testParse("1 |> add(2)", "{(:add 1 2)}")
})
describe("to", () => {
testParse("1 to 2", "{(::$_endOfOuterBlock_$ () (::credibleIntervalToDistribution 1 2))}")
testParse(
"-1 to -2",
"{(::$_endOfOuterBlock_$ () (::credibleIntervalToDistribution (::unaryMinus 1) (::unaryMinus 2)))}",
) // lower than unary
testParse("1 to 2", "{(:credibleIntervalToDistribution 1 2)}")
testParse("-1 to -2", "{(:credibleIntervalToDistribution (:unaryMinus 1) (:unaryMinus 2))}") // lower than unary
testParse(
"a[1] to a[2]",
"{(::$_endOfOuterBlock_$ () (::credibleIntervalToDistribution (::$_atIndex_$ :a 1) (::$_atIndex_$ :a 2)))}",
"{(:credibleIntervalToDistribution (:$_atIndex_$ :a 1) (:$_atIndex_$ :a 2))}",
) // lower than post
testParse(
"a.p1 to a.p2",
"{(::$_endOfOuterBlock_$ () (::credibleIntervalToDistribution (::$_atIndex_$ :a 'p1') (::$_atIndex_$ :a 'p2')))}",
"{(:credibleIntervalToDistribution (:$_atIndex_$ :a 'p1') (:$_atIndex_$ :a 'p2'))}",
) // lower than post
testParse(
"1 to 2 + 3",
"{(::$_endOfOuterBlock_$ () (::add (::credibleIntervalToDistribution 1 2) 3))}",
) // higher than binary operators
testParse("1 to 2 + 3", "{(:add (:credibleIntervalToDistribution 1 2) 3)}") // higher than binary operators
testParse(
"1->add(2) to 3->add(4) -> add(4)",
"{(::$_endOfOuterBlock_$ () (::credibleIntervalToDistribution (::add 1 2) (::add (::add 3 4) 4)))}",
"{(:credibleIntervalToDistribution (:add 1 2) (:add (:add 3 4) 4))}",
) // lower than chain
})
describe("inner block", () => {
// inner blocks are 0 argument lambdas. They can be used whenever a value is required.
// Like lambdas they have a local scope.
testParse("x={y=1; y}; x", "{:x = {:y = {1}; :y}; (::$_endOfOuterBlock_$ () :x)}")
testParse("x={y=1; y}; x", "{:x = {:y = {1}; :y}; :x}")
})
describe("lambda", () => {
testParse("{|x| x}", "{(::$_endOfOuterBlock_$ () {|:x| {:x}})}")
testParse("f={|x| x}", "{:f = {{|:x| {:x}}}; (::$_endOfOuterBlock_$ () ())}")
testParse("f(x)=x", "{:f = {|:x| {:x}}; (::$_endOfOuterBlock_$ () ())}") // Function definitions are lambda assignments
testParse(
"f(x)=x ? 1 : 0",
"{:f = {|:x| {(::$$_ternary_$$ :x 1 0)}}; (::$_endOfOuterBlock_$ () ())}",
) // Function definitions are lambda assignments
testParse("{|x| x}", "{{|:x| :x}}")
testParse("f={|x| x}", "{:f = {{|:x| :x}}}")
testParse("f(x)=x", "{:f = {|:x| {:x}}}") // Function definitions are lambda assignments
testParse("f(x)=x ? 1 : 0", "{:f = {|:x| {(::$$_ternary_$$ :x 1 0)}}}") // Function definitions are lambda assignments
})
describe("Using lambda as value", () => {
testParse(
"myadd(x,y)=x+y; z=myadd; z",
"{:myadd = {|:x,:y| {(::add :x :y)}}; :z = {:myadd}; (::$_endOfOuterBlock_$ () :z)}",
"{:myadd = {|:x,:y| {(:add :x :y)}}; :z = {:myadd}; :z}",
)
testParse(
"myadd(x,y)=x+y; z=[myadd]; z",
"{:myadd = {|:x,:y| {(::add :x :y)}}; :z = {(::$_constructArray_$ :myadd)}; (::$_endOfOuterBlock_$ () :z)}",
"{:myadd = {|:x,:y| {(:add :x :y)}}; :z = {[:myadd]}; :z}",
)
testParse(
"myaddd(x,y)=x+y; z={x: myaddd}; z",
"{:myaddd = {|:x,:y| {(::add :x :y)}}; :z = {(::$_constructRecord_$ ('x': :myaddd))}; (::$_endOfOuterBlock_$ () :z)}",
)
testParse("f({|x| x+1})", "{(::$_endOfOuterBlock_$ () (::f {|:x| {(::add :x 1)}}))}")
testParse(
"map(arr, {|x| x+1})",
"{(::$_endOfOuterBlock_$ () (::map :arr {|:x| {(::add :x 1)}}))}",
)
testParse(
"map([1,2,3], {|x| x+1})",
"{(::$_endOfOuterBlock_$ () (::map (::$_constructArray_$ 1 2 3) {|:x| {(::add :x 1)}}))}",
)
testParse(
"[1,2,3]->map({|x| x+1})",
"{(::$_endOfOuterBlock_$ () (::map (::$_constructArray_$ 1 2 3) {|:x| {(::add :x 1)}}))}",
"{:myaddd = {|:x,:y| {(:add :x :y)}}; :z = {{'x': :myaddd}}; :z}",
)
testParse("f({|x| x+1})", "{(:f {|:x| (:add :x 1)})}")
testParse("map(arr, {|x| x+1})", "{(:map :arr {|:x| (:add :x 1)})}")
testParse("map([1,2,3], {|x| x+1})", "{(:map [1; 2; 3] {|:x| (:add :x 1)})}")
testParse("[1,2,3]->map({|x| x+1})", "{(:map [1; 2; 3] {|:x| (:add :x 1)})}")
})
describe("unit", () => {
testParse("1m", "{(::$_endOfOuterBlock_$ () (::fromUnit_m 1))}")
testParse("1M", "{(::$_endOfOuterBlock_$ () (::fromUnit_M 1))}")
testParse("1m+2cm", "{(::$_endOfOuterBlock_$ () (::add (::fromUnit_m 1) (::fromUnit_cm 2)))}")
testParse("1m", "{(:fromUnit_m 1)}")
testParse("1M", "{(:fromUnit_M 1)}")
testParse("1m+2cm", "{(:add (:fromUnit_m 1) (:fromUnit_cm 2))}")
})
describe("Module", () => {
testParse("x", "{(::$_endOfOuterBlock_$ () :x)}")
testParse("Math.pi", "{(::$_endOfOuterBlock_$ () :Math.pi)}")
testParse("x", "{:x}")
testParse("Math.pi", "{:Math.pi}")
})
})
@ -351,19 +236,19 @@ describe("parsing new line", () => {
`
a +
b`,
"{(::$_endOfOuterBlock_$ () (::add :a :b))}",
"{(:add :a :b)}",
)
testParse(
`
x=
1`,
"{:x = {1}; (::$_endOfOuterBlock_$ () ())}",
"{:x = {1}}",
)
testParse(
`
x=1
y=2`,
"{:x = {1}; :y = {2}; (::$_endOfOuterBlock_$ () ())}",
"{:x = {1}; :y = {2}}",
)
testParse(
`
@ -371,7 +256,7 @@ describe("parsing new line", () => {
y=2;
y }
x`,
"{:x = {:y = {2}; :y}; (::$_endOfOuterBlock_$ () :x)}",
"{:x = {:y = {2}; :y}; :x}",
)
testParse(
`
@ -379,7 +264,7 @@ describe("parsing new line", () => {
y=2
y }
x`,
"{:x = {:y = {2}; :y}; (::$_endOfOuterBlock_$ () :x)}",
"{:x = {:y = {2}; :y}; :x}",
)
testParse(
`
@ -388,7 +273,7 @@ describe("parsing new line", () => {
y
}
x`,
"{:x = {:y = {2}; :y}; (::$_endOfOuterBlock_$ () :x)}",
"{:x = {:y = {2}; :y}; :x}",
)
testParse(
`
@ -396,7 +281,7 @@ describe("parsing new line", () => {
y=2
z=3
`,
"{:x = {1}; :y = {2}; :z = {3}; (::$_endOfOuterBlock_$ () ())}",
"{:x = {1}; :y = {2}; :z = {3}}",
)
testParse(
`
@ -407,7 +292,7 @@ describe("parsing new line", () => {
x+y+z
}
`,
"{:f = {:x = {1}; :y = {2}; :z = {3}; (::add (::add :x :y) :z)}; (::$_endOfOuterBlock_$ () ())}",
"{:f = {:x = {1}; :y = {2}; :z = {3}; (:add (:add :x :y) :z)}}",
)
testParse(
`
@ -420,7 +305,7 @@ describe("parsing new line", () => {
g=f+4
g
`,
"{:f = {:x = {1}; :y = {2}; :z = {3}; (::add (::add :x :y) :z)}; :g = {(::add :f 4)}; (::$_endOfOuterBlock_$ () :g)}",
"{:f = {:x = {1}; :y = {2}; :z = {3}; (:add (:add :x :y) :z)}; :g = {(:add :f 4)}; :g}",
)
testParse(
`
@ -442,7 +327,7 @@ describe("parsing new line", () => {
p ->
q
`,
"{:f = {:x = {1}; :y = {2}; :z = {3}; (::add (::add :x :y) :z)}; :g = {(::add :f 4)}; (::$_endOfOuterBlock_$ () (::q (::p (::h :g))))}",
"{:f = {:x = {1}; :y = {2}; :z = {3}; (:add (:add :x :y) :z)}; :g = {(:add :f 4)}; (:q (:p (:h :g)))}",
)
testParse(
`
@ -451,7 +336,7 @@ describe("parsing new line", () => {
c |>
d
`,
"{(::$_endOfOuterBlock_$ () (::d (::c (::b :a))))}",
"{(:d (:c (:b :a)))}",
)
testParse(
`
@ -461,6 +346,6 @@ describe("parsing new line", () => {
d +
e
`,
"{(::$_endOfOuterBlock_$ () (::add (::d (::c (::b :a))) :e))}",
"{(:add (:d (:c (:b :a))) :e)}",
)
})

View File

@ -1,6 +1,5 @@
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface.InternalExpressionValue
module Parse = Reducer_Peggy_Parse
module Result = Belt.Result
module ToExpression = Reducer_Peggy_ToExpression
@ -24,8 +23,7 @@ let expectToExpressionToBe = (expr, answer, ~v="_", ()) => {
let a2 =
rExpr
->Result.flatMap(expr => Expression.BackCompatible.evaluate(expr))
->Reducer_Helpers.rRemoveDefaultsInternal
->ExpressionValue.toStringResultOkless
->Reducer_Value.toStringResultOkless
(a1, a2)->expect->toEqual((answer, v))
}
}

View File

@ -1,23 +1,12 @@
module Bindings = Reducer_Bindings
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Jest
open Reducer_Peggy_TestHelpers
// Note: these tests aren't useful anymore since outer block macro got deleted.
// Probably can be removed or folded into other Peggy tests.
describe("Peggy Outer Block", () => {
testToExpression("1", "{(:$_endOfOuterBlock_$ () 1)}", ~v="1", ())
testToExpression("x=1", "{(:$_let_$ :x {1}); (:$_endOfOuterBlock_$ () ())}", ~v="()", ())
testToExpression(
"x=1; y=2",
"{(:$_let_$ :x {1}); (:$_let_$ :y {2}); (:$_endOfOuterBlock_$ () ())}",
~v="()",
(),
)
testToExpression("x=1; 2", "{(:$_let_$ :x {1}); (:$_endOfOuterBlock_$ () 2)}", ~v="2", ())
testToExpression(
"x={a=1; a}; x",
"{(:$_let_$ :x {(:$_let_$ :a {1}); :a}); (:$_endOfOuterBlock_$ () :x)}",
~v="1",
(),
)
testToExpression("1", "1", ~v="1", ())
testToExpression("x=1", "x = {1}", ~v="()", ())
testToExpression("x=1; y=2", "x = {1}; y = {2}", ~v="()", ())
testToExpression("x=1; 2", "x = {1}; 2", ~v="2", ())
testToExpression("x={a=1; a}; x", "x = {a = {1}; a}; x", ~v="1", ())
})

View File

@ -1,5 +1,4 @@
module Bindings = Reducer_Bindings
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open Jest
open Reducer_Peggy_TestHelpers
@ -7,160 +6,94 @@ open Reducer_Peggy_TestHelpers
describe("Peggy to Expression", () => {
describe("literals operators parenthesis", () => {
// Note that there is always an outer block. Otherwise, external bindings are ignored at the first statement
testToExpression("1", "{(:$_endOfOuterBlock_$ () 1)}", ~v="1", ())
testToExpression("'hello'", "{(:$_endOfOuterBlock_$ () 'hello')}", ~v="'hello'", ())
testToExpression("true", "{(:$_endOfOuterBlock_$ () true)}", ~v="true", ())
testToExpression("1+2", "{(:$_endOfOuterBlock_$ () (:add 1 2))}", ~v="3", ())
testToExpression("add(1,2)", "{(:$_endOfOuterBlock_$ () (:add 1 2))}", ~v="3", ())
testToExpression("(1)", "{(:$_endOfOuterBlock_$ () 1)}", ())
testToExpression("(1+2)", "{(:$_endOfOuterBlock_$ () (:add 1 2))}", ())
testToExpression("1", "1", ~v="1", ())
testToExpression("'hello'", "'hello'", ~v="'hello'", ())
testToExpression("true", "true", ~v="true", ())
testToExpression("1+2", "(add)(1, 2)", ~v="3", ())
testToExpression("add(1,2)", "(add)(1, 2)", ~v="3", ())
testToExpression("(1)", "1", ())
testToExpression("(1+2)", "(add)(1, 2)", ())
})
describe("unary", () => {
testToExpression("-1", "{(:$_endOfOuterBlock_$ () (:unaryMinus 1))}", ~v="-1", ())
testToExpression("!true", "{(:$_endOfOuterBlock_$ () (:not true))}", ~v="false", ())
testToExpression("1 + -1", "{(:$_endOfOuterBlock_$ () (:add 1 (:unaryMinus 1)))}", ~v="0", ())
testToExpression("-a[0]", "{(:$_endOfOuterBlock_$ () (:unaryMinus (:$_atIndex_$ :a 0)))}", ())
testToExpression("-1", "(unaryMinus)(1)", ~v="-1", ())
testToExpression("!true", "(not)(true)", ~v="false", ())
testToExpression("1 + -1", "(add)(1, (unaryMinus)(1))", ~v="0", ())
testToExpression("-a[0]", "(unaryMinus)(($_atIndex_$)(a, 0))", ())
})
describe("multi-line", () => {
testToExpression("x=1; 2", "{(:$_let_$ :x {1}); (:$_endOfOuterBlock_$ () 2)}", ~v="2", ())
testToExpression(
"x=1; y=2",
"{(:$_let_$ :x {1}); (:$_let_$ :y {2}); (:$_endOfOuterBlock_$ () ())}",
(),
)
testToExpression("x=1; 2", "x = {1}; 2", ~v="2", ())
testToExpression("x=1; y=2", "x = {1}; y = {2}", ())
})
describe("variables", () => {
testToExpression("x = 1", "{(:$_let_$ :x {1}); (:$_endOfOuterBlock_$ () ())}", ())
testToExpression("x", "{(:$_endOfOuterBlock_$ () :x)}", ~v="Error(x is not defined)", ()) //TODO: value should return error
testToExpression("x = 1; x", "{(:$_let_$ :x {1}); (:$_endOfOuterBlock_$ () :x)}", ~v="1", ())
testToExpression("x = 1", "x = {1}", ())
testToExpression("x", "x", ~v="Error(x is not defined)", ()) //TODO: value should return error
testToExpression("x = 1; x", "x = {1}; x", ~v="1", ())
})
describe("functions", () => {
testToExpression(
"identity(x) = x",
"{(:$_let_$ :identity (:$$_lambda_$$ [x] {:x})); (:$_endOfOuterBlock_$ () ())}",
(),
) // Function definitions become lambda assignments
testToExpression("identity(x)", "{(:$_endOfOuterBlock_$ () (:identity :x))}", ()) // Note value returns error properly
testToExpression("identity(x) = x", "identity = {|x| {x}}", ()) // Function definitions become lambda assignments
testToExpression("identity(x)", "(identity)(x)", ()) // Note value returns error properly
testToExpression(
"f(x) = x> 2 ? 0 : 1; f(3)",
"{(:$_let_$ :f (:$$_lambda_$$ [x] {(:$$_ternary_$$ (:larger :x 2) 0 1)})); (:$_endOfOuterBlock_$ () (:f 3))}",
"f = {|x| {(larger)(x, 2) ? (0) : (1)}}; (f)(3)",
~v="0",
(),
)
})
describe("arrays", () => {
testToExpression("[]", "{(:$_endOfOuterBlock_$ () (:$_constructArray_$))}", ~v="[]", ())
testToExpression(
"[0, 1, 2]",
"{(:$_endOfOuterBlock_$ () (:$_constructArray_$ 0 1 2))}",
~v="[0,1,2]",
(),
)
testToExpression(
"['hello', 'world']",
"{(:$_endOfOuterBlock_$ () (:$_constructArray_$ 'hello' 'world'))}",
~v="['hello','world']",
(),
)
testToExpression(
"([0,1,2])[1]",
"{(:$_endOfOuterBlock_$ () (:$_atIndex_$ (:$_constructArray_$ 0 1 2) 1))}",
~v="1",
(),
)
testToExpression("[]", "[]", ~v="[]", ())
testToExpression("[0, 1, 2]", "[0, 1, 2]", ~v="[0,1,2]", ())
testToExpression("['hello', 'world']", "['hello', 'world']", ~v="['hello','world']", ())
testToExpression("([0,1,2])[1]", "($_atIndex_$)([0, 1, 2], 1)", ~v="1", ())
})
describe("records", () => {
testToExpression(
"{a: 1, b: 2}",
"{(:$_endOfOuterBlock_$ () (:$_constructRecord_$ (('a' 1) ('b' 2))))}",
~v="{a: 1,b: 2}",
(),
)
testToExpression(
"{1+0: 1, 2+0: 2}",
"{(:$_endOfOuterBlock_$ () (:$_constructRecord_$ (((:add 1 0) 1) ((:add 2 0) 2))))}",
(),
) // key can be any expression
testToExpression(
"record.property",
"{(:$_endOfOuterBlock_$ () (:$_atIndex_$ :record 'property'))}",
(),
)
testToExpression("{a: 1, b: 2}", "{'a': 1, 'b': 2}", ~v="{a: 1,b: 2}", ())
testToExpression("{1+0: 1, 2+0: 2}", "{(add)(1, 0): 1, (add)(2, 0): 2}", ()) // key can be any expression
testToExpression("record.property", "($_atIndex_$)(record, 'property')", ())
testToExpression(
"record={property: 1}; record.property",
"{(:$_let_$ :record {(:$_constructRecord_$ (('property' 1)))}); (:$_endOfOuterBlock_$ () (:$_atIndex_$ :record 'property'))}",
"record = {{'property': 1}}; ($_atIndex_$)(record, 'property')",
~v="1",
(),
)
})
describe("comments", () => {
testToExpression("1 # This is a line comment", "{(:$_endOfOuterBlock_$ () 1)}", ~v="1", ())
testToExpression("1 // This is a line comment", "{(:$_endOfOuterBlock_$ () 1)}", ~v="1", ())
testToExpression(
"1 /* This is a multi line comment */",
"{(:$_endOfOuterBlock_$ () 1)}",
~v="1",
(),
)
testToExpression(
"/* This is a multi line comment */ 1",
"{(:$_endOfOuterBlock_$ () 1)}",
~v="1",
(),
)
testToExpression("1 # This is a line comment", "1", ~v="1", ())
testToExpression("1 // This is a line comment", "1", ~v="1", ())
testToExpression("1 /* This is a multi line comment */", "1", ~v="1", ())
testToExpression("/* This is a multi line comment */ 1", "1", ~v="1", ())
})
describe("ternary operator", () => {
testToExpression(
"true ? 1 : 0",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ true 1 0))}",
~v="1",
(),
)
testToExpression(
"false ? 1 : 0",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ false 1 0))}",
~v="0",
(),
)
testToExpression(
"true ? 1 : false ? 2 : 0",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ true 1 (:$$_ternary_$$ false 2 0)))}",
~v="1",
(),
) // nested ternary
testToExpression(
"false ? 1 : false ? 2 : 0",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ false 1 (:$$_ternary_$$ false 2 0)))}",
~v="0",
(),
) // nested ternary
testToExpression("true ? 1 : 0", "true ? (1) : (0)", ~v="1", ())
testToExpression("false ? 1 : 0", "false ? (1) : (0)", ~v="0", ())
testToExpression("true ? 1 : false ? 2 : 0", "true ? (1) : (false ? (2) : (0))", ~v="1", ()) // nested ternary
testToExpression("false ? 1 : false ? 2 : 0", "false ? (1) : (false ? (2) : (0))", ~v="0", ()) // nested ternary
describe("ternary bindings", () => {
testToExpression(
// expression binding
"f(a) = a > 5 ? 1 : 0; f(6)",
"{(:$_let_$ :f (:$$_lambda_$$ [a] {(:$$_ternary_$$ (:larger :a 5) 1 0)})); (:$_endOfOuterBlock_$ () (:f 6))}",
"f = {|a| {(larger)(a, 5) ? (1) : (0)}}; (f)(6)",
~v="1",
(),
)
testToExpression(
// when true binding
"f(a) = a > 5 ? a : 0; f(6)",
"{(:$_let_$ :f (:$$_lambda_$$ [a] {(:$$_ternary_$$ (:larger :a 5) :a 0)})); (:$_endOfOuterBlock_$ () (:f 6))}",
"f = {|a| {(larger)(a, 5) ? (a) : (0)}}; (f)(6)",
~v="6",
(),
)
testToExpression(
// when false binding
"f(a) = a < 5 ? 1 : a; f(6)",
"{(:$_let_$ :f (:$$_lambda_$$ [a] {(:$$_ternary_$$ (:smaller :a 5) 1 :a)})); (:$_endOfOuterBlock_$ () (:f 6))}",
"f = {|a| {(smaller)(a, 5) ? (1) : (a)}}; (f)(6)",
~v="6",
(),
)
@ -168,41 +101,23 @@ describe("Peggy to Expression", () => {
})
describe("if then else", () => {
testToExpression(
"if true then 2 else 3",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ true {2} {3}))}",
(),
)
testToExpression(
"if true then {2} else {3}",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ true {2} {3}))}",
(),
)
testToExpression("if true then 2 else 3", "true ? ({2}) : ({3})", ())
testToExpression("if true then {2} else {3}", "true ? ({2}) : ({3})", ())
testToExpression(
"if false then {2} else if false then {4} else {5}",
"{(:$_endOfOuterBlock_$ () (:$$_ternary_$$ false {2} (:$$_ternary_$$ false {4} {5})))}",
"false ? ({2}) : (false ? ({4}) : ({5}))",
(),
) //nested if
})
describe("pipe", () => {
testToExpression("1 -> add(2)", "{(:$_endOfOuterBlock_$ () (:add 1 2))}", ~v="3", ())
testToExpression(
"-1 -> add(2)",
"{(:$_endOfOuterBlock_$ () (:add (:unaryMinus 1) 2))}",
~v="1",
(),
) // note that unary has higher priority naturally
testToExpression(
"1 -> add(2) * 3",
"{(:$_endOfOuterBlock_$ () (:multiply (:add 1 2) 3))}",
~v="9",
(),
)
testToExpression("1 -> add(2)", "(add)(1, 2)", ~v="3", ())
testToExpression("-1 -> add(2)", "(add)((unaryMinus)(1), 2)", ~v="1", ()) // note that unary has higher priority naturally
testToExpression("1 -> add(2) * 3", "(multiply)((add)(1, 2), 3)", ~v="9", ())
})
describe("elixir pipe", () => {
testToExpression("1 |> add(2)", "{(:$_endOfOuterBlock_$ () (:add 1 2))}", ~v="3", ())
testToExpression("1 |> add(2)", "(add)(1, 2)", ~v="3", ())
})
// see testParse for priorities of to and credibleIntervalToDistribution
@ -212,44 +127,28 @@ describe("Peggy to Expression", () => {
// Like lambdas they have a local scope.
testToExpression(
"y=99; x={y=1; y}",
"{(:$_let_$ :y {99}); (:$_let_$ :x {(:$_let_$ :y {1}); :y}); (:$_endOfOuterBlock_$ () ())}",
"y = {99}; x = {y = {1}; y}",
// "{(:$_let_$ :y {99}); (:$_let_$ :x {(:$_let_$ :y {1}); :y}); (:$_endOfOuterBlock_$ () ())}",
(),
)
})
describe("lambda", () => {
testToExpression(
"{|x| x}",
"{(:$_endOfOuterBlock_$ () (:$$_lambda_$$ [x] {:x}))}",
~v="lambda(x=>internal code)",
(),
)
testToExpression(
"f={|x| x}",
"{(:$_let_$ :f {(:$$_lambda_$$ [x] {:x})}); (:$_endOfOuterBlock_$ () ())}",
(),
)
testToExpression(
"f(x)=x",
"{(:$_let_$ :f (:$$_lambda_$$ [x] {:x})); (:$_endOfOuterBlock_$ () ())}",
(),
) // Function definitions are lambda assignments
testToExpression(
"f(x)=x ? 1 : 0",
"{(:$_let_$ :f (:$$_lambda_$$ [x] {(:$$_ternary_$$ :x 1 0)})); (:$_endOfOuterBlock_$ () ())}",
(),
)
testToExpression("{|x| x}", "{|x| x}", ~v="lambda(x=>internal code)", ())
testToExpression("f={|x| x}", "f = {{|x| x}}", ())
testToExpression("f(x)=x", "f = {|x| {x}}", ()) // Function definitions are lambda assignments
testToExpression("f(x)=x ? 1 : 0", "f = {|x| {x ? (1) : (0)}}", ())
})
describe("module", () => {
// testToExpression("Math.pi", "{:Math.pi}", ~v="3.141592653589793", ())
// Only.test("stdlibrary", () => {
// ReducerInterface_StdLib.internalStdLib
// SquiggleLibrary_StdLib.stdLib
// ->IEvBindings
// ->InternalExpressionValue.toString
// ->Reducer_Value.toString
// ->expect
// ->toBe("")
// })
testToExpression("Math.pi", "{(:$_endOfOuterBlock_$ () :Math.pi)}", ~v="3.141592653589793", ())
testToExpression("Math.pi", "Math.pi", ~v="3.141592653589793", ())
})
})

View File

@ -3,22 +3,17 @@ open Reducer_Peggy_TestHelpers
describe("Peggy void", () => {
//literal
testToExpression("()", "{(:$_endOfOuterBlock_$ () ())}", ~v="()", ())
testToExpression("()", "()", ~v="()", ())
testToExpression(
"fn()=1",
"{(:$_let_$ :fn (:$$_lambda_$$ [_] {1})); (:$_endOfOuterBlock_$ () ())}",
"fn = {|_| {1}}",
// ~v="@{fn: lambda(_=>internal code)}",
(),
)
testToExpression(
"fn()=1; fn()",
"{(:$_let_$ :fn (:$$_lambda_$$ [_] {1})); (:$_endOfOuterBlock_$ () (:fn ()))}",
~v="1",
(),
)
testToExpression("fn()=1; fn()", "fn = {|_| {1}}; (fn)(())", ~v="1", ())
testToExpression(
"fn(a)=(); call fn(1)",
"{(:$_let_$ :fn (:$$_lambda_$$ [a] {()})); (:$_let_$ :_ {(:fn 1)}); (:$_endOfOuterBlock_$ () ())}",
"fn = {|a| {()}}; _ = {(fn)(1)}",
// ~v="@{_: (),fn: lambda(a=>internal code)}",
(),
)

View File

@ -1,7 +1,6 @@
module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
open Jest
open Expect
@ -9,7 +8,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
}
)
@ -18,15 +17,11 @@ let expectParseToBe = (code: string, answer: string) =>
Expression.BackCompatible.parse(code)->ExpressionT.toStringResult->expect->toBe(answer)
let expectEvalToBe = (code: string, answer: string) =>
Expression.BackCompatible.evaluateString(code)
->Reducer_Helpers.rRemoveDefaultsInternal
->InternalExpressionValue.toStringResult
->expect
->toBe(answer)
Expression.BackCompatible.evaluateString(code)->Reducer_Value.toStringResult->expect->toBe(answer)
let expectEvalError = (code: string) =>
Expression.BackCompatible.evaluateString(code)
->InternalExpressionValue.toStringResult
->Reducer_Value.toStringResult
->expect
->toMatch("Error\(")

View File

@ -1,89 +0,0 @@
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
let testMacro_ = (
tester,
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedCode: string,
) => {
let bindings = Bindings.fromArray(bindArray)
tester(expr->T.toString, () =>
expr
->Macro.expandMacroCallRs(
bindings,
ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject,
)
->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 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 MyOnly = {
let testMacro = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedExpr: string,
) => testMacro_(Only.test, bindArray, expr, expectedExpr)
let testMacroEval = (
bindArray: array<(string, InternalExpressionValue.t)>,
expr: T.expression,
expectedValue: string,
) => testMacroEval_(Only.test, bindArray, expr, expectedValue)
}

View File

@ -1,52 +0,0 @@
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
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 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 myTypeExpectEqual = (aTypeSourceCode, answer) =>
expect(myTypeEvalToString(aTypeSourceCode))->toEqual(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}")

View File

@ -1,42 +0,0 @@
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
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 myCheckArgumentsExpectEqual = (aTypeSourceCode, sourceCode, answer) =>
expect(myCheckArguments(aTypeSourceCode, sourceCode))->toEqual(answer)
let myCheckArgumentsTest = (test, aTypeSourceCode, sourceCode, answer) =>
test(aTypeSourceCode, () => myCheckArgumentsExpectEqual(aTypeSourceCode, sourceCode, answer))
myCheckArgumentsTest(test, "number=>number=>number", "[1,2]", "Ok")

View File

@ -1,73 +0,0 @@
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
// 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 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 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")

View File

@ -1,127 +0,0 @@
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
open ReducerInterface_InternalExpressionValue
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.
// 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 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'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,
),
]
//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))
}
// 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")])
let result = dispatchChainPiece(call, ProjectAccessorsT.identityAccessors)
expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
})
})

View File

@ -0,0 +1,14 @@
open Jest
open Expect
describe("ExpressionValue", () => {
test("argsToString", () =>
expect([IEvNumber(1.), IEvString("a")]->Reducer_Value.argsToString)->toBe("1,'a'")
)
test("toStringFunctionCall", () =>
expect(("fn", [IEvNumber(1.), IEvString("a")])->Reducer_Value.toStringFunctionCall)->toBe(
"fn(1,'a')",
)
)
})

View File

@ -2,11 +2,11 @@ open Jest
open Reducer_Peggy_TestHelpers
describe("Construct Array", () => {
testToExpression("[1,2]", "{(:$_endOfOuterBlock_$ () (:$_constructArray_$ 1 2))}", ~v="[1,2]", ())
testToExpression("[]", "{(:$_endOfOuterBlock_$ () (:$_constructArray_$))}", ~v="[]", ())
testToExpression("[1,2]", "[1, 2]", ~v="[1,2]", ())
testToExpression("[]", "[]", ~v="[]", ())
testToExpression(
"f(x)=x; g(x)=x; [f, g]",
"{(:$_let_$ :f (:$$_lambda_$$ [x] {:x})); (:$_let_$ :g (:$$_lambda_$$ [x] {:x})); (:$_endOfOuterBlock_$ () (:$_constructArray_$ :f :g))}",
"f = {|x| {x}}; g = {|x| {x}}; [f, g]",
~v="[lambda(x=>internal code),lambda(x=>internal code)]",
(),
)

View File

@ -2,17 +2,15 @@ open Jest
open Reducer_TestHelpers
describe("Parse function assignment", () => {
testParseToBe(
"f(x)=x",
"Ok({(:$_let_$ :f (:$$_lambda_$$ [x] {:x})); (:$_endOfOuterBlock_$ () ())})",
)
testParseToBe(
"f(x)=2*x",
"Ok({(:$_let_$ :f (:$$_lambda_$$ [x] {(:multiply 2 :x)})); (:$_endOfOuterBlock_$ () ())})",
)
testParseToBe("f(x)=x", "Ok(f = {|x| {x}})")
testParseToBe("f(x)=2*x", "Ok(f = {|x| {(multiply)(2, x)}})")
//MathJs does not allow blocks in function definitions
})
describe("Evaluate function assignment", () => {
testEvalToBe("f(x)=x; f(1)", "Ok(1)")
})
describe("Shadowing", () => {
testEvalToBe("x = 5; f(y) = x*y; x = 6; f(2)", "Ok(10)")
})

View File

@ -34,7 +34,7 @@ describe("symbol not defined", () => {
testEvalToBe("f(x)=x(y); f(f)", "Error(y is not defined)")
testEvalToBe("f(x)=x; f(f)", "Ok(lambda(x=>internal code))")
testEvalToBe("f(x)=x(y); f(z)", "Error(z is not defined)")
testEvalToBe("f(x)=x(y); f(2)", "Error(2 is not a function)")
testEvalToBe("f(x)=x(y); f(2)", "Error(y is not defined)")
testEvalToBe("f(x)=x(1); f(2)", "Error(2 is not a function)")
})
@ -46,10 +46,7 @@ describe("call and bindings", () => {
testEvalToBe("f(x)=x+1; y=f(1); f(1)", "Ok(2)")
testEvalToBe("f(x)=x+1; y=f(1); z=f(1); z", "Ok(2)")
testEvalToBe("f(x)=x+1; g(x)=f(x)+1; g(0)", "Ok(2)")
testParseToBe(
"f=99; g(x)=f; g(2)",
"Ok({(:$_let_$ :f {99}); (:$_let_$ :g (:$$_lambda_$$ [x] {:f})); (:$_endOfOuterBlock_$ () (:g 2))})",
)
testParseToBe("f=99; g(x)=f; g(2)", "Ok(f = {99}; g = {|x| {f}}; (g)(2))")
testEvalToBe("f=99; g(x)=f; g(2)", "Ok(99)")
testEvalToBe("f(x)=x; g(x)=f(x); g(2)", "Ok(2)")
testEvalToBe("f(x)=x+1; g(x)=f(x)+1; y=g(2); y", "Ok(4)")

View File

@ -5,3 +5,7 @@ Skip.describe("map reduce (sam)", () => {
testEvalToBe("addone(x)=x+1; map(2, addone)", "Error???")
testEvalToBe("addone(x)=x+1; map(2, {x: addone})", "Error???")
})
describe("map", () => {
testEvalToBe("arr=[1,2,3]; map(arr, {|x| x*2})", "Ok([2,4,6])")
})

View File

@ -2,10 +2,7 @@ open Jest
open Reducer_TestHelpers
describe("Parse ternary operator", () => {
testParseToBe(
"true ? 'YES' : 'NO'",
"Ok({(:$_endOfOuterBlock_$ () (:$$_ternary_$$ true 'YES' 'NO'))})",
)
testParseToBe("true ? 'YES' : 'NO'", "Ok(true ? ('YES') : ('NO'))")
})
describe("Evaluate ternary operator", () => {

View File

@ -2,19 +2,29 @@ open Jest
open Reducer_TestHelpers
describe("eval", () => {
// All MathJs operators and functions are builtin for string, float and boolean
// .e.g + - / * > >= < <= == /= not and or
// See https://mathjs.org/docs/reference/functions.html
describe("expressions", () => {
testEvalToBe("1", "Ok(1)")
testEvalToBe("-1", "Ok(-1)")
testEvalToBe("1-1", "Ok(0)")
testEvalToBe("1+2", "Ok(3)")
testEvalToBe("(1+2)*3", "Ok(9)")
testEvalToBe("2>1", "Ok(true)")
testEvalToBe("concat('a ', 'b')", "Ok('a b')")
testEvalToBe("concat([3,4], [5,6,7])", "Ok([3,4,5,6,7])")
testEvalToBe("log(10)", "Ok(2.302585092994046)")
testEvalToBe("cos(10)", "Ok(-0.8390715290764524)")
testEvalToBe("Math.cos(10)", "Ok(-0.8390715290764524)")
// TODO more built ins
})
describe("missing function", () => {
testEvalToBe("testZadanga(1)", "Error(testZadanga is not defined)")
testEvalToBe(
"arr = [normal(3,2)]; map(arr, zarathsuzaWasHere)",
"Error(zarathsuzaWasHere is not defined)",
)
})
describe("arrays", () => {
test("empty array", () => expectEvalToBe("[]", "Ok([])"))
testEvalToBe("[1, 2, 3]", "Ok([1,2,3])")
@ -50,6 +60,10 @@ describe("eval", () => {
testEvalError("1; 1")
testEvalToBe("x=1; x=1; x", "Ok(1)")
})
describe("blocks", () => {
testEvalToBe("x = { y = { z = 5; z * 2 }; y + 3 }; x", "Ok(13)")
})
})
describe("test exceptions", () => {

View File

@ -1,11 +0,0 @@
open ReducerInterface.InternalExpressionValue
open Jest
open Expect
describe("ExpressionValue", () => {
test("argsToString", () => expect([IEvNumber(1.), IEvString("a")]->argsToString)->toBe("1,'a'"))
test("toStringFunctionCall", () =>
expect(("fn", [IEvNumber(1.), IEvString("a")])->toStringFunctionCall)->toBe("fn(1,'a')")
)
})

View File

@ -1,7 +1,5 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
open Jest
open Expect
@ -30,12 +28,11 @@ x=1`,
| Error(error) => fail(error->Reducer_ErrorValue.errorToString)
}
})
let internalProject = project->Project.T.Private.castToInternalProject
test("past chain", () => {
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
expect(project->Project.getPastChain("main")) == ["common"]
})
test("import as variables", () => {
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == []
expect(project->Project.Private.getIncludesAsVariables("main")) == []
})
})
@ -67,20 +64,16 @@ x=1`,
}
})
let internalProject = project->Project.T.Private.castToInternalProject
test("direct past chain", () => {
expect(Project.Private.getPastChain(internalProject, "main")) == ["common"]
expect(project->Project.Private.getPastChain("main")) == ["common"]
})
test("direct includes", () => {
expect(Project.Private.getDirectIncludes(internalProject, "main")) == ["common"]
expect(project->Project.Private.getDirectIncludes("main")) == ["common"]
})
test("include as variables", () => {
expect(Project.Private.getIncludesAsVariables(internalProject, "main")) == [
("myVariable", "myModule"),
]
expect(project->Project.Private.getIncludesAsVariables("main")) == [("myVariable", "myModule")]
})
})
@ -109,13 +102,10 @@ x=1`,
| 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"),
]
expect(project->Project.Private.getIncludesAsVariables("main")) == [("myVariable", "myModule")]
})
})

View File

@ -1,5 +1,4 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
@ -7,29 +6,16 @@ open Jest
open Expect
open Expect.Operators
// test("", () => expect(1)->toBe(1))
let runFetchResult = (project, sourceId) => {
Project.run(project, sourceId)
Project.getResult(project, sourceId)->InternalExpressionValue.toStringResult
Project.getResult(project, sourceId)->Reducer_Value.toStringResult
}
let runFetchFlatBindings = (project, sourceId) => {
Project.run(project, sourceId)
Project.getBindings(project, sourceId)
->Bindings.removeResult
->InternalExpressionValue.toStringBindings
Project.getBindings(project, sourceId)->Reducer_Value.toStringRecord
}
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")
expect(answer)->toBe(sampleBindings)
})
test("test result true", () => {
let project = Project.createProject()
Project.setSource(project, "main", "true")
@ -51,7 +37,7 @@ test("test library", () => {
test("test bindings", () => {
let project = Project.createProject()
Project.setSource(project, "variables", "myVariable=666")
runFetchFlatBindings(project, "variables")->expect->toBe("@{myVariable: 666}")
runFetchFlatBindings(project, "variables")->expect->toBe("{myVariable: 666}")
})
describe("project1", () => {
@ -59,7 +45,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,17 +63,17 @@ 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", () => {
runFetchResult(project, "main")->expect->toBe("Ok(1)")
})
test("test bindings", () => {
runFetchFlatBindings(project, "first")->expect->toBe("@{x: 1}")
runFetchFlatBindings(project, "first")->expect->toBe("{x: 1}")
})
})
@ -98,7 +83,7 @@ describe("project2", () => {
Project.setContinues(project, "second", ["first"])
Project.setSource(project, "first", "x=1")
Project.setSource(project, "second", "y=2")
Project.setSource(project, "main", "y")
Project.setSource(project, "main", "z=3;y")
test("runOrder", () => {
expect(Project.getRunOrder(project)) == ["first", "second", "main"]
@ -122,7 +107,8 @@ describe("project2", () => {
runFetchResult(project, "main")->expect->toBe("Ok(2)")
})
test("test bindings", () => {
runFetchFlatBindings(project, "main")->expect->toBe("@{x: 1,y: 2}")
// bindings from continues are not exposed!
runFetchFlatBindings(project, "main")->expect->toBe("{z: 3}")
})
})
@ -152,7 +138,7 @@ describe("project with include", () => {
)
Project.parseIncludes(project, "second") //The only way of setting includes
Project.setSource(project, "main", "y")
Project.setSource(project, "main", "z=3; y")
test("runOrder", () => {
expect(Project.getRunOrder(project)) == ["common", "first", "second", "main"]
@ -178,7 +164,8 @@ describe("project with include", () => {
runFetchResult(project, "main")->expect->toBe("Ok(2)")
})
test("test bindings", () => {
runFetchFlatBindings(project, "main")->expect->toBe("@{common: 0,x: 1,y: 2}")
// bindings from continues are not exposed!
runFetchFlatBindings(project, "main")->expect->toBe("{z: 3}")
})
})

View File

@ -1,5 +1,4 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
@ -16,13 +15,13 @@ Case "Running a single source".
/* Let's start with running a single source and getting Result as well as the Bindings
First you need to create a project. A project is a collection of sources.
Project takes care of the dependencies between the sources, correct compilation and run order.
You can run any source in the project. It will be compiled and run if it is not already done else already existing results will be presented.
You can run any source in the project. It will be compiled and run if it hasn't happened already; otherwise already existing results will be presented.
The dependencies will be automatically compiled and run. So you don't need to worry about that in a multi source project.
In summary you issue a run command on the whole project or on a specific source to ensure that there is a result for that source.
*/
let project = Project.createProject()
/* Every source has a name. This is used for debugging, dependencies and error messages. */
Project.setSource(project, "main", "1 + 2")
project->Project.setSource("main", "1 + 2")
/* Let's run "main" source. */
project->Project.run("main")
/* Now you have a result for "main" source.
@ -46,27 +45,25 @@ Case "Running a single source".
Getting None means you have forgotten to run the source.
*/
let result = project->Project.getResult("main")
let bindings = project->Project.getBindings("main")->Bindings.removeResult
let bindings = project->Project.getBindings("main")
/* Let's display the result and bindings */
(
result->InternalExpressionValue.toStringResult,
bindings->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(3)", "@{}")
(result->Reducer_Value.toStringResult, bindings->Reducer_Value.toStringRecord)->expect ==
("Ok(3)", "{}")
/* You've got 3 with empty bindings. */
})
test("run summary", () => {
let project = Project.createProject()
Project.setSource(project, "main", "1 + 2")
Project.runAll(project)
let result = Project.getResult(project, "main")
let bindings = Project.getBindings(project, "main")->Bindings.removeResult
project->Project.setSource("main", "1 + 2")
project->Project.runAll
let result = project->Project.getResult("main")
let bindings = project->Project.getBindings("main")
/* Now you have external bindings and external result. */
(
result->InternalExpressionValue.toStringResult,
bindings->InternalExpressionValue.IEvBindings->InternalExpressionValue.toString,
)->expect == ("Ok(3)", "@{}")
result->Reducer_Value.toStringResult,
bindings->Reducer_T.IEvRecord->Reducer_Value.toString,
)->expect == ("Ok(3)", "{}")
})
test("run with an environment", () => {
@ -74,23 +71,21 @@ Case "Running a single source".
let project = Project.createProject()
/* Optional. Set your custom environment anytime before running */
Project.setEnvironment(project, InternalExpressionValue.defaultEnvironment)
project->Project.setEnvironment(Reducer_Context.defaultEnvironment)
Project.setSource(project, "main", "1 + 2")
Project.runAll(project)
let result = Project.getResult(project, "main")
let _bindings = Project.getBindings(project, "main")
result->InternalExpressionValue.toStringResult->expect == "Ok(3)"
project->Project.setSource("main", "1 + 2")
project->Project.runAll
let result = project->Project.getResult("main")
let _bindings = project->Project.getBindings("main")
result->Reducer_Value.toStringResult->expect == "Ok(3)"
})
test("shortcut", () => {
/* If you are running single source without includes and you don't need a custom environment, you can use the shortcut. */
/* Examples above was to prepare you for the multi source tutorial. */
let (result, bindings) = Project.evaluate("1+2")
(
result->InternalExpressionValue.toStringResult,
bindings->Bindings.removeResult->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(3)", "@{}")
(result->Reducer_Value.toStringResult, bindings->Reducer_Value.toStringRecord)->expect ==
("Ok(3)", "{}")
})
})
})

View File

@ -1,5 +1,4 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
@ -14,27 +13,25 @@ describe("ReducerProject Tutorial", () => {
test("Chaining", () => {
let project = Project.createProject()
/* This time let's add 3 sources and chain them together */
Project.setSource(project, "source1", "x=1")
project->Project.setSource("source1", "x=1")
Project.setSource(project, "source2", "y=2")
project->Project.setSource("source2", "y=x+1")
/* To run, source2 depends on source1 */
Project.setContinues(project, "source2", ["source1"])
project->Project.setContinues("source2", ["source1"])
Project.setSource(project, "source3", "z=3")
project->Project.setSource("source3", "z=y+1")
/* To run, source3 depends on source2 */
Project.setContinues(project, "source3", ["source2"])
project->Project.setContinues("source3", ["source2"])
/* Now we can run the project */
Project.runAll(project)
project->Project.runAll
/* And let's check the result and bindings of source3 */
let result3 = Project.getResult(project, "source3")
let bindings3 = Project.getBindings(project, "source3")->Bindings.removeResult
let result3 = project->Project.getResult("source3")
let bindings3 = project->Project.getBindings("source3")
(
result3->InternalExpressionValue.toStringResult,
bindings3->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(())", "@{x: 1,y: 2,z: 3}")
(result3->Reducer_Value.toStringResult, bindings3->Reducer_Value.toStringRecord)->expect ==
("Ok(())", "{z: 3}")
})
test("Depending", () => {
@ -43,24 +40,22 @@ describe("ReducerProject Tutorial", () => {
let project = Project.createProject()
/* This time source1 and source2 are not depending on anything */
Project.setSource(project, "source1", "x=1")
Project.setSource(project, "source2", "y=2")
project->Project.setSource("source1", "x=1")
project->Project.setSource("source2", "y=2")
Project.setSource(project, "source3", "z=3")
project->Project.setSource("source3", "z=x+y")
/* To run, source3 depends on source1 and source3 together */
Project.setContinues(project, "source3", ["source1", "source2"])
project->Project.setContinues("source3", ["source1", "source2"])
/* Now we can run the project */
Project.runAll(project)
project->Project.runAll
/* And let's check the result and bindings of source3 */
let result3 = Project.getResult(project, "source3")
let bindings3 = Project.getBindings(project, "source3")->Bindings.removeResult
let result3 = project->Project.getResult("source3")
let bindings3 = project->Project.getBindings("source3")
(
result3->InternalExpressionValue.toStringResult,
bindings3->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(())", "@{x: 1,y: 2,z: 3}")
(result3->Reducer_Value.toStringResult, bindings3->Reducer_Value.toStringRecord)->expect ==
("Ok(())", "{z: 3}")
})
test("Intro to including", () => {
@ -70,33 +65,30 @@ describe("ReducerProject Tutorial", () => {
let project = Project.createProject()
/* This time source1 and source2 are not depending on anything */
Project.setSource(project, "source1", "x=1")
Project.setSource(project, "source2", "y=2")
project->Project.setSource("source1", "x=1")
project->Project.setSource("source2", "y=2")
Project.setSource(
project,
project->Project.setSource(
"source3",
`
#include "source1"
#include "source2"
z=3`,
z=x+y`,
)
/* We need to parse the includes to set the dependencies */
Project.parseIncludes(project, "source3")
project->Project.parseIncludes("source3")
/* Now we can run the project */
Project.runAll(project)
project->Project.runAll
/* And let's check the result and bindings of source3
This time you are getting all the variables because we are including the other sources
Behind the scenes parseIncludes is setting the dependencies */
let result3 = Project.getResult(project, "source3")
let bindings3 = Project.getBindings(project, "source3")->Bindings.removeResult
let result3 = project->Project.getResult("source3")
let bindings3 = project->Project.getBindings("source3")
(
result3->InternalExpressionValue.toStringResult,
bindings3->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(())", "@{x: 1,y: 2,z: 3}")
(result3->Reducer_Value.toStringResult, bindings3->Reducer_Value.toStringRecord)->expect ==
("Ok(())", "{z: 3}")
/*
Doing it like this is too verbose for a storybook
But I hope you have seen the relation of setContinues and parseIncludes */

View File

@ -1,5 +1,4 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
@ -16,8 +15,7 @@ Here we will finally proceed to a real life scenario. */
/* Here we investigate the details about parseIncludes, before setting up a real life scenario in the next section. */
/* Everything happens inside a project, so let's have a project */
let project = Project.createProject()
Project.setSource(
project,
project->Project.setSource(
"main",
`
#include "common"
@ -25,10 +23,10 @@ Here we will finally proceed to a real life scenario. */
`,
)
/* We need to parse includes after changing the source */
Project.parseIncludes(project, "main")
project->Project.parseIncludes("main")
test("getDependencies", () => {
/* Parse includes has set the dependencies */
Project.getDependencies(project, "main")->expect == ["common"]
project->Project.getDependencies("main")->expect == ["common"]
/* If there were no includes than there would be no dependencies */
/* However if there was a syntax error at includes then would be no dependencies also */
/* Therefore looking at dependencies is not the right way to load includes */
@ -36,7 +34,7 @@ Here we will finally proceed to a real life scenario. */
})
test("getIncludes", () => {
/* Parse includes has set the includes */
switch Project.getIncludes(project, "main") {
switch project->Project.getIncludes("main") {
| Ok(includes) => includes->expect == ["common"]
| Error(err) => err->Reducer_ErrorValue.errorToString->fail
}
@ -50,7 +48,7 @@ Here we will finally proceed to a real life scenario. */
include or depend on the current source.
But you don't need to use this to execute the projects.
It is provided for completeness of information. */
Project.getDependents(project, "main")->expect == []
project->Project.getDependents("main")->expect == []
/* Nothing is depending on or including main */
})
@ -76,29 +74,29 @@ Here we will finally proceed to a real life scenario. */
/* let's recursively load the sources */
let rec loadIncludesRecursively = (project, sourceName, visited) => {
if Js.Array2.includes(visited, sourceName) {
if visited->Js.Array2.includes(sourceName) {
/* Oh we have already visited this source. There is an include cycle */
"Cyclic include ${sourceName}"->Js.Exn.raiseError
} else {
let newVisited = Js.Array2.copy(visited)
let _ = Js.Array2.push(newVisited, sourceName)
let _ = newVisited->Js.Array2.push(sourceName)
/* Let's parse the includes and dive into them */
Project.parseIncludes(project, sourceName)
let rIncludes = Project.getIncludes(project, sourceName)
let rIncludes = project->Project.getIncludes(sourceName)
switch rIncludes {
/* Maybe there is an include syntax error */
| Error(err) => err->Reducer_ErrorValue.errorToString->Js.Exn.raiseError
| Ok(includes) =>
Belt.Array.forEach(includes, newIncludeName => {
includes->Belt.Array.forEach(newIncludeName => {
/* We have got one of the new includes.
Let's load it and add it to the project */
let newSource = loadSource(newIncludeName)
Project.setSource(project, newIncludeName, newSource)
project->Project.setSource(newIncludeName, newSource)
/* The new source is loaded and added to the project. */
/* Of course the new source might have includes too. */
/* Let's recursively load them */
loadIncludesRecursively(project, newIncludeName, newVisited)
project->loadIncludesRecursively(newIncludeName, newVisited)
})
}
}
@ -110,45 +108,44 @@ Here we will finally proceed to a real life scenario. */
let project = Project.createProject()
/* main includes source3 which includes source2 which includes source1 */
Project.setSource(
project,
project->Project.setSource(
"main",
`
#include "source1"
#include "source2"
#include "source3"
x+y+z
a = x+y+z
b = doubleX
a
`,
)
/* Setting source requires parsing and loading the includes recursively */
loadIncludesRecursively(project, "main", []) //No visited yet
project->loadIncludesRecursively("main", []) // Not visited yet
/* Let's salt it more. Let's have another source in the project which also has includes */
/* doubleX includes source1 which is eventually included by main as well */
Project.setSource(
project,
project->Project.setSource(
"doubleX",
`
#include "source1"
doubleX = x * 2
`,
)
loadIncludesRecursively(project, "doubleX", [])
project->loadIncludesRecursively("doubleX", [])
/* Remember, any time you set a source, you need to load includes recursively */
/* As doubleX is not included by main, it is not loaded recursively.
So we link it to the project as a dependency */
Project.setContinues(project, "main", ["doubleX"])
project->Project.setContinues("main", ["doubleX"])
/* Let's run the project */
Project.runAll(project)
let result = Project.getResult(project, "main")
let bindings = Project.getBindings(project, "main")
project->Project.runAll
let result = project->Project.getResult("main")
let bindings = project->Project.getBindings("main")
/* And see the result and bindings.. */
test("recursive includes", () => {
(
result->InternalExpressionValue.toStringResult,
bindings->Bindings.removeResult->InternalExpressionValue.toStringBindings,
)->expect == ("Ok(6)", "@{doubleX: 2,x: 1,y: 2,z: 3}")
(result->Reducer_Value.toStringResult, bindings->Reducer_Value.toStringRecord)->expect ==
("Ok(6)", "{a: 6,b: 2}")
/* Everything as expected */
})
})

View File

@ -1,7 +1,5 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
open Jest
open Expect
@ -30,7 +28,7 @@ describe("ReducerProject Tutorial", () => {
/* We can now run the project */
Project.runAll(project)
let result = Project.getResult(project, "main")
result->InternalExpressionValue.toStringResult->expect == "Ok(6)"
result->Reducer_Value.toStringResult->expect == "Ok(6)"
})
})

View File

@ -1,5 +1,4 @@
@@warning("-44")
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Project = ForTS_ReducerProject
module Bindings = Reducer_Bindings
@ -32,7 +31,7 @@ describe("ReducerProject Tutorial", () => {
test("userResults", () => {
let userResultsAsString = Belt.Array.map(userResults, aResult =>
aResult->InternalExpressionValue.toStringResult
aResult->Reducer_Value.toStringResult
)
userResultsAsString->expect == ["Ok(2)", "Ok(4)", "Ok(6)", "Ok(8)", "Ok(10)"]
})

View File

@ -23,7 +23,7 @@ describe("eval on distribution functions", () => {
testEval("-normal(5,2)", "Ok(Normal(-5,2))")
})
describe("to", () => {
testEval("5 to 2", "Error(TODO: Low value must be less than high value.)")
testEval("5 to 2", "Error(Error: Low value must be less than high value.)")
testEval("to(2,5)", "Ok(Lognormal(1.1512925464970227,0.27853260523016377))")
testEval("to(-2,2)", "Ok(Normal(0,1.2159136638235384))")
})
@ -119,40 +119,28 @@ describe("eval on distribution functions", () => {
describe("parse on distribution functions", () => {
describe("power", () => {
testParse(
"normal(5,2) ^ normal(5,1)",
"Ok({(:$_endOfOuterBlock_$ () (:pow (:normal 5 2) (:normal 5 1)))})",
)
testParse("3 ^ normal(5,1)", "Ok({(:$_endOfOuterBlock_$ () (:pow 3 (:normal 5 1)))})")
testParse("normal(5,2) ^ 3", "Ok({(:$_endOfOuterBlock_$ () (:pow (:normal 5 2) 3))})")
testParse("normal(5,2) ^ normal(5,1)", "Ok((pow)((normal)(5, 2), (normal)(5, 1)))")
testParse("3 ^ normal(5,1)", "Ok((pow)(3, (normal)(5, 1)))")
testParse("normal(5,2) ^ 3", "Ok((pow)((normal)(5, 2), 3))")
})
describe("subtraction", () => {
testParse("10 - normal(5,1)", "Ok({(:$_endOfOuterBlock_$ () (:subtract 10 (:normal 5 1)))})")
testParse("normal(5,1) - 10", "Ok({(:$_endOfOuterBlock_$ () (:subtract (:normal 5 1) 10))})")
testParse("10 - normal(5,1)", "Ok((subtract)(10, (normal)(5, 1)))")
testParse("normal(5,1) - 10", "Ok((subtract)((normal)(5, 1), 10))")
})
describe("pointwise arithmetic expressions", () => {
testParse(~skip=true, "normal(5,2) .+ normal(5,1)", "Ok((:dotAdd (:normal 5 2) (:normal 5 1)))")
testParse(
~skip=true,
"normal(5,2) .- normal(5,1)",
"Ok((:$_endOfOuterBlock_$ () (:$$_block_$$ (:dotSubtract (:normal 5 2) (:normal 5 1)))))",
"Ok((:$$_block_$$ (:dotSubtract (:normal 5 2) (:normal 5 1))))",
// TODO: !!! returns "Ok({(:dotPow (:normal 5 2) (:normal 5 1))})"
)
testParse(
"normal(5,2) .* normal(5,1)",
"Ok({(:$_endOfOuterBlock_$ () (:dotMultiply (:normal 5 2) (:normal 5 1)))})",
)
testParse(
"normal(5,2) ./ normal(5,1)",
"Ok({(:$_endOfOuterBlock_$ () (:dotDivide (:normal 5 2) (:normal 5 1)))})",
)
testParse(
"normal(5,2) .^ normal(5,1)",
"Ok({(:$_endOfOuterBlock_$ () (:dotPow (:normal 5 2) (:normal 5 1)))})",
)
testParse("normal(5,2) .* normal(5,1)", "Ok((dotMultiply)((normal)(5, 2), (normal)(5, 1)))")
testParse("normal(5,2) ./ normal(5,1)", "Ok((dotDivide)((normal)(5, 2), (normal)(5, 1)))")
testParse("normal(5,2) .^ normal(5,1)", "Ok((dotPow)((normal)(5, 2), (normal)(5, 1)))")
})
describe("equality", () => {
testParse("5 == normal(5,2)", "Ok({(:$_endOfOuterBlock_$ () (:equal 5 (:normal 5 2)))})")
testParse("5 == normal(5,2)", "Ok((equal)(5, (normal)(5, 2)))")
})
describe("pointwise adding two normals", () => {
testParse(~skip=true, "normal(5,2) .+ normal(5,1)", "Ok((:dotAdd (:normal 5 2) (:normal 5 1)))")

View File

@ -3,11 +3,7 @@ open Expect
open Reducer_TestHelpers
let expectEvalToBeOk = (code: string) =>
Reducer_Expression.BackCompatible.evaluateString(code)
->Reducer_Helpers.rRemoveDefaultsInternal
->E.R.isOk
->expect
->toBe(true)
Reducer_Expression.BackCompatible.evaluateString(code)->E.R.isOk->expect->toBe(true)
let registry = FunctionRegistry_Library.registry
let examples = E.A.to_list(FunctionRegistry_Core.Registry.allExamples(registry))
@ -15,7 +11,7 @@ let examples = E.A.to_list(FunctionRegistry_Core.Registry.allExamples(registry))
describe("FunctionRegistry Library", () => {
describe("Regular tests", () => {
testEvalToBe("List.make(3, 'HI')", "Ok(['HI','HI','HI'])")
testEvalToBe("make(3, 'HI')", "Error(Function not found: make(Number,String))")
testEvalToBe("make(3, 'HI')", "Error(make is not defined)")
testEvalToBe("List.upTo(1,3)", "Ok([1,2,3])")
testEvalToBe("List.first([3,5,8])", "Ok(3)")
testEvalToBe("List.last([3,5,8])", "Ok(8)")
@ -84,6 +80,13 @@ describe("FunctionRegistry Library", () => {
"SampleSet.toList(SampleSet.mapN([SampleSet.fromList([1,2,3,4,5,6]), SampleSet.fromList([6, 5, 4, 3, 2, 1])], {|x| x[0] > x[1] ? x[0] : x[1]}))",
"Ok([6,5,4,4,5,6])",
)
testEvalToBe("Dict.merge({a: 1, b: 2}, {b: 3, c: 4, d: 5})", "Ok({a: 1,b: 3,c: 4,d: 5})")
testEvalToBe("Dict.mergeMany([{a: 1, b: 2}, {c: 3, d: 4}, {c: 5, e: 6}])", "Ok({a: 1,b: 2,c: 5,d: 4,e: 6})")
testEvalToBe("Dict.keys({a: 1, b: 2})", "Ok(['a','b'])")
testEvalToBe("Dict.values({a: 1, b: 2})", "Ok([1,2])")
testEvalToBe("Dict.toList({a: 1, b: 2})", "Ok([['a',1],['b',2]])")
testEvalToBe("Dict.fromList([['a', 1], ['b', 2]])", "Ok({a: 1,b: 2})")
})
describe("Fn auto-testing", () => {
@ -102,7 +105,7 @@ describe("FunctionRegistry Library", () => {
let responseType =
example
->Reducer_Expression.BackCompatible.evaluateString
->E.R2.fmap(ReducerInterface_InternalExpressionValue.valueToValueType)
->E.R2.fmap(Reducer_Value.valueToValueType)
let expectedOutputType = fn.output |> E.O.toExn("")
expect(responseType)->toEqual(Ok(expectedOutputType))
},

View File

@ -0,0 +1,80 @@
module Map: Benchmark_Helpers.BenchmarkTopic = {
let arraySize = 1000
let iterations = 300_000
let beltArray = () => {
let x = Belt.Array.make(arraySize, 0.)
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Belt.Array.map(v => v)
})
}
let jsArray2 = () => {
let x = Belt.Array.make(arraySize, 0.)
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Js.Array2.map(v => v)
})
}
let ocamlArray = () => {
let x = Belt.Array.make(arraySize, 0.)
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Array.map(v => v, _)
})
}
let runAll = () => {
Js.log(
`Mapping identity function over arrays of size ${arraySize->Js.Int.toString} (${iterations->Js.Int.toString} iterations)`,
)
Benchmark_Helpers.measure("Belt.Array.map", beltArray)
Benchmark_Helpers.measure("Js.Array2.map", jsArray2)
Benchmark_Helpers.measure("Array.map", ocamlArray)
}
}
module Sort: Benchmark_Helpers.BenchmarkTopic = {
let arraySize = 1000
let iterations = 30000
let jsArray2 = () => {
let x = Belt.Array.make(arraySize, 0.)
let compare = (a: float, b: float) => {
if a < b {
-1
} else {
1
}
}
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Js.Array2.sortInPlaceWith(compare)
})
}
let jsArray2withOcamlCompare = () => {
let x = Belt.Array.make(arraySize, 0.)
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Js.Array2.sortInPlaceWith(Pervasives.compare)
})
}
let ocamlArray = () => {
let x = Belt.Array.make(arraySize, 0.)
Belt.Range.forEach(1, iterations, _ => {
let _ = x->Array.fast_sort(compare, _)
})
}
let runAll = () => {
Js.log(
`Sorting arrays of size ${arraySize->Js.Int.toString} (${iterations->Js.Int.toString} iterations)`,
)
Benchmark_Helpers.measure("Js.Array2.sort", jsArray2)
Benchmark_Helpers.measure("Js.Array2.sort with Ocaml compare", jsArray2withOcamlCompare)
Benchmark_Helpers.measure("Array.fast_sort", ocamlArray)
}
}
Map.runAll()
Sort.runAll()

View File

@ -0,0 +1,11 @@
module type BenchmarkTopic = {
let runAll: unit => unit
}
let measure = (name: string, f: unit => unit) => {
let start = Js.Date.make()->Js.Date.valueOf
f()
let end = Js.Date.make()->Js.Date.valueOf
let duration = (end -. start) /. 1000.
Js.log2(duration, name)
}

View File

@ -0,0 +1,63 @@
module StringMap: Benchmark_Helpers.BenchmarkTopic = {
let size = 1000
let iterations = 10_000
let kv = Belt.Array.range(1, size)->Belt.Array.map(v => ("key" ++ v->Belt.Int.toString, v))
let beltMap = () => {
Belt.Range.forEach(1, iterations, _ => {
let m = Belt.Map.String.empty
let _ = Belt.Array.reduce(kv, m, (acc, (k, v)) => acc->Belt.Map.String.set(k, v))
})
}
let beltMutableMap = () => {
Belt.Range.forEach(1, iterations, _ => {
let m = Belt.MutableMap.String.make()
let _ = Belt.Array.reduce(kv, m, (acc, (k, v)) => {
acc->Belt.MutableMap.String.set(k, v)
acc
})
})
}
let beltHashMap = () => {
Belt.Range.forEach(1, iterations, _ => {
let m = Belt.HashMap.String.make(~hintSize=100)
let _ = Belt.Array.reduce(kv, m, (acc, (k, v)) => {
acc->Belt.HashMap.String.set(k, v)
acc
})
})
}
let jsDict = () => {
Belt.Range.forEach(1, iterations, _ => {
let m = Js.Dict.empty()
let _ = Belt.Array.reduce(kv, m, (acc, (k, v)) => {
acc->Js.Dict.set(k, v)
acc
})
})
}
let jsMap = () => {
Belt.Range.forEach(1, iterations, _ => {
let m = Js_map.make()
let _ = Belt.Array.reduce(kv, m, (acc, (k, v)) => acc->Js_map.set(k, v))
})
}
let runAll = () => {
Js.log(
`Filling a map with ("key{i}" => "i") key-value pairs, size ${size->Js.Int.toString} (${iterations->Js.Int.toString} iterations)`,
)
Benchmark_Helpers.measure("Belt.Map.String", beltMap)
Benchmark_Helpers.measure("Belt.MutableMap.String", beltMutableMap)
Benchmark_Helpers.measure("Belt.HashMap.String", beltHashMap)
Benchmark_Helpers.measure("Js.Dict", jsDict)
Benchmark_Helpers.measure("Js.Map", jsMap)
}
}
let runAll = StringMap.runAll()

View File

@ -9,6 +9,11 @@
"dir": "__tests__",
"type": "dev",
"subdirs": true
},
{
"dir": "benchmark",
"type": "dev",
"subdirs": true
}
],
"bsc-flags": ["-bs-super-errors", "-bs-no-version-header", "-bs-g"],
@ -21,7 +26,12 @@
"suffix": ".bs.js",
"namespace": true,
"bs-dependencies": ["bisect_ppx"],
"bs-dev-dependencies": ["@glennsl/rescript-jest", "rescript-fast-check"],
"bs-dev-dependencies": [
"@glennsl/rescript-jest",
"rescript-fast-check",
"rescript-js-map",
"rescript-js-iterator"
],
"gentypeconfig": {
"language": "typescript",
"module": "commonjs",

View File

@ -10,5 +10,7 @@ module.exports = {
"/node_modules/",
".*Helpers.bs.js",
".*Helpers.ts",
".*Reducer_Type.*",
".*_type_test.bs.js",
],
};

View File

@ -1,6 +1,6 @@
{
"name": "@quri/squiggle-lang",
"version": "0.4.2",
"version": "0.5.0-alpha.2",
"homepage": "https://squiggle-language.com",
"license": "MIT",
"scripts": {
@ -66,6 +66,7 @@
"reanalyze": "^2.23.0",
"rescript": "^9.1.4",
"rescript-fast-check": "^1.1.1",
"rescript-js-map": "^1.1.0",
"ts-jest": "^27.1.4",
"ts-loader": "^9.4.0",
"ts-node": "^10.9.1",

View File

@ -13,7 +13,7 @@ export const measure = (cb, times = 1) => {
export const red = (str) => `\x1b[31m${str}\x1b[0m`;
export const green = (str) => `\x1b[32m${str}\x1b[0m`;
export const run = (src, { output, sampleCount }) => {
export const run = (src, { output, sampleCount } = {}) => {
const project = SqProject.create();
if (sampleCount) {
project.setEnvironment({

View File

@ -7,4 +7,6 @@ if (!src) {
}
console.log(`Running ${src}`);
run(src);
const sampleCount = process.env.SAMPLE_COUNT;
run(src, { output: true, sampleCount });

View File

@ -1,30 +0,0 @@
import * as RSModuleValue from "../rescript/ForTS/ForTS_SquiggleValue/ForTS_SquiggleValue_Module.gen";
import { SqModuleValue, wrapValue } from "./SqValue";
import { SqValueLocation } from "./SqValueLocation";
export class SqModule {
constructor(
private _value: RSModuleValue.squiggleValue_Module,
public location: SqValueLocation
) {}
entries() {
return RSModuleValue.getKeyValuePairs(this._value).map(
([k, v]) => [k, wrapValue(v, this.location.extend(k))] as const
);
}
asValue() {
return new SqModuleValue(
RSModuleValue.toSquiggleValue(this._value),
this.location
);
}
get(k: string) {
const v = RSModuleValue.get(this._value, k);
return v === undefined || v === null
? undefined
: wrapValue(v, this.location.extend(k));
}
}

View File

@ -1,4 +1,4 @@
import * as _ from "lodash";
import zipWith from "lodash/zipWith";
import { wrapDistribution } from "./SqDistribution";
import * as RSPointSetDist from "../rescript/ForTS/ForTS_Distribution/ForTS_Distribution_PointSetDistribution.gen";
import { pointSetDistributionTag as Tag } from "../rescript/ForTS/ForTS_Distribution/ForTS_Distribution_PointSetDistribution_tag";
@ -16,7 +16,7 @@ const shapePoints = (
): SqPoint[] => {
let xs = x.xyShape.xs;
let ys = x.xyShape.ys;
return _.zipWith(xs, ys, (x, y) => ({ x, y }));
return zipWith(xs, ys, (x, y) => ({ x, y }));
};
export const wrapPointSetDist = (value: T) => {

View File

@ -2,7 +2,7 @@ import * as RSProject from "../rescript/ForTS/ForTS_ReducerProject.gen";
import { reducerErrorValue } from "../rescript/ForTS/ForTS_Reducer_ErrorValue.gen";
import { environment } from "../rescript/ForTS/ForTS_Distribution/ForTS_Distribution_Environment.gen";
import { SqError } from "./SqError";
import { SqModule } from "./SqModule";
import { SqRecord } from "./SqRecord";
import { wrapValue } from "./SqValue";
import { resultMap2 } from "./types";
import { SqValueLocation } from "./SqValueLocation";
@ -83,7 +83,7 @@ export class SqProject {
}
getBindings(sourceId: string) {
return new SqModule(
return new SqRecord(
RSProject.getBindings(this._value, sourceId),
new SqValueLocation(this, sourceId, {
root: "bindings",
@ -111,4 +111,8 @@ export class SqProject {
setEnvironment(environment: environment) {
RSProject.setEnvironment(this._value, environment);
}
getEnvironment(): environment {
return RSProject.getEnvironment(this._value);
}
}

View File

@ -1,5 +1,5 @@
import * as RSRecord from "../rescript/ForTS/ForTS_SquiggleValue/ForTS_SquiggleValue_Record.gen";
import { wrapValue } from "./SqValue";
import { SqRecordValue, wrapValue } from "./SqValue";
import { SqValueLocation } from "./SqValueLocation";
type T = RSRecord.squiggleValue_Record;
@ -12,4 +12,15 @@ export class SqRecord {
([k, v]) => [k, wrapValue(v, this.location.extend(k))] as const
);
}
toString() {
return RSRecord.toString(this._value);
}
asValue() {
return new SqRecordValue(
RSRecord.toSquiggleValue(this._value),
this.location
);
}
}

View File

@ -1,7 +0,0 @@
import * as RSType from "../rescript/ForTS/ForTS_SquiggleValue/ForTS_SquiggleValue_Type.gen";
type T = RSType.squiggleValue_Type;
export class SqType {
constructor(private _value: T) {}
}

View File

@ -3,11 +3,8 @@ import { squiggleValueTag as Tag } from "../rescript/ForTS/ForTS_SquiggleValue/F
import { wrapDistribution } from "./SqDistribution";
import { SqLambda } from "./SqLambda";
import { SqLambdaDeclaration } from "./SqLambdaDeclaration";
import { SqModule } from "./SqModule";
import { SqRecord } from "./SqRecord";
import { SqArray } from "./SqArray";
import { SqType } from "./SqType";
import { SqProject } from "./SqProject";
import { SqValueLocation } from "./SqValueLocation";
export { Tag as SqValueTag };
@ -46,14 +43,6 @@ export class SqArrayValue extends SqAbstractValue {
}
}
export class SqArrayStringValue extends SqAbstractValue {
tag = Tag.ArrayString as const;
get value() {
return this.valueMethod(RSValue.getArrayString);
}
}
export class SqBoolValue extends SqAbstractValue {
tag = Tag.Bool as const;
@ -62,14 +51,6 @@ export class SqBoolValue extends SqAbstractValue {
}
}
export class SqCallValue extends SqAbstractValue {
tag = Tag.Call as const;
get value() {
return this.valueMethod(RSValue.getCall);
}
}
export class SqDateValue extends SqAbstractValue {
tag = Tag.Date as const;
@ -102,14 +83,6 @@ export class SqLambdaValue extends SqAbstractValue {
}
}
export class SqModuleValue extends SqAbstractValue {
tag = Tag.Module as const;
get value() {
return new SqModule(this.valueMethod(RSValue.getModule), this.location);
}
}
export class SqNumberValue extends SqAbstractValue {
tag = Tag.Number as const;
@ -134,14 +107,6 @@ export class SqStringValue extends SqAbstractValue {
}
}
export class SqSymbolValue extends SqAbstractValue {
tag = Tag.Symbol as const;
get value(): string {
return this.valueMethod(RSValue.getSymbol);
}
}
export class SqTimeDurationValue extends SqAbstractValue {
tag = Tag.TimeDuration as const;
@ -150,22 +115,6 @@ export class SqTimeDurationValue extends SqAbstractValue {
}
}
export class SqTypeValue extends SqAbstractValue {
tag = Tag.Type as const;
get value() {
return new SqType(this.valueMethod(RSValue.getType));
}
}
export class SqTypeIdentifierValue extends SqAbstractValue {
tag = Tag.TypeIdentifier as const;
get value() {
return this.valueMethod(RSValue.getTypeIdentifier);
}
}
export class SqVoidValue extends SqAbstractValue {
tag = Tag.Void as const;
@ -176,21 +125,15 @@ export class SqVoidValue extends SqAbstractValue {
const tagToClass = {
[Tag.Array]: SqArrayValue,
[Tag.ArrayString]: SqArrayStringValue,
[Tag.Bool]: SqBoolValue,
[Tag.Call]: SqCallValue,
[Tag.Date]: SqDateValue,
[Tag.Declaration]: SqDeclarationValue,
[Tag.Distribution]: SqDistributionValue,
[Tag.Lambda]: SqLambdaValue,
[Tag.Module]: SqModuleValue,
[Tag.Number]: SqNumberValue,
[Tag.Record]: SqRecordValue,
[Tag.String]: SqStringValue,
[Tag.Symbol]: SqSymbolValue,
[Tag.TimeDuration]: SqTimeDurationValue,
[Tag.Type]: SqTypeValue,
[Tag.TypeIdentifier]: SqTypeIdentifierValue,
[Tag.Void]: SqVoidValue,
} as const;
@ -198,19 +141,13 @@ const tagToClass = {
// type SqValue = typeof tagToClass[keyof typeof tagToClass];
export type SqValue =
| SqArrayValue
| SqArrayStringValue
| SqBoolValue
| SqCallValue
| SqDateValue
| SqDeclarationValue
| SqDistributionValue
| SqLambdaValue
| SqModuleValue
| SqNumberValue
| SqRecordValue
| SqStringValue
| SqSymbolValue
| SqTimeDurationValue
| SqTypeValue
| SqTypeIdentifierValue
| SqVoidValue;

View File

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

View File

@ -1,5 +1,6 @@
const pdfast = require("pdfast");
const _ = require("lodash");
const filter = require("lodash/filter");
const isFinite = require("lodash/isFinite");
const samplesToContinuousPdf = (
samples,
@ -8,12 +9,12 @@ const samplesToContinuousPdf = (
min = false,
max = false
) => {
let _samples = _.filter(samples, _.isFinite);
if (_.isFinite(min)) {
_samples = _.filter(_samples, (r) => r > min);
let _samples = filter(samples, isFinite);
if (isFinite(min)) {
_samples = filter(_samples, (r) => r > min);
}
if (_.isFinite(max)) {
_samples = _.filter(_samples, (r) => r < max);
if (isFinite(max)) {
_samples = filter(_samples, (r) => r < max);
}
// The pdf that's created from this function is not a pdf but a pmf. y values

View File

@ -62,7 +62,7 @@ let toPointSetDist = (
~samplingInputs: SamplingInputs.samplingInputs,
(),
): Internals.Types.outputs => {
let samples = samples->Js.Array2.copy->Js.Array2.sortInPlaceWith(compare)
let samples = samples->E.A.Floats.sort
let minDiscreteToKeep = MagicNumbers.ToPointSet.minDiscreteToKeep(samples)
let (continuousPart, discretePart) = E.A.Floats.Sorted.splitContinuousAndDiscreteForMinWeight(

View File

@ -0,0 +1,102 @@
open FunctionRegistry_Core
open FunctionRegistry_Helpers
let nameSpace = "" // no namespaced versions
type simpleDefinition = {
inputs: array<frType>,
fn: array<Reducer_T.value> => result<Reducer_T.value, errorValue>,
}
let makeFnMany = (name: string, definitions: array<simpleDefinition>) =>
Function.make(
~name,
~nameSpace,
~requiresNamespace=false,
~definitions=definitions->Js.Array2.map(({inputs, fn}) =>
FnDefinition.make(~name, ~inputs, ~run=(inputs, _, _) => fn(inputs), ())
),
(),
)
let makeFn = (
name: string,
inputs: array<frType>,
fn: array<Reducer_T.value> => result<Reducer_T.value, errorValue>,
) => makeFnMany(name, [{inputs: inputs, fn: fn}])
let library = [
Make.ff2f(~name="add", ~fn=(x, y) => x +. y, ()), // infix + (see Reducer/Reducer_Peggy/helpers.ts)
Make.ff2f(~name="subtract", ~fn=(x, y) => x -. y, ()), // infix -
Make.ff2f(~name="multiply", ~fn=(x, y) => x *. y, ()), // infix *
Make.ff2f(~name="divide", ~fn=(x, y) => x /. y, ()), // infix /
Make.ff2f(~name="pow", ~fn=(x, y) => Js.Math.pow_float(~base=x, ~exp=y), ()), // infix ^
Make.ff2b(~name="equal", ~fn=(x, y) => x == y, ()), // infix == on numbers
Make.bb2b(~name="equal", ~fn=(x, y) => x == y, ()), // infix == on booleans
Make.ff2b(~name="unequal", ~fn=(x, y) => x != y, ()), // infix != on numbers
Make.ff2b(~name="unequal", ~fn=(x, y) => x != y, ()), // infix != on booleans
Make.ff2b(~name="smaller", ~fn=(x, y) => x < y, ()), // infix <
Make.ff2b(~name="smallerEq", ~fn=(x, y) => x <= y, ()), // infix <=
Make.ff2b(~name="larger", ~fn=(x, y) => x > y, ()), // infix >
Make.ff2b(~name="largerEq", ~fn=(x, y) => x >= y, ()), // infix >=
Make.bb2b(~name="or", ~fn=(x, y) => x || y, ()), // infix ||
Make.bb2b(~name="and", ~fn=(x, y) => x && y, ()), // infix &&
Make.f2f(~name="unaryMinus", ~fn=x => -.x, ()), // unary prefix -
makeFn("not", [FRTypeNumber], inputs => {
// unary prefix !
switch inputs {
| [IEvNumber(x)] => IEvBool(x != 0.)->Ok
| _ => Error(impossibleError)
}
}),
makeFn("not", [FRTypeBool], inputs => {
// unary prefix !
switch inputs {
| [IEvBool(x)] => IEvBool(!x)->Ok
| _ => Error(impossibleError)
}
}),
makeFn("concat", [FRTypeString, FRTypeString], inputs => {
switch inputs {
| [IEvString(a), IEvString(b)] => {
let answer = Js.String2.concat(a, b)
answer->Reducer_T.IEvString->Ok
}
| _ => Error(impossibleError)
}
}),
makeFn("concat", [FRTypeArray(FRTypeAny), FRTypeArray(FRTypeAny)], inputs => {
switch inputs {
| [IEvArray(originalA), IEvArray(b)] => {
let a = originalA->Js.Array2.copy
let _ = Js.Array2.pushMany(a, b)
a->Reducer_T.IEvArray->Ok
}
| _ => Error(impossibleError)
}
}),
makeFn("inspect", [FRTypeAny], inputs => {
switch inputs {
| [value] => {
Js.log(value->Reducer_Value.toString)
value->Ok
}
| _ => Error(impossibleError)
}
}),
makeFn("inspect", [FRTypeAny, FRTypeString], inputs => {
switch inputs {
| [value, IEvString(label)] => {
Js.log(`${label}: ${value->Reducer_Value.toString}`)
value->Ok
}
| _ => Error(impossibleError)
}
}),
makeFn("javascriptraise", [FRTypeAny], inputs => {
switch inputs {
| [msg] => Js.Exn.raiseError(msg->Reducer_Value.toString)
| _ => Error(impossibleError)
}
}),
]

View File

@ -8,11 +8,11 @@ let requiresNamespace = true
module Combinatorics = {
module Helpers = {
let laplace = ((successes, trials)) => (successes +. 1.0) /. (trials +. 2.0)
let laplace = (successes, trials) => (successes +. 1.0) /. (trials +. 2.0)
let factorial = Stdlib.Math.factorial
let choose = ((n, k)) => factorial(n) /. (factorial(n -. k) *. factorial(k))
let choose = (n, k) => factorial(n) /. (factorial(n -. k) *. factorial(k))
let pow = (base, exp) => Js.Math.pow_float(~base, ~exp)
let binomial = ((n, k, p)) => choose((n, k)) *. pow(p, k) *. pow(1.0 -. p, n -. k)
let binomial = (n, k, p) => choose(n, k) *. pow(p, k) *. pow(1.0 -. p, n -. k)
}
module Lib = {
let laplace = Function.make(
@ -69,15 +69,15 @@ module Integration = {
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
aLambda,
list{pointAsInternalExpression},
[pointAsInternalExpression],
environment,
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",
"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"->Reducer_ErrorValue.REOther,
)
}
result
@ -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)
@ -141,11 +141,11 @@ module Integration = {
resultWithOuterPoints
}
| Error(b) =>
Error(
"Integration error 2 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." ++
"Original error: " ++
b,
)
("Integration error 2 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." ++
"Original error: " ++
b->Reducer_ErrorValue.errorToString)
->Reducer_ErrorValue.REOther
->Error
}
result
}
@ -165,10 +165,12 @@ module Integration = {
FnDefinition.make(
~name="integrateFunctionBetweenWithNumIntegrationPoints",
~inputs=[FRTypeLambda, FRTypeNumber, FRTypeNumber, FRTypeNumber],
~run=(inputs, _, env, reducer) => {
~run=(inputs, env, reducer) => {
let result = switch inputs {
| [_, _, _, IEvNumber(0.0)] =>
Error("Integration error 4 in Danger.integrate: Increment can't be 0.")
"Integration error 4 in Danger.integrate: Increment can't be 0."
->Reducer_ErrorValue.REOther
->Error
| [
IEvLambda(aLambda),
IEvNumber(min),
@ -185,7 +187,9 @@ module Integration = {
)
| _ =>
Error(
"Integration error 5 in Danger.integrate. Remember that inputs are (function, number (min), number (max), number(increment))",
Reducer_ErrorValue.REOther(
"Integration error 5 in Danger.integrate. Remember that inputs are (function, number (min), number (max), number(increment))",
),
)
}
result
@ -205,10 +209,12 @@ module Integration = {
FnDefinition.make(
~name="integrateFunctionBetweenWithEpsilon",
~inputs=[FRTypeLambda, FRTypeNumber, FRTypeNumber, FRTypeNumber],
~run=(inputs, _, env, reducer) => {
~run=(inputs, env, reducer) => {
let result = switch inputs {
| [_, _, _, IEvNumber(0.0)] =>
Error("Integration error in Danger.integrate: Increment can't be 0.")
"Integration error in Danger.integrate: Increment can't be 0."
->Reducer_ErrorValue.REOther
->Error
| [IEvLambda(aLambda), IEvNumber(min), IEvNumber(max), IEvNumber(epsilon)] =>
Helpers.integrateFunctionBetweenWithNumIntegrationPoints(
aLambda,
@ -218,12 +224,13 @@ module Integration = {
env,
reducer,
)->E.R2.errMap(b =>
"Integration error 7 in Danger.integrate. Something went wrong along the way: " ++ b
("Integration error 7 in Danger.integrate. Something went wrong along the way: " ++
b->Reducer_ErrorValue.errorToString)->Reducer_ErrorValue.REOther
)
| _ =>
Error(
"Integration error 8 in Danger.integrate. Remember that inputs are (function, number (min), number (max), number(increment))",
)
"Integration error 8 in Danger.integrate. Remember that inputs are (function, number (min), number (max), number(increment))"
->Reducer_ErrorValue.REOther
->Error
}
result
},
@ -239,16 +246,16 @@ module DiminishingReturns = {
module Helpers = {
type diminishingReturnsAccumulatorInner = {
optimalAllocations: array<float>,
currentMarginalReturns: result<array<float>, string>,
currentMarginalReturns: result<array<float>, errorValue>,
}
let findBiggestElementIndex = xs =>
let findBiggestElementIndex = (xs: array<float>) =>
E.A.reducei(xs, 0, (acc, newElement, index) => {
switch newElement > xs[acc] {
| true => index
| false => acc
}
})
type diminishingReturnsAccumulator = result<diminishingReturnsAccumulatorInner, string>
type diminishingReturnsAccumulator = result<diminishingReturnsAccumulatorInner, errorValue>
// TODO: This is so complicated, it probably should be its own file. It might also make sense to have it work in Rescript directly, taking in a function rather than a reducer; then something else can wrap that function in the reducer/lambdas/environment.
/*
The key idea for this function is that
@ -283,19 +290,19 @@ module DiminishingReturns = {
) {
| (false, _, _, _) =>
Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, number of functions should be greater than 1.",
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, number of functions should be greater than 1."->Reducer_ErrorValue.REOther,
)
| (_, false, _, _) =>
Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, funds should be greater than 0.",
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, funds should be greater than 0."->Reducer_ErrorValue.REOther,
)
| (_, _, false, _) =>
Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, approximateIncrement should be greater than 0.",
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, approximateIncrement should be greater than 0."->Reducer_ErrorValue.REOther,
)
| (_, _, _, false) =>
Error(
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, approximateIncrement should be smaller than funds amount.",
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions, approximateIncrement should be smaller than funds amount."->Reducer_ErrorValue.REOther,
)
| (true, true, true, true) => {
let applyFunctionAtPoint = (lambda, point: float) => {
@ -303,15 +310,15 @@ module DiminishingReturns = {
let pointAsInternalExpression = FunctionRegistry_Helpers.Wrappers.evNumber(point)
let resultAsInternalExpression = Reducer_Expression_Lambda.doLambdaCall(
lambda,
list{pointAsInternalExpression},
[pointAsInternalExpression],
environment,
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",
"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"->Reducer_ErrorValue.REOther,
)
}
}
@ -396,16 +403,16 @@ module DiminishingReturns = {
FnDefinition.make(
~name="optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions",
~inputs=[FRTypeArray(FRTypeLambda), FRTypeNumber, FRTypeNumber],
~run=(inputs, _, environment, reducer) =>
~run=(inputs, environment, reducer) =>
switch inputs {
| [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",
)
"Error in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. A member of the array wasn't a function"
->Reducer_ErrorValue.REOther
->Error
}
}, innerlambdas)
let wrappedLambdas = E.A.R.firstErrorOrOpen(individuallyWrappedLambdas)
@ -424,7 +431,10 @@ module DiminishingReturns = {
}
result
}
| _ => Error("Error in Danger.diminishingMarginalReturnsForTwoFunctions")
| _ =>
"Error in Danger.diminishingMarginalReturnsForTwoFunctions"
->Reducer_ErrorValue.REOther
->Error
},
(),
),

View File

@ -0,0 +1,159 @@
open FunctionRegistry_Core
open FunctionRegistry_Helpers
let makeFn = (
name: string,
inputs: array<frType>,
fn: array<Reducer_T.value> => result<Reducer_T.value, errorValue>,
) =>
Function.make(
~name,
~nameSpace="",
~requiresNamespace=false,
~definitions=[FnDefinition.make(~name, ~inputs, ~run=(inputs, _, _) => fn(inputs), ())],
(),
)
let makeNumberToDurationFn = (name: string, fn: float => DateTime.Duration.t) =>
Function.make(
~name,
~nameSpace="",
~requiresNamespace=false,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeNumber],
~run=(inputs, _, _) =>
switch inputs {
| [IEvNumber(t)] => IEvTimeDuration(fn(t))->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
let makeDurationToNumberFn = (name: string, fn: DateTime.Duration.t => float) =>
Function.make(
~name,
~nameSpace="",
~requiresNamespace=false,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeTimeDuration],
~run=(inputs, _, _) =>
switch inputs {
| [IEvTimeDuration(t)] => IEvNumber(fn(t))->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
let library = [
makeFn("toString", [FRTypeDate], inputs =>
switch inputs {
| [IEvDate(t)] => IEvString(DateTime.Date.toString(t))->Ok
| _ => Error(impossibleError)
}
),
makeFn("makeDateFromYear", [FRTypeNumber], inputs =>
switch inputs {
| [IEvNumber(year)] =>
switch DateTime.Date.makeFromYear(year) {
| Ok(t) => IEvDate(t)->Ok
| Error(e) => Reducer_ErrorValue.RETodo(e)->Error
}
| _ => Error(impossibleError)
}
),
makeFn("dateFromNumber", [FRTypeNumber], inputs =>
switch inputs {
| [IEvNumber(f)] => IEvDate(DateTime.Date.fromFloat(f))->Ok
| _ => Error(impossibleError)
}
),
makeFn("toNumber", [FRTypeDate], inputs =>
switch inputs {
| [IEvDate(f)] => IEvNumber(DateTime.Date.toFloat(f))->Ok
| _ => Error(impossibleError)
}
),
makeFn("subtract", [FRTypeDate, FRTypeDate], inputs =>
switch inputs {
| [IEvDate(d1), IEvDate(d2)] =>
switch DateTime.Date.subtract(d1, d2) {
| Ok(d) => IEvTimeDuration(d)->Ok
| Error(e) => Error(RETodo(e))
}
| _ => Error(impossibleError)
}
),
makeFn("subtract", [FRTypeDate, FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvDate(d1), IEvTimeDuration(d2)] => IEvDate(DateTime.Date.subtractDuration(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("add", [FRTypeDate, FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvDate(d1), IEvTimeDuration(d2)] => IEvDate(DateTime.Date.addDuration(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("toString", [FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvTimeDuration(t)] => IEvString(DateTime.Duration.toString(t))->Ok
| _ => Error(impossibleError)
}
),
makeNumberToDurationFn("minutes", DateTime.Duration.fromMinutes),
makeNumberToDurationFn("fromUnit_minutes", DateTime.Duration.fromMinutes),
makeNumberToDurationFn("hours", DateTime.Duration.fromHours),
makeNumberToDurationFn("fromUnit_hours", DateTime.Duration.fromHours),
makeNumberToDurationFn("days", DateTime.Duration.fromDays),
makeNumberToDurationFn("fromUnit_days", DateTime.Duration.fromDays),
makeNumberToDurationFn("years", DateTime.Duration.fromYears),
makeNumberToDurationFn("fromUnit_years", DateTime.Duration.fromYears),
makeDurationToNumberFn("toMinutes", DateTime.Duration.toMinutes),
makeDurationToNumberFn("toHours", DateTime.Duration.toHours),
makeDurationToNumberFn("toDays", DateTime.Duration.toDays),
makeDurationToNumberFn("toYears", DateTime.Duration.toYears),
makeFn("add", [FRTypeTimeDuration, FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvTimeDuration(d1), IEvTimeDuration(d2)] =>
IEvTimeDuration(DateTime.Duration.add(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("subtract", [FRTypeTimeDuration, FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvTimeDuration(d1), IEvTimeDuration(d2)] =>
IEvTimeDuration(DateTime.Duration.subtract(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("multiply", [FRTypeTimeDuration, FRTypeNumber], inputs =>
switch inputs {
| [IEvTimeDuration(d1), IEvNumber(d2)] =>
IEvTimeDuration(DateTime.Duration.multiply(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("divide", [FRTypeTimeDuration, FRTypeNumber], inputs =>
switch inputs {
| [IEvTimeDuration(d1), IEvNumber(d2)] => IEvTimeDuration(DateTime.Duration.divide(d1, d2))->Ok
| _ => Error(impossibleError)
}
),
makeFn("divide", [FRTypeTimeDuration, FRTypeTimeDuration], inputs =>
switch inputs {
| [IEvTimeDuration(d1), IEvTimeDuration(d2)] => IEvNumber(d1 /. d2)->Ok
| _ => Error(impossibleError)
}
),
]

View File

@ -4,23 +4,23 @@ open FunctionRegistry_Helpers
let nameSpace = "Dict"
module Internals = {
type t = ReducerInterface_InternalExpressionValue.map
type t = Reducer_T.map
let keys = (a: t): internalExpressionValue => IEvArray(
let keys = (a: t): Reducer_T.value => IEvArray(
Belt.Map.String.keysToArray(a)->E.A2.fmap(Wrappers.evString),
)
let values = (a: t): internalExpressionValue => IEvArray(Belt.Map.String.valuesToArray(a))
let values = (a: t): Reducer_T.value => IEvArray(Belt.Map.String.valuesToArray(a))
let toList = (a: t): internalExpressionValue =>
let toList = (a: t): Reducer_T.value =>
Belt.Map.String.toArray(a)
->E.A2.fmap(((key, value)) => Wrappers.evArray([IEvString(key), value]))
->Wrappers.evArray
let fromList = (items: array<internalExpressionValue>): result<internalExpressionValue, string> =>
let fromList = (items: array<Reducer_T.value>): result<Reducer_T.value, errorValue> =>
items
->E.A2.fmap(item => {
switch (item: internalExpressionValue) {
switch (item: Reducer_T.value) {
| IEvArray([IEvString(string), value]) => (string, value)->Ok
| _ => Error(impossibleError)
}
@ -29,12 +29,8 @@ module Internals = {
->E.R2.fmap(Belt.Map.String.fromArray)
->E.R2.fmap(Wrappers.evRecord)
let merge = (a: t, b: t): internalExpressionValue => IEvRecord(
Belt.Map.String.merge(a, b, (_, _, c) => c),
)
//Belt.Map.String has a function for mergeMany, but I couldn't understand how to use it yet.
let mergeMany = (a: array<t>): internalExpressionValue => {
let mergeMany = (a: array<t>): Reducer_T.value => {
let mergedValues =
a->E.A2.fmap(Belt.Map.String.toArray)->Belt.Array.concatMany->Belt.Map.String.fromArray
IEvRecord(mergedValues)
@ -52,10 +48,10 @@ let library = [
FnDefinition.make(
~name="merge",
~inputs=[FRTypeDict(FRTypeAny), FRTypeDict(FRTypeAny)],
~run=(inputs, _, _, _) => {
~run=(inputs, _, _) => {
switch inputs {
| [IEvRecord(d1), IEvRecord(d2)] => Internals.merge(d1, d2)->Ok
| _ => Error(impossibleError)
| [IEvRecord(d1), IEvRecord(d2)] => Internals.mergeMany([d1, d2])->Ok
| _ => impossibleError->Error
}
},
(),
@ -63,7 +59,7 @@ let library = [
],
(),
),
//TODO: Change to use new mergeMany() function.
Function.make(
~name="mergeMany",
~nameSpace,
@ -74,13 +70,17 @@ let library = [
FnDefinition.make(
~name="mergeMany",
~inputs=[FRTypeArray(FRTypeDict(FRTypeAny))],
~run=(_, inputs, _, _) =>
inputs
->Prepare.ToTypedArray.dicts
->E.R2.fmap(E.Dict.concatMany)
->E.R2.fmap(Js.Dict.map((. r) => FunctionRegistry_Core.FRType.matchReverse(r)))
->E.R2.fmap(r => r->Js.Dict.entries->Belt.Map.String.fromArray)
->E.R2.fmap(Wrappers.evRecord),
~run=(inputs, _, _) => {
switch inputs {
| [IEvArray(dicts)] => {
dicts->Belt.Array.map(dictValue => switch dictValue {
| IEvRecord(dict) => dict
| _ => impossibleError->Reducer_ErrorValue.toException
})->Internals.mergeMany->Ok
}
| _ => impossibleError->Error
}
},
(),
),
],
@ -96,7 +96,7 @@ let library = [
FnDefinition.make(
~name="keys",
~inputs=[FRTypeDict(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvRecord(d1)] => Internals.keys(d1)->Ok
| _ => Error(impossibleError)
@ -116,7 +116,7 @@ let library = [
FnDefinition.make(
~name="values",
~inputs=[FRTypeDict(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvRecord(d1)] => Internals.values(d1)->Ok
| _ => Error(impossibleError)
@ -136,7 +136,7 @@ let library = [
FnDefinition.make(
~name="toList",
~inputs=[FRTypeDict(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvRecord(dict)] => dict->Internals.toList->Ok
| _ => Error(impossibleError)
@ -156,7 +156,7 @@ let library = [
FnDefinition.make(
~name="fromList",
~inputs=[FRTypeArray(FRTypeArray(FRTypeAny))],
~run=(inputs, _, _, _) => {
~run=(inputs, _, _) => {
switch inputs {
| [IEvArray(items)] => Internals.fromList(items)
| _ => Error(impossibleError)

View File

@ -4,7 +4,7 @@ let twoArgs = E.Tuple2.toFnCall
module DistributionCreation = {
let nameSpace = "Dist"
let output = ReducerInterface_InternalExpressionValue.EvtDistribution
let output = Reducer_Value.EvtDistribution
let requiresNamespace = false
let fnMake = (~name, ~examples, ~definitions) => {
@ -16,13 +16,14 @@ module DistributionCreation = {
r
->E.R.bind(Process.DistOrNumberToDist.twoValuesUsingSymbolicDist(~fn, ~values=_, ~env))
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(e => Reducer_ErrorValue.REOther(e))
let make = (name, fn) => {
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),
(),
)
}
@ -31,10 +32,8 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeRecord([("p5", FRTypeDistOrNumber), ("p95", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) =>
inputs
->Prepare.ToValueTuple.Record.twoDistOrNumber
->process(~fn, ~env=accessors.environment),
~run=(inputs, env, _) =>
inputs->Prepare.ToValueTuple.Record.twoDistOrNumber(("p5", "p95"))->process(~fn, ~env),
(),
)
}
@ -43,10 +42,8 @@ module DistributionCreation = {
FnDefinition.make(
~name,
~inputs=[FRTypeRecord([("mean", FRTypeDistOrNumber), ("stdev", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) =>
inputs
->Prepare.ToValueTuple.Record.twoDistOrNumber
->process(~fn, ~env=accessors.environment),
~run=(inputs, env, _) =>
inputs->Prepare.ToValueTuple.Record.twoDistOrNumber(("mean", "stdev"))->process(~fn, ~env),
(),
)
}
@ -57,13 +54,14 @@ module DistributionCreation = {
r
->E.R.bind(Process.DistOrNumberToDist.oneValueUsingSymbolicDist(~fn, ~value=_, ~env))
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(e => Reducer_ErrorValue.REOther(e))
let make = (name, fn) =>
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),
(),
)
}

View File

@ -7,23 +7,21 @@ module Declaration = {
("inputs", FRTypeArray(FRTypeRecord([("min", FRTypeNumber), ("max", FRTypeNumber)]))),
])
let fromExpressionValue = (e: frValue): result<internalExpressionValue, string> => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs([e]) {
| Ok([FRValueLambda(lambda), FRValueArray(inputs)]) => {
let fromExpressionValue = (e: Reducer_T.value): result<Reducer_T.value, string> => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs([e], ("fn", "inputs")) {
| Ok([IEvLambda(lambda), IEvArray(inputs)]) => {
open FunctionRegistry_Helpers.Prepare
let getMinMax = arg =>
ToValueArray.Record.toArgs([arg])
ToValueArray.Record.twoArgs([arg], ("min", "max"))
->E.R.bind(ToValueTuple.twoNumbers)
->E.R2.fmap(((min, max)) => Declaration.ContinuousFloatArg.make(min, max))
inputs
->E.A2.fmap(getMinMax)
->E.A.R.firstErrorOrOpen
->E.R2.fmap(args => ReducerInterface_InternalExpressionValue.IEvDeclaration(
Declaration.make(lambda, args),
))
->E.R2.fmap(args => Reducer_T.IEvDeclaration(Declaration.make(lambda, args)))
}
| Error(r) => Error(r)
| Ok(_) => Error(FunctionRegistry_Helpers.impossibleError)
| Ok(_) => Error(impossibleErrorString)
}
}
}
@ -51,8 +49,8 @@ let library = [
FnDefinition.make(
~name="declare",
~inputs=[Declaration.frType],
~run=(_, inputs, _, _) => {
inputs->getOrError(0)->E.R.bind(Declaration.fromExpressionValue)
~run=(inputs, _, _) => {
inputs->getOrError(0)->E.R.bind(Declaration.fromExpressionValue)->E.R2.errMap(wrapError)
},
(),
),

View File

@ -0,0 +1,410 @@
open FunctionRegistry_Core
module Old = {
module Helpers = {
let arithmeticMap = r =>
switch r {
| "add" => #Add
| "dotAdd" => #Add
| "subtract" => #Subtract
| "dotSubtract" => #Subtract
| "divide" => #Divide
| "log" => #Logarithm
| "dotDivide" => #Divide
| "pow" => #Power
| "dotPow" => #Power
| "multiply" => #Multiply
| "dotMultiply" => #Multiply
| _ => #Multiply
}
let catchAndConvertTwoArgsToDists = (args: array<Reducer_T.value>): option<(
DistributionTypes.genericDist,
DistributionTypes.genericDist,
)> =>
switch args {
| [IEvDistribution(a), IEvDistribution(b)] => Some((a, b))
| [IEvNumber(a), IEvDistribution(b)] => Some((GenericDist.fromFloat(a), b))
| [IEvDistribution(a), IEvNumber(b)] => Some((a, GenericDist.fromFloat(b)))
| _ => None
}
let toFloatFn = (
fnCall: DistributionTypes.DistributionOperation.toFloat,
dist: DistributionTypes.genericDist,
~env: GenericDist.env,
) => {
FromDist(#ToFloat(fnCall), dist)->DistributionOperation.run(~env)->Some
}
let toStringFn = (
fnCall: DistributionTypes.DistributionOperation.toString,
dist: DistributionTypes.genericDist,
~env: GenericDist.env,
) => {
FromDist(#ToString(fnCall), dist)->DistributionOperation.run(~env)->Some
}
let toBoolFn = (
fnCall: DistributionTypes.DistributionOperation.toBool,
dist: DistributionTypes.genericDist,
~env: GenericDist.env,
) => {
FromDist(#ToBool(fnCall), dist)->DistributionOperation.run(~env)->Some
}
let toDistFn = (
fnCall: DistributionTypes.DistributionOperation.toDist,
dist,
~env: GenericDist.env,
) => {
FromDist(#ToDist(fnCall), dist)->DistributionOperation.run(~env)->Some
}
let twoDiststoDistFn = (direction, arithmetic, dist1, dist2, ~env: GenericDist.env) => {
FromDist(
#ToDistCombination(direction, arithmeticMap(arithmetic), #Dist(dist2)),
dist1,
)->DistributionOperation.run(~env)
}
let parseNumber = (args: Reducer_T.value): Belt.Result.t<float, string> =>
switch args {
| IEvNumber(x) => Ok(x)
| _ => Error("Not a number")
}
let parseNumberArray = (ags: array<Reducer_T.value>): Belt.Result.t<array<float>, string> =>
E.A.fmap(parseNumber, ags) |> E.A.R.firstErrorOrOpen
let parseDist = (args: Reducer_T.value): Belt.Result.t<DistributionTypes.genericDist, string> =>
switch args {
| IEvDistribution(x) => Ok(x)
| IEvNumber(x) => Ok(GenericDist.fromFloat(x))
| _ => Error("Not a distribution")
}
let parseDistributionArray = (ags: array<Reducer_T.value>): Belt.Result.t<
array<DistributionTypes.genericDist>,
string,
> => E.A.fmap(parseDist, ags) |> E.A.R.firstErrorOrOpen
let mixtureWithGivenWeights = (
distributions: array<DistributionTypes.genericDist>,
weights: array<float>,
~env: GenericDist.env,
): DistributionOperation.outputType =>
E.A.length(distributions) == E.A.length(weights)
? Mixture(Belt.Array.zip(distributions, weights))->DistributionOperation.run(~env)
: GenDistError(
ArgumentError("Error, mixture call has different number of distributions and weights"),
)
let mixtureWithDefaultWeights = (
distributions: array<DistributionTypes.genericDist>,
~env: GenericDist.env,
): DistributionOperation.outputType => {
let length = E.A.length(distributions)
let weights = Belt.Array.make(length, 1.0 /. Belt.Int.toFloat(length))
mixtureWithGivenWeights(distributions, weights, ~env)
}
let mixture = (
args: array<Reducer_T.value>,
~env: GenericDist.env,
): DistributionOperation.outputType => {
let error = (err: string): DistributionOperation.outputType =>
err->DistributionTypes.ArgumentError->GenDistError
switch args {
| [IEvArray(distributions)] =>
switch parseDistributionArray(distributions) {
| Ok(distrs) => mixtureWithDefaultWeights(distrs, ~env)
| Error(err) => error(err)
}
| [IEvArray(distributions), IEvArray(weights)] =>
switch (parseDistributionArray(distributions), parseNumberArray(weights)) {
| (Ok(distrs), Ok(wghts)) => mixtureWithGivenWeights(distrs, wghts, ~env)
| (Error(err), Ok(_)) => error(err)
| (Ok(_), Error(err)) => error(err)
| (Error(err1), Error(err2)) => error(`${err1}|${err2}`)
}
| _ =>
switch E.A.last(args) {
| Some(IEvArray(b)) => {
let weights = parseNumberArray(b)
let distributions = parseDistributionArray(
Belt.Array.slice(args, ~offset=0, ~len=E.A.length(args) - 1),
)
switch E.R.merge(distributions, weights) {
| Ok(d, w) => mixtureWithGivenWeights(d, w, ~env)
| Error(err) => error(err)
}
}
| Some(IEvNumber(_))
| Some(IEvDistribution(_)) =>
switch parseDistributionArray(args) {
| Ok(distributions) => mixtureWithDefaultWeights(distributions, ~env)
| Error(err) => error(err)
}
| _ => error("Last argument of mx must be array or distribution")
}
}
}
}
module SymbolicConstructors = {
let threeFloat = name =>
switch name {
| "triangular" => Ok(SymbolicDist.Triangular.make)
| _ => Error("Unreachable state")
}
let symbolicResultToOutput = (
symbolicResult: result<SymbolicDistTypes.symbolicDist, string>,
): option<DistributionOperation.outputType> =>
switch symbolicResult {
| Ok(r) => Some(Dist(Symbolic(r)))
| Error(r) => Some(GenDistError(OtherError(r)))
}
}
let dispatchToGenericOutput = (call: Reducer_Value.functionCall, env: GenericDist.env): option<
DistributionOperation.outputType,
> => {
let (fnName, args) = call
switch (fnName, args) {
| ("triangular" as fnName, [IEvNumber(f1), IEvNumber(f2), IEvNumber(f3)]) =>
SymbolicConstructors.threeFloat(fnName)
->E.R.bind(r => r(f1, f2, f3))
->SymbolicConstructors.symbolicResultToOutput
| ("sample", [IEvDistribution(dist)]) => Helpers.toFloatFn(#Sample, dist, ~env)
| ("sampleN", [IEvDistribution(dist), IEvNumber(n)]) =>
Some(FloatArray(GenericDist.sampleN(dist, Belt.Int.fromFloat(n))))
| (("mean" | "stdev" | "variance" | "min" | "max" | "mode") as op, [IEvDistribution(dist)]) => {
let fn = switch op {
| "mean" => #Mean
| "stdev" => #Stdev
| "variance" => #Variance
| "min" => #Min
| "max" => #Max
| "mode" => #Mode
| _ => #Mean
}
Helpers.toFloatFn(fn, dist, ~env)
}
| ("integralSum", [IEvDistribution(dist)]) => Helpers.toFloatFn(#IntegralSum, dist, ~env)
| ("toString", [IEvDistribution(dist)]) => Helpers.toStringFn(ToString, dist, ~env)
| ("sparkline", [IEvDistribution(dist)]) =>
Helpers.toStringFn(ToSparkline(MagicNumbers.Environment.sparklineLength), dist, ~env)
| ("sparkline", [IEvDistribution(dist), IEvNumber(n)]) =>
Helpers.toStringFn(ToSparkline(Belt.Float.toInt(n)), dist, ~env)
| ("exp", [IEvDistribution(a)]) =>
// https://mathjs.org/docs/reference/functions/exp.html
Helpers.twoDiststoDistFn(
Algebraic(AsDefault),
"pow",
GenericDist.fromFloat(MagicNumbers.Math.e),
a,
~env,
)->Some
| ("normalize", [IEvDistribution(dist)]) => Helpers.toDistFn(Normalize, dist, ~env)
| ("isNormalized", [IEvDistribution(dist)]) => Helpers.toBoolFn(IsNormalized, dist, ~env)
| ("toPointSet", [IEvDistribution(dist)]) => Helpers.toDistFn(ToPointSet, dist, ~env)
| ("scaleLog", [IEvDistribution(dist)]) =>
Helpers.toDistFn(Scale(#Logarithm, MagicNumbers.Math.e), dist, ~env)
| ("scaleLog10", [IEvDistribution(dist)]) =>
Helpers.toDistFn(Scale(#Logarithm, 10.0), dist, ~env)
| ("scaleLog", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toDistFn(Scale(#Logarithm, float), dist, ~env)
| ("scaleLogWithThreshold", [IEvDistribution(dist), IEvNumber(base), IEvNumber(eps)]) =>
Helpers.toDistFn(Scale(#LogarithmWithThreshold(eps), base), dist, ~env)
| ("scaleMultiply", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toDistFn(Scale(#Multiply, float), dist, ~env)
| ("scalePow", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toDistFn(Scale(#Power, float), dist, ~env)
| ("scaleExp", [IEvDistribution(dist)]) =>
Helpers.toDistFn(Scale(#Power, MagicNumbers.Math.e), dist, ~env)
| ("cdf", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toFloatFn(#Cdf(float), dist, ~env)
| ("pdf", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toFloatFn(#Pdf(float), dist, ~env)
| ("inv", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toFloatFn(#Inv(float), dist, ~env)
| ("quantile", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toFloatFn(#Inv(float), dist, ~env)
| ("inspect", [IEvDistribution(dist)]) => Helpers.toDistFn(Inspect, dist, ~env)
| ("truncateLeft", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toDistFn(Truncate(Some(float), None), dist, ~env)
| ("truncateRight", [IEvDistribution(dist), IEvNumber(float)]) =>
Helpers.toDistFn(Truncate(None, Some(float)), dist, ~env)
| ("truncate", [IEvDistribution(dist), IEvNumber(float1), IEvNumber(float2)]) =>
Helpers.toDistFn(Truncate(Some(float1), Some(float2)), dist, ~env)
| ("mx" | "mixture", args) => Helpers.mixture(args, ~env)->Some
| ("log", [IEvDistribution(a)]) =>
Helpers.twoDiststoDistFn(
Algebraic(AsDefault),
"log",
a,
GenericDist.fromFloat(MagicNumbers.Math.e),
~env,
)->Some
| ("log10", [IEvDistribution(a)]) =>
Helpers.twoDiststoDistFn(
Algebraic(AsDefault),
"log",
a,
GenericDist.fromFloat(10.0),
~env,
)->Some
| ("unaryMinus", [IEvDistribution(a)]) =>
Helpers.twoDiststoDistFn(
Algebraic(AsDefault),
"multiply",
a,
GenericDist.fromFloat(-1.0),
~env,
)->Some
| (
("add" | "multiply" | "subtract" | "divide" | "pow" | "log") as arithmetic,
[_, _] as args,
) =>
Helpers.catchAndConvertTwoArgsToDists(args)->E.O2.fmap(((fst, snd)) =>
Helpers.twoDiststoDistFn(Algebraic(AsDefault), arithmetic, fst, snd, ~env)
)
| (
("dotAdd"
| "dotMultiply"
| "dotSubtract"
| "dotDivide"
| "dotPow") as arithmetic,
[_, _] as args,
) =>
Helpers.catchAndConvertTwoArgsToDists(args)->E.O2.fmap(((fst, snd)) =>
Helpers.twoDiststoDistFn(Pointwise, arithmetic, fst, snd, ~env)
)
| ("dotExp", [IEvDistribution(a)]) =>
Helpers.twoDiststoDistFn(
Pointwise,
"dotPow",
GenericDist.fromFloat(MagicNumbers.Math.e),
a,
~env,
)->Some
| _ => None
}
}
let genericOutputToReducerValue = (o: DistributionOperation.outputType): result<
Reducer_T.value,
Reducer_ErrorValue.errorValue,
> =>
switch o {
| 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 => Reducer_T.IEvNumber(r))))
| GenDistError(err) => Error(REDistributionError(err))
}
let dispatch = (call: Reducer_Value.functionCall, environment) =>
switch dispatchToGenericOutput(call, environment) {
| Some(o) => genericOutputToReducerValue(o)
| None =>
Reducer_ErrorValue.REOther("Internal error in FR_GenericDist implementation")
->Reducer_ErrorValue.ErrorException
->raise
}
}
let makeProxyFn = (name: string, inputs: array<frType>) => {
Function.make(
~name,
~nameSpace="",
~requiresNamespace=false,
~definitions=[
FnDefinition.make(
~name,
~inputs,
~run=(inputs, env, _) => Old.dispatch((name, inputs), env),
(),
),
],
(),
)
}
let makeOperationFns = (): array<function> => {
let ops = [
"add",
"multiply",
"subtract",
"divide",
"pow",
"log",
"dotAdd",
"dotMultiply",
"dotSubtract",
"dotDivide",
"dotPow",
]
let twoArgTypes = [
// can't use numeric+numeric, since number+number should be delegated to builtin arithmetics
[FRTypeDist, FRTypeNumber],
[FRTypeNumber, FRTypeDist],
[FRTypeDist, FRTypeDist],
]
ops->E.A2.fmap(op => twoArgTypes->E.A2.fmap(types => makeProxyFn(op, types)))->E.A.concatMany
}
// TODO - duplicates the switch above, should rewrite with standard FR APIs
let library = E.A.concatMany([
[
makeProxyFn("triangular", [FRTypeNumber, FRTypeNumber, FRTypeNumber]),
makeProxyFn("sample", [FRTypeDist]),
makeProxyFn("sampleN", [FRTypeDist, FRTypeNumber]),
makeProxyFn("mean", [FRTypeDist]),
makeProxyFn("stdev", [FRTypeDist]),
makeProxyFn("variance", [FRTypeDist]),
makeProxyFn("min", [FRTypeDist]),
makeProxyFn("max", [FRTypeDist]),
makeProxyFn("mode", [FRTypeDist]),
makeProxyFn("integralSum", [FRTypeDist]),
makeProxyFn("toString", [FRTypeDist]),
makeProxyFn("sparkline", [FRTypeDist]),
makeProxyFn("sparkline", [FRTypeDist, FRTypeNumber]),
makeProxyFn("exp", [FRTypeDist]),
makeProxyFn("normalize", [FRTypeDist]),
makeProxyFn("isNormalized", [FRTypeDist]),
makeProxyFn("toPointSet", [FRTypeDist]),
makeProxyFn("scaleLog", [FRTypeDist]),
makeProxyFn("scaleLog10", [FRTypeDist]),
makeProxyFn("scaleLog", [FRTypeDist, FRTypeNumber]),
makeProxyFn("scaleLogWithThreshold", [FRTypeDist, FRTypeNumber, FRTypeNumber]),
makeProxyFn("scaleMultiply", [FRTypeDist, FRTypeNumber]),
makeProxyFn("scalePow", [FRTypeDist, FRTypeNumber]),
makeProxyFn("scaleExp", [FRTypeDist]),
makeProxyFn("cdf", [FRTypeDist, FRTypeNumber]),
makeProxyFn("pdf", [FRTypeDist, FRTypeNumber]),
makeProxyFn("inv", [FRTypeDist, FRTypeNumber]),
makeProxyFn("quantile", [FRTypeDist, FRTypeNumber]),
makeProxyFn("inspect", [FRTypeDist]),
makeProxyFn("truncateLeft", [FRTypeDist, FRTypeNumber]),
makeProxyFn("truncateRight", [FRTypeDist, FRTypeNumber]),
makeProxyFn("truncate", [FRTypeDist, FRTypeNumber, FRTypeNumber]),
makeProxyFn("log", [FRTypeDist]),
makeProxyFn("log10", [FRTypeDist]),
makeProxyFn("unaryMinus", [FRTypeDist]),
makeProxyFn("dotExp", [FRTypeDist]),
],
makeOperationFns(),
])
// FIXME - impossible to implement with FR due to arbitrary parameters length;
let mxLambda = Reducer_Expression_Lambda.makeFFILambda((inputs, env, _) => {
switch Old.dispatch(("mx", inputs), env) {
| Ok(value) => value
| Error(e) => e->Reducer_ErrorValue.ErrorException->raise
}
})

View File

@ -1,6 +1,3 @@
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
open FunctionRegistry_Core
open FunctionRegistry_Helpers
@ -8,38 +5,32 @@ let nameSpace = "List"
let requiresNamespace = true
module Internals = {
let makeFromNumber = (
n: float,
value: internalExpressionValue,
): internalExpressionValue => IEvArray(Belt.Array.make(E.Float.toInt(n), value))
let makeFromNumber = (n: float, value: Reducer_T.value): Reducer_T.value => IEvArray(
Belt.Array.make(E.Float.toInt(n), value),
)
let upTo = (low: float, high: float): internalExpressionValue => IEvArray(
let upTo = (low: float, high: float): Reducer_T.value => IEvArray(
E.A.Floats.range(low, high, (high -. low +. 1.0)->E.Float.toInt)->E.A2.fmap(Wrappers.evNumber),
)
let first = (v: array<internalExpressionValue>): result<internalExpressionValue, string> =>
let first = (v: array<Reducer_T.value>): result<Reducer_T.value, string> =>
v->E.A.first |> E.O.toResult("No first element")
let last = (v: array<internalExpressionValue>): result<internalExpressionValue, string> =>
let last = (v: array<Reducer_T.value>): result<Reducer_T.value, string> =>
v->E.A.last |> E.O.toResult("No last element")
let reverse = (array: array<internalExpressionValue>): internalExpressionValue => IEvArray(
let reverse = (array: array<Reducer_T.value>): Reducer_T.value => IEvArray(
Belt.Array.reverse(array),
)
let map = (
array: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
array: array<Reducer_T.value>,
eLambdaValue,
reducer: ProjectReducerFnT.t,
): ReducerInterface_InternalExpressionValue.t => {
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
): Reducer_T.value => {
Belt.Array.map(array, elem =>
Reducer_Expression_Lambda.doLambdaCall(
eLambdaValue,
list{elem},
(accessors: ProjectAccessorsT.t),
(reducer: ProjectReducerFnT.t),
)
Reducer_Expression_Lambda.doLambdaCall(eLambdaValue, [elem], env, reducer)
)->Wrappers.evArray
}
@ -47,11 +38,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)
)
}
@ -59,27 +50,22 @@ 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,
) => {
Js.Array2.filter(aValueArray, elem => {
let result = Reducer_Expression_Lambda.doLambdaCall(
aLambdaValue,
list{elem},
accessors,
reducer,
)
let result = Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, [elem], env, reducer)
switch result {
| IEvBool(true) => true
| _ => false
@ -100,7 +86,7 @@ let library = [
FnDefinition.make(
~name="make",
~inputs=[FRTypeNumber, FRTypeAny],
~run=(inputs, _, _, _) => {
~run=(inputs, _, _) => {
switch inputs {
| [IEvNumber(number), value] => Internals.makeFromNumber(number, value)->Ok
| _ => Error(impossibleError)
@ -121,10 +107,11 @@ let library = [
FnDefinition.make(
~name="upTo",
~inputs=[FRTypeNumber, FRTypeNumber],
~run=(_, inputs, _, _) =>
inputs
->Prepare.ToValueTuple.twoNumbers
->E.R2.fmap(((low, high)) => Internals.upTo(low, high)),
~run=(inputs, _, _) =>
switch inputs {
| [IEvNumber(low), IEvNumber(high)] => Internals.upTo(low, high)->Ok
| _ => impossibleError->Error
},
(),
),
],
@ -139,9 +126,9 @@ let library = [
FnDefinition.make(
~name="first",
~inputs=[FRTypeArray(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvArray(array)] => Internals.first(array)
| [IEvArray(array)] => Internals.first(array)->E.R2.errMap(wrapError)
| _ => Error(impossibleError)
},
(),
@ -158,9 +145,9 @@ let library = [
FnDefinition.make(
~name="last",
~inputs=[FRTypeArray(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvArray(array)] => Internals.last(array)
| [IEvArray(array)] => Internals.last(array)->E.R2.errMap(wrapError)
| _ => Error(impossibleError)
},
(),
@ -178,7 +165,7 @@ let library = [
FnDefinition.make(
~name="reverse",
~inputs=[FRTypeArray(FRTypeAny)],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvArray(array)] => Internals.reverse(array)->Ok
| _ => Error(impossibleError)
@ -198,10 +185,9 @@ 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))
| [IEvArray(array), IEvLambda(lambda)] => Ok(Internals.map(array, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),
@ -218,10 +204,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)
},
(),
@ -238,10 +224,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)
},
(),
@ -258,10 +244,10 @@ let library = [
FnDefinition.make(
~name="filter",
~inputs=[FRTypeArray(FRTypeAny), FRTypeLambda],
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
~run=(inputs, env, reducer) =>
switch inputs {
| [IEvArray(array), IEvLambda(lambda)] =>
Ok(Internals.filter(array, lambda, accessors, reducer))
Ok(Internals.filter(array, lambda, env, reducer))
| _ => Error(impossibleError)
},
(),

View File

@ -0,0 +1,21 @@
open FunctionRegistry_Helpers
let library = [
// ported MathJS functions
// https://docs.google.com/spreadsheets/d/1bUK2RaBFg8aJHuzZcw9yXp8StCBH5If5sU2iRw1T_HY/edit
// TODO - implement the rest of useful stuff
Make.f2f(
~name="sqrt",
~nameSpace="Math",
~requiresNamespace=true,
~fn=x => Js.Math.pow_float(~base=x, ~exp=0.5),
(),
),
Make.f2f(~name="sin", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.sin, ()),
Make.f2f(~name="cos", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.cos, ()),
Make.f2f(~name="tan", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.tan, ()),
Make.f2f(~name="asin", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.asin, ()),
Make.f2f(~name="acos", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.acos, ()),
Make.f2f(~name="atan", ~nameSpace="Math", ~requiresNamespace=true, ~fn=Js.Math.atan, ()),
]

View File

@ -9,34 +9,24 @@ module ArrayNumberDist = {
FnDefinition.make(
~name,
~inputs=[FRTypeArray(FRTypeNumber)],
~run=(_, inputs, _, _) =>
Prepare.ToTypedArray.numbers(inputs)
~run=(inputs, _, _) =>
inputs
->Prepare.ToTypedArray.numbers
->E.R.bind(r => E.A.length(r) === 0 ? Error("List is empty") : Ok(r))
->E.R.bind(fn),
(),
)
}
let make2 = (name, fn) => {
FnDefinition.make(
~name,
~inputs=[FRTypeArray(FRTypeAny)],
~run=(_, inputs, _, _) =>
Prepare.ToTypedArray.numbers(inputs)
->E.R.bind(r => E.A.length(r) === 0 ? Error("List is empty") : Ok(r))
->E.R.bind(fn),
->E.R.bind(fn)
->E.R2.errMap(wrapError),
(),
)
}
}
let library = [
Function.make(
Make.f2f(
~name="floor",
~nameSpace,
~requiresNamespace,
~output=EvtNumber,
~examples=[`floor(3.5)`],
~definitions=[DefineFn.Numbers.oneToOne("floor", Js.Math.floor_float)],
~fn=Js.Math.floor_float,
(),
),
Function.make(

View File

@ -4,45 +4,47 @@ open FunctionRegistry_Helpers
let nameSpace = "PointSet"
let requiresNamespace = true
let inputsTodist = (inputs: array<FunctionRegistry_Core.frValue>, makeDist) => {
let array = inputs->getOrError(0)->E.R.bind(Prepare.ToValueArray.Array.openA)
let xyCoords =
array->E.R.bind(xyCoords =>
xyCoords
->E.A2.fmap(xyCoord =>
[xyCoord]->Prepare.ToValueArray.Record.twoArgs->E.R.bind(Prepare.ToValueTuple.twoNumbers)
)
->E.A.R.firstErrorOrOpen
)
let expressionValue =
xyCoords
->E.R.bind(r => r->XYShape.T.makeFromZipped->E.R2.errMap(XYShape.Error.toString))
->E.R2.fmap(r => ReducerInterface_InternalExpressionValue.IEvDistribution(
PointSet(makeDist(r)),
))
expressionValue
let inputsToDist = (inputs: array<Reducer_T.value>, xyShapeToPointSetDist) => {
// TODO - rewrite in more functional/functor-based style
switch inputs {
| [IEvArray(items)] => {
items->Belt.Array.map(
item =>
switch item {
| IEvRecord(map) => {
let xValue = map->Belt.Map.String.get("x")
let yValue = map->Belt.Map.String.get("y")
switch (xValue, yValue) {
| (Some(IEvNumber(x)), Some(IEvNumber(y))) => (x, y)
| _ => impossibleError->Reducer_ErrorValue.toException
}
}
| _ => impossibleError->Reducer_ErrorValue.toException
}
)->Ok->E.R.bind(r => r->XYShape.T.makeFromZipped->E.R2.errMap(XYShape.Error.toString))
->E.R2.fmap(r => Reducer_T.IEvDistribution(PointSet(r->xyShapeToPointSetDist)))
}
| _ => impossibleError->Reducer_ErrorValue.toException
}
}
module Internal = {
type t = PointSetDist.t
let toType = (r): result<
ReducerInterface_InternalExpressionValue.t,
Reducer_ErrorValue.errorValue,
> =>
let toType = (r): result<Reducer_T.value, Reducer_ErrorValue.errorValue> =>
switch r {
| Ok(r) => Ok(Wrappers.evDistribution(PointSet(r)))
| 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
}
}
@ -53,23 +55,23 @@ let library = [
~nameSpace,
~requiresNamespace=true,
~examples=[`PointSet.fromDist(normal(5,2))`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="fromDist",
~inputs=[FRTypeDist],
~run=(_, inputs, accessors, _) =>
~run=(inputs, env, _) =>
switch inputs {
| [FRValueDist(dist)] =>
| [IEvDistribution(dist)] =>
GenericDist.toPointSet(
dist,
~xyPointLength=accessors.environment.xyPointLength,
~sampleCount=accessors.environment.sampleCount,
~xyPointLength=env.xyPointLength,
~sampleCount=env.sampleCount,
(),
)
->E.R2.fmap(Wrappers.pointSet)
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(_ => "")
->E.R2.errMap(e => Reducer_ErrorValue.REDistributionError(e))
| _ => Error(impossibleError)
},
(),
@ -82,15 +84,15 @@ let library = [
~nameSpace,
~requiresNamespace=true,
~examples=[`PointSet.mapY(mx(normal(5,2)), {|x| x + 1})`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="mapY",
~inputs=[FRTypeDist, FRTypeLambda],
~run=(inputs, _, env, reducer) =>
~run=(inputs, env, reducer) =>
switch inputs {
| [IEvDistribution(PointSet(dist)), IEvLambda(lambda)] =>
Internal.mapY(dist, lambda, env, reducer)->E.R2.errMap(Reducer_ErrorValue.errorToString)
Internal.mapY(dist, lambda, env, reducer)
| _ => Error(impossibleError)
},
(),
@ -110,12 +112,13 @@ let library = [
{x: 3, y: 0.2}
])`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="makeContinuous",
~inputs=[FRTypeArray(FRTypeRecord([("x", FRTypeNumeric), ("y", FRTypeNumeric)]))],
~run=(_, inputs, _, _) => inputsTodist(inputs, r => Continuous(Continuous.make(r))),
~run=(inputs, _, _) =>
inputsToDist(inputs, r => Continuous(Continuous.make(r)))->E.R2.errMap(wrapError),
(),
),
],
@ -133,12 +136,13 @@ let library = [
{x: 3, y: 0.2}
])`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="makeDiscrete",
~inputs=[FRTypeArray(FRTypeRecord([("x", FRTypeNumeric), ("y", FRTypeNumeric)]))],
~run=(_, inputs, _, _) => inputsTodist(inputs, r => Discrete(Discrete.make(r))),
~run=(inputs, _, _) =>
inputsToDist(inputs, r => Discrete(Discrete.make(r)))->E.R2.errMap(wrapError),
(),
),
],

View File

@ -1,5 +1,3 @@
// module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
// module ProjectReducerFnT = ReducerProject_ReducerFn_T
open FunctionRegistry_Core
open FunctionRegistry_Helpers
@ -12,51 +10,46 @@ 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_ErrorValue.errorValue,
> =>
let toType = (r): result<Reducer_T.value, Reducer_ErrorValue.errorValue> =>
switch r {
| Ok(r) => Ok(Wrappers.evDistribution(SampleSet(r)))
| Error(r) => Error(REDistributionError(SampleSetError(r)))
}
//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
}
let parseSampleSetArray = (arr: array<internalExpressionValue>): option<
array<SampleSetDist.t>,
> => {
let parseSampleSet = (value: internalExpressionValue): option<SampleSetDist.t> =>
let parseSampleSetArray = (arr: array<Reducer_T.value>): option<array<SampleSetDist.t>> => {
let parseSampleSet = (value: Reducer_T.value): option<SampleSetDist.t> =>
switch value {
| IEvDistribution(SampleSet(dist)) => Some(dist)
| _ => None
@ -65,9 +58,9 @@ module Internal = {
}
let mapN = (
aValueArray: array<internalExpressionValue>,
aValueArray: array<Reducer_T.value>,
aLambdaValue,
accessors: ProjectAccessorsT.t,
environment: Reducer_T.environment,
reducer,
) => {
switch parseSampleSetArray(aValueArray) {
@ -75,8 +68,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
@ -91,18 +84,18 @@ let libaryBase = [
~nameSpace,
~requiresNamespace=true,
~examples=[`SampleSet.fromDist(normal(5,2))`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="fromDist",
~inputs=[FRTypeDist],
~run=(_, inputs, accessors: ProjectAccessorsT.t, _) =>
~run=(inputs, environment, _) =>
switch inputs {
| [FRValueDist(dist)] =>
GenericDist.toSampleSetDist(dist, accessors.environment.sampleCount)
| [IEvDistribution(dist)] =>
GenericDist.toSampleSetDist(dist, environment.sampleCount)
->E.R2.fmap(Wrappers.sampleSet)
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(DistributionTypes.Error.toString)
->E.R2.errMap(e => Reducer_ErrorValue.REDistributionError(e))
| _ => Error(impossibleError)
},
(),
@ -115,17 +108,20 @@ let libaryBase = [
~nameSpace,
~requiresNamespace=true,
~examples=[`SampleSet.fromList([3,5,2,3,5,2,3,5,2,3,3,5,3,2,3,1,1,3])`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
FnDefinition.make(
~name="fromList",
~inputs=[FRTypeArray(FRTypeNumber)],
~run=(_, inputs, _, _) => {
~run=(inputs, _, _) => {
let sampleSet =
Prepare.ToTypedArray.numbers(inputs) |> E.R2.bind(r =>
inputs->Prepare.ToTypedArray.numbers |> E.R2.bind(r =>
SampleSetDist.make(r)->E.R2.errMap(_ => "AM I HERE? WHYERE AMI??")
)
sampleSet->E.R2.fmap(Wrappers.sampleSet)->E.R2.fmap(Wrappers.evDistribution)
sampleSet
->E.R2.fmap(Wrappers.sampleSet)
->E.R2.fmap(Wrappers.evDistribution)
->E.R2.errMap(wrapError)
},
(),
),
@ -137,12 +133,12 @@ let libaryBase = [
~nameSpace,
~requiresNamespace=true,
~examples=[`SampleSet.toList(SampleSet.fromDist(normal(5,2)))`],
~output=ReducerInterface_InternalExpressionValue.EvtArray,
~output=Reducer_Value.EvtArray,
~definitions=[
FnDefinition.make(
~name="toList",
~inputs=[FRTypeDist],
~run=(inputs, _, _, _) =>
~run=(inputs, _, _) =>
switch inputs {
| [IEvDistribution(SampleSet(dist))] =>
dist->E.A2.fmap(Wrappers.evNumber)->Wrappers.evArray->Ok
@ -158,17 +154,17 @@ let libaryBase = [
~nameSpace,
~requiresNamespace=true,
~examples=[`SampleSet.fromFn({|| sample(normal(5,2))})`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
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))
| Error(e) => e->Reducer_ErrorValue.REOperationError->Error
}
| _ => Error(impossibleError)
},
@ -182,15 +178,15 @@ let libaryBase = [
~nameSpace,
~requiresNamespace,
~examples=[`SampleSet.map(SampleSet.fromDist(normal(5,2)), {|x| x + 1})`],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
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)
| _ => Error(impossibleError)
},
(),
@ -205,19 +201,19 @@ let libaryBase = [
~examples=[
`SampleSet.map2(SampleSet.fromDist(normal(5,2)), SampleSet.fromDist(normal(5,2)), {|x, y| x + y})`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
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)
| _ => Error(impossibleError)
}
},
@ -233,12 +229,12 @@ let libaryBase = [
~examples=[
`SampleSet.map3(SampleSet.fromDist(normal(5,2)), SampleSet.fromDist(normal(5,2)), SampleSet.fromDist(normal(5,2)), {|x, y, z| max([x,y,z])})`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
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 +242,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)
| _ => Error(impossibleError)
},
(),
@ -261,17 +257,15 @@ let libaryBase = [
~examples=[
`SampleSet.mapN([SampleSet.fromDist(normal(5,2)), SampleSet.fromDist(normal(5,2)), SampleSet.fromDist(normal(5,2))], {|x| max(x)})`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
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 => {
"AHHH doesn't work"
})
Internal.mapN(dists, lambda, environment, reducer)
| _ => Error(impossibleError)
},
(),
@ -286,7 +280,7 @@ module Comparison = {
FnDefinition.make(
~name,
~inputs,
~run=(inputs, _, _, _) => {
~run=(inputs, _, _) => {
run(inputs)
},
(),
@ -296,7 +290,9 @@ module Comparison = {
let wrapper = r =>
r
->E.R2.fmap(r => r->Wrappers.sampleSet->Wrappers.evDistribution)
->E.R2.errMap(SampleSetDist.Error.toString)
->E.R2.errMap(e =>
e->DistributionTypes.Error.sampleErrorToDistErr->Reducer_ErrorValue.REDistributionError
)
let mkBig = (name, withDist, withFloat) =>
Function.make(
@ -308,7 +304,7 @@ module Comparison = {
`SampleSet.${name}(SampleSet.fromDist(normal(5,2)), 3.0)`,
`SampleSet.${name}(4.0, SampleSet.fromDist(normal(6,2)))`,
],
~output=ReducerInterface_InternalExpressionValue.EvtDistribution,
~output=Reducer_Value.EvtDistribution,
~definitions=[
template(name, [FRTypeDist, FRTypeDist], inputs => {
switch inputs {

View File

@ -6,7 +6,7 @@ let requiresNamespace = true
let runScoring = (estimate, answer, prior, env) => {
GenericDist.Score.logScore(~estimate, ~answer, ~prior, ~env)
->E.R2.fmap(FunctionRegistry_Helpers.Wrappers.evNumber)
->E.R2.errMap(DistributionTypes.Error.toString)
->E.R2.errMap(e => Reducer_ErrorValue.REDistributionError(e))
}
let library = [
@ -30,17 +30,17 @@ let library = [
("prior", FRTypeDist),
]),
],
~run=(_, inputs, accessors, _) => {
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)
~run=(inputs, environment, _) => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.threeArgs(inputs, ("estimate", "answer", "prior")) {
| Ok([IEvDistribution(estimate), IEvDistribution(d), IEvDistribution(prior)]) =>
runScoring(estimate, Score_Dist(d), Some(prior), environment)
| Ok([
FRValueDist(estimate),
FRValueDistOrNumber(FRValueNumber(d)),
FRValueDist(prior),
IEvDistribution(estimate),
IEvNumber(d),
IEvDistribution(prior),
]) =>
runScoring(estimate, Score_Scalar(d), Some(prior), accessors.environment)
| Error(e) => Error(e)
runScoring(estimate, Score_Scalar(d), Some(prior), environment)
| Error(e) => Error(e->FunctionRegistry_Helpers.wrapError)
| _ => Error(FunctionRegistry_Helpers.impossibleError)
}
},
@ -49,13 +49,13 @@ let library = [
FnDefinition.make(
~name="logScore",
~inputs=[FRTypeRecord([("estimate", FRTypeDist), ("answer", FRTypeDistOrNumber)])],
~run=(_, inputs, accessors, _) => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs(inputs) {
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueDist(d))]) =>
runScoring(estimate, Score_Dist(d), None, accessors.environment)
| Ok([FRValueDist(estimate), FRValueDistOrNumber(FRValueNumber(d))]) =>
runScoring(estimate, Score_Scalar(d), None, accessors.environment)
| Error(e) => Error(e)
~run=(inputs, environment, _) => {
switch FunctionRegistry_Helpers.Prepare.ToValueArray.Record.twoArgs(inputs, ("estimate", "answer")) {
| Ok([IEvDistribution(estimate), IEvDistribution(d)]) =>
runScoring(estimate, Score_Dist(d), None, environment)
| Ok([IEvDistribution(estimate), IEvNumber(d)]) =>
runScoring(estimate, Score_Scalar(d), None, environment)
| Error(e) => Error(e->FunctionRegistry_Helpers.wrapError)
| _ => 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)
| [IEvDistribution(estimate), IEvDistribution(d)] =>
runScoring(estimate, Score_Dist(d), None, environment)
| _ => Error(FunctionRegistry_Helpers.impossibleError)
}
},

View File

@ -0,0 +1,34 @@
open FunctionRegistry_Core
let makeUnitFn = (name: string, multiplier: float) => {
Function.make(
~name="fromUnit_" ++ name,
~nameSpace="",
~requiresNamespace=false,
~definitions=[
FnDefinition.make(
~name="fromUnit_" ++ name,
~inputs=[FRTypeNumber],
~run=(inputs, _, _) => {
switch inputs {
| [IEvNumber(f)] => IEvNumber(f *. multiplier)->Ok
| _ => FunctionRegistry_Helpers.impossibleError->Error
}
},
(),
),
],
(),
)
}
let library = [
makeUnitFn("n", 1E-9),
makeUnitFn("m", 1E-3),
makeUnitFn("k", 1E3),
makeUnitFn("M", 1E6),
makeUnitFn("B", 1E9),
makeUnitFn("G", 1E9),
makeUnitFn("T", 1E12),
makeUnitFn("P", 1E15),
]

View File

@ -8,7 +8,7 @@
type environment = ForTS_Distribution_Environment.environment //use
@genType
let defaultEnvironment: environment = DistributionOperation.defaultEnv
let defaultEnvironment: environment = Reducer_Context.defaultEnvironment
@module("./ForTS_Distribution_tag") @scope("distributionTag")
external dtPointSet_: string = "PointSet"

View File

@ -1,14 +1,14 @@
@genType type reducerProject = ReducerProject_T.t //re-export
@genType type reducerProject = ReducerProject_T.project //re-export
type reducerErrorValue = ForTS_Reducer_ErrorValue.reducerErrorValue //use
type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
type squiggleValue_Module = ForTS_SquiggleValue_Module.squiggleValue_Module //use
type squiggleValue_Record = ForTS_SquiggleValue.squiggleValue_Record //use
type environment = ForTS_Distribution_Environment.environment //use
module T = ReducerProject_T
module Private = ReducerProject.Private
module Private = ReducerProject
/*
PUBLIC FUNCTIONS
@ -35,35 +35,34 @@ 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
let getSourceIds = (project: reducerProject): array<string> => 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.
@ -71,15 +70,13 @@ Cleans the compilation artifacts for a given source ID. The results stay untouch
Normally, you would never need the compilation artifacts again as the results with the same sources would never change. However, they are needed in case of any debugging reruns
*/
@genType
let clean = (project: reducerProject, sourceId: string): unit =>
project->T.Private.castToInternalProject->Private.clean(sourceId)
let clean = (project: reducerProject, sourceId: string): unit => 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
let cleanAll = (project: reducerProject): unit => project->Private.cleanAll
/*
Cleans results. Compilation stays untouched to be able to re-run the source.
@ -87,14 +84,13 @@ 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
let cleanAllResults = (project: reducerProject): unit => project->Private.cleanAllResults
/*
To set the includes one first has to call "parseIncludes". The parsed includes or the parser error is returned.
@ -103,19 +99,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 +120,34 @@ 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
let getRunOrder = (project: reducerProject): array<string> => 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 +157,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 +166,26 @@ 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)
let run = (project: reducerProject, sourceId: string): unit => 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
let runAll = (project: reducerProject): unit => 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)
let getBindings = (project: reducerProject, sourceId: string): squiggleValue_Record =>
project->Private.getBindings(sourceId)->Reducer_Namespace.toMap
/*
Get the result after running this source file or the project
@ -201,7 +194,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.
@ -211,12 +204,15 @@ The source has to be include free
@genType
let evaluate = (sourceCode: string): (
result<squiggleValue, reducerErrorValue>,
squiggleValue_Module,
squiggleValue_Record,
) => Private.evaluate(sourceCode)
@genType
let setEnvironment = (project: reducerProject, environment: environment): unit =>
project->T.Private.castToInternalProject->Private.setEnvironment(environment)
project->Private.setEnvironment(environment)
@genType
let getEnvironment = (project: reducerProject): environment => project->Private.getEnvironment
/*
Foreign function interface is intentionally demolished.

View File

@ -1,10 +1,8 @@
@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_Record = 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
@ -14,15 +12,9 @@ type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //us
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtArray_: string = "Array"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
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 svtDate_: string = "Date"
@ -35,9 +27,6 @@ external svtDistribution_: string = "Distribution"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtLambda_: string = "Lambda"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtModule_: string = "Module"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtNumber_: string = "Number"
@ -47,18 +36,9 @@ 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 svtTimeDuration_: string = "TimeDuration"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtType_: string = "Type"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtTypeIdentifier_: string = "TypeIdentifier"
@module("./ForTS_SquiggleValue_tag") @scope("squiggleValueTag")
external svtVoid_: string = "Void"
@ -71,33 +51,26 @@ external castEnum: string => squiggleValueTag = "%identity"
let getTag = (variant: squiggleValue): squiggleValueTag =>
switch variant {
| IEvArray(_) => svtArray_->castEnum
| IEvArrayString(_) => svtArrayString_->castEnum
| IEvBool(_) => svtBool_->castEnum
| IEvCall(_) => svtCall_->castEnum //Impossible
| IEvDate(_) => svtDate_->castEnum
| IEvDeclaration(_) => svtDeclaration_->castEnum
| IEvDistribution(_) => svtDistribution_->castEnum
| IEvLambda(_) => svtLambda_->castEnum
| IEvBindings(_) => svtModule_->castEnum //Impossible
| IEvNumber(_) => svtNumber_->castEnum
| IEvRecord(_) => svtRecord_->castEnum
| IEvString(_) => svtString_->castEnum
| IEvSymbol(_) => svtSymbol_->castEnum
| IEvTimeDuration(_) => svtTimeDuration_->castEnum
| IEvType(_) => svtType_->castEnum
| IEvTypeIdentifier(_) => svtTypeIdentifier_->castEnum
| IEvVoid => svtVoid_->castEnum
}
@genType
let toString = (variant: squiggleValue) =>
ReducerInterface_InternalExpressionValue.toString(variant)
let toString = (variant: squiggleValue) => Reducer_Value.toString(variant)
// This is a useful method for unit tests.
// Convert the result along with the error message to a string.
@genType
let toStringResult = (variantResult: result<squiggleValue, reducerErrorValue>) =>
ReducerInterface_InternalExpressionValue.toStringResult(variantResult)
Reducer_Value.toStringResult(variantResult)
@genType
let getArray = (variant: squiggleValue): option<squiggleValue_Array> =>
@ -107,13 +80,6 @@ let getArray = (variant: squiggleValue): option<squiggleValue_Array> =>
| _ => None
}
@genType
let getArrayString = (variant: squiggleValue): option<array<string>> =>
switch variant {
| IEvArrayString(value) => value->Some
| _ => None
}
@genType
let getBool = (variant: squiggleValue): option<bool> =>
switch variant {
@ -121,13 +87,6 @@ let getBool = (variant: squiggleValue): option<bool> =>
| _ => None
}
@genType
let getCall = (variant: squiggleValue): option<string> =>
switch variant {
| IEvCall(value) => value->Some
| _ => None
}
@genType
let getDate = (variant: squiggleValue): option<Js.Date.t> =>
switch variant {
@ -156,13 +115,6 @@ let getLambda = (variant: squiggleValue): option<squiggleValue_Lambda> =>
| _ => None
}
@genType
let getModule = (variant: squiggleValue): option<squiggleValue_Module> =>
switch variant {
| IEvBindings(value) => value->Some
| _ => None
}
@genType
let getNumber = (variant: squiggleValue): option<float> =>
switch variant {
@ -184,30 +136,9 @@ let getString = (variant: squiggleValue): option<string> =>
| _ => None
}
@genType
let getSymbol = (variant: squiggleValue): option<string> =>
switch variant {
| IEvSymbol(value) => value->Some
| _ => None
}
@genType
let getTimeDuration = (variant: squiggleValue): option<float> =>
switch variant {
| IEvTimeDuration(value) => value->Some
| _ => None
}
@genType
let getType = (variant: squiggleValue): option<squiggleValue_Type> =>
switch variant {
| IEvType(value) => value->Some
| _ => None
}
@genType
let getTypeIdentifier = (variant: squiggleValue): option<string> =>
switch variant {
| IEvTypeIdentifier(value) => value->Some
| _ => None
}

View File

@ -2,9 +2,7 @@ type squiggleValue = ForTS_SquiggleValue.squiggleValue
@genType type squiggleValue_Array = ForTS_SquiggleValue.squiggleValue_Array //re-export recursive type
@genType
let getValues = (v: squiggleValue_Array): array<squiggleValue> =>
ReducerInterface_InternalExpressionValue.arrayToValueArray(v)
let getValues = (v: squiggleValue_Array): array<squiggleValue> => Reducer_Value.arrayToValueArray(v)
@genType
let toString = (v: squiggleValue_Array): string =>
ReducerInterface_InternalExpressionValue.toStringArray(v)
let toString = (v: squiggleValue_Array): string => Reducer_Value.toStringArray(v)

View File

@ -1,5 +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 =>
ReducerInterface_InternalExpressionValue.toStringDeclaration(v)
let toString = (v: squiggleValue_Declaration): string => Reducer_Value.toStringDeclaration(v)

View File

@ -1,5 +1,4 @@
@genType type squiggleValue_Distribution = ForTS_Distribution.distribution
@genType
let toString = (v: squiggleValue_Distribution): string =>
ReducerInterface_InternalExpressionValue.toStringDistribution(v)
let toString = (v: squiggleValue_Distribution): string => Reducer_Value.toStringDistribution(v)

View File

@ -1,8 +1,7 @@
@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 =>
ReducerInterface_InternalExpressionValue.toStringFunction(v)
let toString = (v: squiggleValue_Lambda): string => Reducer_Value.toStringFunction(v)
@genType
let parameters = (v: squiggleValue_Lambda): array<string> => {

View File

@ -1,16 +0,0 @@
type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
@genType type squiggleValue_Module = ForTS_SquiggleValue.squiggleValue_Module //re-export recursive type
@genType
let getKeyValuePairs = (v: squiggleValue_Module): array<(string, squiggleValue)> =>
ReducerInterface_InternalExpressionValue.nameSpaceToKeyValuePairs(v)
@genType
let toString = (v: squiggleValue_Module): string =>
ReducerInterface_InternalExpressionValue.toStringNameSpace(v)
@genType
let toSquiggleValue = (v: squiggleValue_Module): squiggleValue => IEvBindings(v)
@genType
let get = ReducerInterface_InternalExpressionValue.nameSpaceGet

View File

@ -3,7 +3,10 @@ type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
@genType
let getKeyValuePairs = (value: squiggleValue_Record): array<(string, squiggleValue)> =>
ReducerInterface_InternalExpressionValue.recordToKeyValuePairs(value)
Reducer_Value.recordToKeyValuePairs(value)
@genType
let toString = (v: squiggleValue_Record) => ReducerInterface_InternalExpressionValue.toStringMap(v)
let toString = (v: squiggleValue_Record) => Reducer_Value.toStringMap(v)
@genType
let toSquiggleValue = (v: squiggleValue_Record): squiggleValue => IEvRecord(v)

View File

@ -1,10 +0,0 @@
type squiggleValue = ForTS_SquiggleValue.squiggleValue //use
@genType type squiggleValue_Type = ForTS_SquiggleValue.squiggleValue_Type //re-export recursive type
@genType
let getKeyValuePairs = (value: squiggleValue_Type): array<(string, squiggleValue)> =>
ReducerInterface_InternalExpressionValue.recordToKeyValuePairs(value)
@genType
let toString = (value: squiggleValue_Type): string =>
ReducerInterface_InternalExpressionValue.toStringType(value)

View File

@ -1,19 +1,13 @@
export enum squiggleValueTag {
Array = "Array",
ArrayString = "ArrayString",
Bool = "Bool",
Call = "Call",
Date = "Date",
Declaration = "Declaration",
Distribution = "Distribution",
Lambda = "Lambda",
Module = "Module",
Number = "Number",
Record = "Record",
String = "String",
Symbol = "Symbol",
TimeDuration = "TimeDuration",
Type = "Type",
TypeIdentifier = "TypeIdentifier",
Void = "Void",
}

View File

@ -6,9 +6,7 @@
@genType type squiggleValue_Array = ForTS_SquiggleValue_Array.squiggleValue_Array //re-export
@genType type squiggleValue_Declaration = ForTS_SquiggleValue_Declaration.squiggleValue_Declaration //re-export
@genType type squiggleValue_Lambda = ForTS_SquiggleValue_Lambda.squiggleValue_Lambda //re-export
@genType type squiggleValue_Module = ForTS_SquiggleValue_Module.squiggleValue_Module //re-export
@genType type squiggleValue_Record = ForTS_SquiggleValue_Record.squiggleValue_Record //re-export
@genType type squiggleValue_Type = ForTS_SquiggleValue_Type.squiggleValue_Type //re-export
/* Distribution related */
@genType type squiggleValue_Distribution = ForTS_Distribution.distribution //re-export

View File

@ -1,7 +1,5 @@
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
type internalExpressionValue = ReducerInterface_InternalExpressionValue.t
type internalExpressionValueType = ReducerInterface_InternalExpressionValue.internalExpressionValueType
type internalExpressionValueType = Reducer_Value.internalExpressionValueType
type errorValue = Reducer_ErrorValue.errorValue
/*
Function Registry "Type". A type, without any other information.
@ -9,7 +7,10 @@ type internalExpressionValueType = ReducerInterface_InternalExpressionValue.inte
*/
type rec frType =
| FRTypeNumber
| FRTypeBool
| FRTypeNumeric
| FRTypeDate
| FRTypeTimeDuration
| FRTypeDistOrNumber
| FRTypeDist
| FRTypeLambda
@ -22,35 +23,16 @@ type rec frType =
and frTypeRecord = array<frTypeRecordParam>
and frTypeRecordParam = (string, frType)
/*
Function Registry "Value". A type, with the information of that type.
Like, #Float(40.0)
*/
type rec frValue =
| FRValueNumber(float)
| FRValueDist(DistributionTypes.genericDist)
| FRValueArray(array<frValue>)
| FRValueDistOrNumber(frValueDistOrNumber)
| FRValueRecord(frValueRecord)
| FRValueLambda(ReducerInterface_InternalExpressionValue.lambdaValue)
| FRValueString(string)
| FRValueVariant(string)
| FRValueAny(frValue)
| FRValueDict(Js.Dict.t<frValue>)
and frValueRecord = array<frValueRecordParam>
and frValueRecordParam = (string, frValue)
and frValueDictParam = (string, frValue)
and frValueDistOrNumber = FRValueNumber(float) | FRValueDist(DistributionTypes.genericDist)
type frValueDistOrNumber = FRValueNumber(float) | FRValueDist(DistributionTypes.genericDist)
type fnDefinition = {
name: string,
inputs: array<frType>,
run: (
array<internalExpressionValue>,
array<frValue>,
ProjectAccessorsT.t,
ProjectReducerFnT.t,
) => result<internalExpressionValue, string>,
array<Reducer_T.value>,
Reducer_T.environment,
Reducer_T.reducerFn,
) => result<Reducer_T.value, errorValue>,
}
type function = {
@ -64,14 +46,14 @@ type function = {
isExperimental: bool,
}
type fnNameDict = Js.Dict.t<array<function>>
type registry = {functions: array<function>, fnNameDict: fnNameDict}
module FRType = {
type t = frType
let rec toString = (t: t) =>
switch t {
| FRTypeNumber => "number"
| FRTypeBool => "bool"
| FRTypeDate => "date"
| FRTypeTimeDuration => "duration"
| FRTypeNumeric => "numeric"
| FRTypeDist => "distribution"
| FRTypeDistOrNumber => "distribution|number"
@ -87,284 +69,47 @@ module FRType = {
| FRTypeAny => `any`
}
let rec toFrValue = (r: internalExpressionValue): option<frValue> =>
switch r {
| IEvNumber(f) => Some(FRValueNumber(f))
| IEvString(f) => Some(FRValueString(f))
| IEvDistribution(f) => Some(FRValueDistOrNumber(FRValueDist(f)))
| IEvLambda(f) => Some(FRValueLambda(f))
| IEvArray(elements) =>
elements->E.A2.fmap(toFrValue)->E.A.O.openIfAllSome->E.O2.fmap(r => FRValueArray(r))
| IEvRecord(map) =>
Belt.Map.String.toArray(map)
->E.A2.fmap(((key, item)) => item->toFrValue->E.O2.fmap(o => (key, o)))
->E.A.O.openIfAllSome
->E.O2.fmap(r => FRValueRecord(r))
| _ => None
}
let rec matchWithExpressionValue = (t: t, r: internalExpressionValue): option<frValue> =>
let rec matchWithValue = (t: t, r: Reducer_T.value): bool =>
switch (t, r) {
| (FRTypeAny, f) => toFrValue(f)
| (FRTypeString, IEvString(f)) => Some(FRValueString(f))
| (FRTypeNumber, IEvNumber(f)) => Some(FRValueNumber(f))
| (FRTypeDistOrNumber, IEvNumber(f)) => Some(FRValueDistOrNumber(FRValueNumber(f)))
| (FRTypeDistOrNumber, IEvDistribution(Symbolic(#Float(f)))) =>
Some(FRValueDistOrNumber(FRValueNumber(f)))
| (FRTypeDistOrNumber, IEvDistribution(f)) => Some(FRValueDistOrNumber(FRValueDist(f)))
| (FRTypeDist, IEvDistribution(f)) => Some(FRValueDist(f))
| (FRTypeNumeric, IEvNumber(f)) => Some(FRValueNumber(f))
| (FRTypeNumeric, IEvDistribution(Symbolic(#Float(f)))) => Some(FRValueNumber(f))
| (FRTypeLambda, IEvLambda(f)) => Some(FRValueLambda(f))
| (FRTypeAny, _) => true
| (FRTypeString, IEvString(_)) => true
| (FRTypeNumber, IEvNumber(_)) => true
| (FRTypeBool, IEvBool(_)) => true
| (FRTypeDate, IEvDate(_)) => true
| (FRTypeTimeDuration, IEvTimeDuration(_)) => true
| (FRTypeDistOrNumber, IEvNumber(_)) => true
| (FRTypeDistOrNumber, IEvDistribution(_)) => true
| (FRTypeDist, IEvDistribution(_)) => true
| (FRTypeNumeric, IEvNumber(_)) => true
| (FRTypeNumeric, IEvDistribution(Symbolic(#Float(_)))) => true
| (FRTypeLambda, IEvLambda(_)) => true
| (FRTypeArray(intendedType), IEvArray(elements)) => {
let el = elements->E.A2.fmap(matchWithExpressionValue(intendedType))
E.A.O.openIfAllSome(el)->E.O2.fmap(r => FRValueArray(r))
elements->Belt.Array.every(v => matchWithValue(intendedType, v))
}
| (FRTypeDict(r), IEvRecord(map)) =>
map
->Belt.Map.String.toArray
->E.A2.fmap(((key, item)) => matchWithExpressionValue(r, item)->E.O2.fmap(o => (key, o)))
->E.A.O.openIfAllSome
->E.O2.fmap(r => FRValueDict(Js.Dict.fromArray(r)))
map->Belt.Map.String.valuesToArray->Belt.Array.every(v => matchWithValue(r, v))
| (FRTypeRecord(recordParams), IEvRecord(map)) => {
let getAndMatch = (name, input) =>
Belt.Map.String.get(map, name)->E.O.bind(matchWithExpressionValue(input))
//All names in the type must be present. If any are missing, the corresponding
//value will be None, and this function would return None.
let namesAndValues: array<option<(Js.Dict.key, frValue)>> =
recordParams->E.A2.fmap(((name, input)) =>
getAndMatch(name, input)->E.O2.fmap(match => (name, match))
)
namesAndValues->E.A.O.openIfAllSome->E.O2.fmap(r => FRValueRecord(r))
}
| _ => None
recordParams->Belt.Array.every(((name, input)) => {
switch map->Belt.Map.String.get(name) {
| Some(v) => matchWithValue(input, v)
| None => false
}
})
}
| _ => false
}
let rec matchReverse = (e: frValue): internalExpressionValue =>
switch e {
| FRValueNumber(f) => IEvNumber(f)
| FRValueDistOrNumber(FRValueNumber(n)) => IEvNumber(n)
| FRValueDistOrNumber(FRValueDist(n)) => IEvDistribution(n)
| FRValueDist(dist) => IEvDistribution(dist)
| FRValueArray(elements) => IEvArray(elements->E.A2.fmap(matchReverse))
| FRValueRecord(frValueRecord) => {
let map =
frValueRecord
->E.A2.fmap(((name, value)) => (name, matchReverse(value)))
->Belt.Map.String.fromArray
IEvRecord(map)
}
| FRValueDict(frValueRecord) => {
let map =
frValueRecord
->Js.Dict.entries
->E.A2.fmap(((name, value)) => (name, matchReverse(value)))
->Belt.Map.String.fromArray
IEvRecord(map)
}
| FRValueLambda(l) => IEvLambda(l)
| FRValueString(string) => IEvString(string)
| FRValueVariant(string) => IEvString(string)
| FRValueAny(f) => matchReverse(f)
}
let matchWithExpressionValueArray = (
inputs: array<t>,
args: array<internalExpressionValue>,
): option<array<frValue>> => {
let matchWithValueArray = (inputs: array<t>, args: array<Reducer_T.value>): bool => {
let isSameLength = E.A.length(inputs) == E.A.length(args)
if !isSameLength {
None
false
} else {
E.A.zip(inputs, args)
->E.A2.fmap(((input, arg)) => matchWithExpressionValue(input, arg))
->E.A.O.openIfAllSome
->Belt.Array.every(((input, arg)) => matchWithValue(input, arg))
}
}
}
/*
This module, Matcher, is fairly lengthy. However, only two functions from it
are meant to be used outside of it. These are findMatches and matchToDef in Matches.Registry.
The rest of it is just called from those two functions.
Update: This really should be completely re-done sometime, and tested. It works, but it's pretty messy. I'm sure
there are internal bugs, but the end functionality works, so I'm not too worried.
*/
module Matcher = {
module MatchSimple = {
type t = DifferentName | SameNameDifferentArguments | FullMatch
let isFullMatch = (match: t) =>
switch match {
| FullMatch => true
| _ => false
}
let isNameMatchOnly = (match: t) =>
switch match {
| SameNameDifferentArguments => true
| _ => false
}
}
module Match = {
type t<'a, 'b> = DifferentName | SameNameDifferentArguments('a) | FullMatch('b)
let isFullMatch = (match: t<'a, 'b>): bool =>
switch match {
| FullMatch(_) => true
| _ => false
}
let isNameMatchOnly = (match: t<'a, 'b>) =>
switch match {
| SameNameDifferentArguments(_) => true
| _ => false
}
}
module FnDefinition = {
let matchAssumingSameName = (f: fnDefinition, args: array<internalExpressionValue>) => {
switch FRType.matchWithExpressionValueArray(f.inputs, args) {
| Some(_) => MatchSimple.FullMatch
| None => MatchSimple.SameNameDifferentArguments
}
}
let match = (f: fnDefinition, fnName: string, args: array<internalExpressionValue>) => {
if f.name !== fnName {
MatchSimple.DifferentName
} else {
matchAssumingSameName(f, args)
}
}
}
module Function = {
type definitionId = int
type match = Match.t<array<definitionId>, definitionId>
let match = (
f: function,
nameSpace: option<string>,
fnName: string,
args: array<internalExpressionValue>,
): match => {
switch nameSpace {
| Some(ns) if ns !== f.nameSpace => Match.DifferentName
| _ => {
let matchedDefinition = () =>
E.A.getIndexBy(f.definitions, r =>
MatchSimple.isFullMatch(FnDefinition.match(r, fnName, args))
) |> E.O.fmap(r => Match.FullMatch(r))
let getMatchedNameOnlyDefinition = () => {
let nameMatchIndexes =
f.definitions
->E.A2.fmapi((index, r) =>
MatchSimple.isNameMatchOnly(FnDefinition.match(r, fnName, args))
? Some(index)
: None
)
->E.A.O.concatSomes
switch nameMatchIndexes {
| [] => None
| elements => Some(Match.SameNameDifferentArguments(elements))
}
}
E.A.O.firstSomeFnWithDefault(
[matchedDefinition, getMatchedNameOnlyDefinition],
Match.DifferentName,
)
}
}
}
}
module RegistryMatch = {
type match = {
nameSpace: string,
fnName: string,
inputIndex: int,
}
let makeMatch = (nameSpace: string, fnName: string, inputIndex: int) => {
nameSpace: nameSpace,
fnName: fnName,
inputIndex: inputIndex,
}
}
module Registry = {
let _findExactMatches = (
r: registry,
nameSpace: option<string>,
fnName: string,
args: array<internalExpressionValue>,
) => {
let functionMatchPairs =
r.functions->E.A2.fmap(l => (l, Function.match(l, nameSpace, fnName, args)))
let fullMatch = functionMatchPairs->E.A.getBy(((_, match)) => Match.isFullMatch(match))
fullMatch->E.O.bind(((fn, match)) =>
switch match {
| FullMatch(index) => Some(RegistryMatch.makeMatch(fn.nameSpace, fn.name, index))
| _ => None
}
)
}
let _findNameMatches = (
r: registry,
nameSpace: option<string>,
fnName: string,
args: array<internalExpressionValue>,
) => {
let functionMatchPairs =
r.functions->E.A2.fmap(l => (l, Function.match(l, nameSpace, fnName, args)))
let getNameMatches =
functionMatchPairs
->E.A2.fmap(((fn, match)) => Match.isNameMatchOnly(match) ? Some((fn, match)) : None)
->E.A.O.concatSomes
let matches =
getNameMatches
->E.A2.fmap(((fn, match)) =>
switch match {
| SameNameDifferentArguments(indexes) =>
indexes->E.A2.fmap(index => RegistryMatch.makeMatch(fn.nameSpace, fn.name, index))
| _ => []
}
)
->Belt.Array.concatMany
E.A.toNoneIfEmpty(matches)
}
let findMatches = (r: registry, fnName: string, args: array<internalExpressionValue>) => {
let fnNameInParts = Js.String.split(".", fnName)
let fnToSearch = E.A.get(fnNameInParts, 1) |> E.O.default(fnNameInParts[0])
let nameSpace = E.A.length(fnNameInParts) > 1 ? Some(fnNameInParts[0]) : None
switch _findExactMatches(r, nameSpace, fnToSearch, args) {
| Some(r) => Match.FullMatch(r)
| None =>
switch _findNameMatches(r, nameSpace, fnToSearch, args) {
| Some(r) => Match.SameNameDifferentArguments(r)
| None => Match.DifferentName
}
}
}
let matchToDef = (
registry: registry,
{nameSpace, fnName, inputIndex}: RegistryMatch.match,
): option<fnDefinition> =>
registry.functions
->E.A.getBy(fn => {
nameSpace === fn.nameSpace && fnName === fn.name
})
->E.O.bind(fn => E.A.get(fn.definitions, inputIndex))
}
}
module FnDefinition = {
type t = fnDefinition
@ -373,24 +118,19 @@ module FnDefinition = {
t.name ++ `(${inputs})`
}
let isMatch = (t: t, args: array<internalExpressionValue>) => {
let argValues = FRType.matchWithExpressionValueArray(t.inputs, args)
switch argValues {
| Some(_) => true
| None => false
}
let isMatch = (t: t, args: array<Reducer_T.value>) => {
FRType.matchWithValueArray(t.inputs, args)
}
let run = (
t: t,
args: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
args: array<Reducer_T.value>,
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)
| None => Error("Incorrect Types")
switch t->isMatch(args) {
| true => t.run(args, env, reducer)
| false => REOther("Incorrect Types")->Error
}
}
@ -442,43 +182,41 @@ module Function = {
}
}
module NameSpace = {
type t = {name: string, functions: array<function>}
let definitions = (t: t) => t.functions->E.A2.fmap(f => f.definitions)->E.A.concatMany
let uniqueFnNames = (t: t) => definitions(t)->E.A2.fmap(r => r.name)->E.A.uniq
let nameToDefinitions = (t: t, name: string) => definitions(t)->E.A2.filter(r => r.name == name)
}
module Registry = {
type fnNameDict = Belt.Map.String.t<array<fnDefinition>>
type registry = {functions: array<function>, fnNameDict: fnNameDict}
let toJson = (r: registry) => r.functions->E.A2.fmap(Function.toJson)
let allExamples = (r: registry) => r.functions->E.A2.fmap(r => r.examples)->E.A.concatMany
let allExamplesWithFns = (r: registry) =>
r.functions->E.A2.fmap(fn => fn.examples->E.A2.fmap(example => (fn, example)))->E.A.concatMany
let allNames = (r: registry) => r.fnNameDict->Belt.Map.String.keysToArray
let _buildFnNameDict = (r: array<function>): fnNameDict => {
let allDefinitionsWithFns =
r
->E.A2.fmap(fn => fn.definitions->E.A2.fmap(definitions => (fn, definitions)))
->E.A.concatMany
let functionsWithFnNames =
allDefinitionsWithFns
->E.A2.fmap(((fn, def)) => {
let nameWithNamespace = `${fn.nameSpace}.${def.name}`
let nameWithoutNamespace = def.name
fn.requiresNamespace
? [(nameWithNamespace, fn)]
: [(nameWithNamespace, fn), (nameWithoutNamespace, fn)]
// Three layers of reduce:
// 1. functions
// 2. definitions of each function
// 3. name variations of each definition
r->Belt.Array.reduce(Belt.Map.String.empty, (acc, fn) =>
fn.definitions->Belt.Array.reduce(acc, (acc, def) => {
let names =
[
fn.nameSpace == "" ? [] : [`${fn.nameSpace}.${def.name}`],
fn.requiresNamespace ? [] : [def.name],
]->E.A.concatMany
names->Belt.Array.reduce(acc, (acc, name) => {
switch acc->Belt.Map.String.get(name) {
| Some(fns) => {
let _ = fns->Js.Array2.push(def) // mutates the array, no need to update acc
acc
}
| None => acc->Belt.Map.String.set(name, [def])
}
})
})
->E.A.concatMany
let uniqueNames = functionsWithFnNames->E.A2.fmap(((name, _)) => name)->E.A.uniq
let cacheAsArray: array<(string, array<function>)> = uniqueNames->E.A2.fmap(uniqueName => {
let relevantItems =
E.A2.filter(functionsWithFnNames, ((defName, _)) => defName == uniqueName)->E.A2.fmap(
E.Tuple2.second,
)
(uniqueName, relevantItems)
})
cacheAsArray->Js.Dict.fromArray
)
}
let make = (fns: array<function>): registry => {
@ -486,48 +224,31 @@ module Registry = {
{functions: fns, fnNameDict: dict}
}
/*
There's a (potential+minor) bug here: If a function definition is called outside of the calls
to the registry, then it's possible that there could be a match after the registry is
called. However, for now, we could just call the registry last.
*/
let _matchAndRun = (
~registry: registry,
~fnName: string,
~args: array<internalExpressionValue>,
~accessors: ProjectAccessorsT.t,
~reducer: ProjectReducerFnT.t,
) => {
let relevantFunctions = Js.Dict.get(registry.fnNameDict, fnName) |> E.O.default([])
let modified = {functions: relevantFunctions, fnNameDict: registry.fnNameDict}
let matchToDef = m => Matcher.Registry.matchToDef(registry, m)
let showNameMatchDefinitions = matches => {
let defs =
matches
->E.A2.fmap(matchToDef)
->E.A.O.concatSomes
->E.A2.fmap(FnDefinition.toString)
->E.A2.fmap(r => `[${r}]`)
->E.A2.joinWith("; ")
`There are function matches for ${fnName}(), but with different arguments: ${defs}`
}
switch Matcher.Registry.findMatches(modified, fnName, args) {
| Matcher.Match.FullMatch(match) =>
match->matchToDef->E.O2.fmap(FnDefinition.run(_, args, accessors, reducer))
| SameNameDifferentArguments(m) => Some(Error(showNameMatchDefinitions(m)))
| _ => None
}
}
let dispatch = (
let call = (
registry,
(fnName, args): ReducerInterface_InternalExpressionValue.functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => {
_matchAndRun(~registry, ~fnName, ~args, ~accessors, ~reducer)->E.O2.fmap(
E.R2.errMap(_, s => Reducer_ErrorValue.RETodo(s)),
)
fnName: string,
args: array<Reducer_T.value>,
env: Reducer_T.environment,
reducer: Reducer_T.reducerFn,
): result<Reducer_T.value, errorValue> => {
switch Belt.Map.String.get(registry.fnNameDict, fnName) {
| Some(definitions) => {
let showNameMatchDefinitions = () => {
let defsString =
definitions
->E.A2.fmap(FnDefinition.toString)
->E.A2.fmap(r => `[${r}]`)
->E.A2.joinWith("; ")
`There are function matches for ${fnName}(), but with different arguments: ${defsString}`
}
let match = definitions->Js.Array2.find(def => def->FnDefinition.isMatch(args))
switch match {
| Some(def) => def->FnDefinition.run(args, env, reducer)
| None => REOther(showNameMatchDefinitions())->Error
}
}
| None => RESymbolNotFound(fnName)->Error
}
}
}

View File

@ -1,59 +1,65 @@
open FunctionRegistry_Core
open Reducer_T
let impossibleError = "Wrong inputs / Logically impossible"
let impossibleErrorString = "Wrong inputs / Logically impossible"
let impossibleError: errorValue = impossibleErrorString->Reducer_ErrorValue.REOther
let wrapError = e => Reducer_ErrorValue.REOther(e)
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
}
let getOrError = (a, g) => E.A.get(a, g) |> E.O.toResult(impossibleError)
let getOrError = (a, g) => E.A.get(a, g) |> E.O.toResult(impossibleErrorString)
module Prepare = {
type t = frValue
type ts = array<frValue>
type t = value
type ts = array<value>
type err = string
module ToValueArray = {
module Record = {
let twoArgs = (inputs: ts): result<ts, err> =>
let twoArgs = (inputs: ts, (arg1: string, arg2: string)): result<ts, err> =>
switch inputs {
| [FRValueRecord([(_, n1), (_, n2)])] => Ok([n1, n2])
| _ => Error(impossibleError)
| [IEvRecord(map)] => {
let n1 = map->Belt.Map.String.getExn(arg1)
let n2 = map->Belt.Map.String.getExn(arg2)
Ok([n1, n2])
}
| _ => Error(impossibleErrorString)
}
let threeArgs = (inputs: ts): result<ts, err> =>
let threeArgs = (inputs: ts, (arg1: string, arg2: string, arg3: string)): result<ts, err> =>
switch inputs {
| [FRValueRecord([(_, n1), (_, n2), (_, n3)])] => Ok([n1, n2, n3])
| _ => Error(impossibleError)
| [IEvRecord(map)] => {
let n1 = map->Belt.Map.String.getExn(arg1)
let n2 = map->Belt.Map.String.getExn(arg2)
let n3 = map->Belt.Map.String.getExn(arg3)
Ok([n1, n2, n3])
}
let toArgs = (inputs: ts): result<ts, err> =>
switch inputs {
| [FRValueRecord(args)] => args->E.A2.fmap(((_, b)) => b)->Ok
| _ => Error(impossibleError)
| _ => Error(impossibleErrorString)
}
}
module Array = {
let openA = (inputs: t): result<ts, err> =>
switch inputs {
| FRValueArray(n) => Ok(n)
| _ => Error(impossibleError)
| IEvArray(n) => Ok(n)
| _ => Error(impossibleErrorString)
}
let arrayOfArrays = (inputs: t): result<array<ts>, err> =>
switch inputs {
| FRValueArray(n) => n->E.A2.fmap(openA)->E.A.R.firstErrorOrOpen
| _ => Error(impossibleError)
| IEvArray(n) => n->E.A2.fmap(openA)->E.A.R.firstErrorOrOpen
| _ => Error(impossibleErrorString)
}
}
}
@ -61,8 +67,11 @@ module Prepare = {
module ToValueTuple = {
let twoDistOrNumber = (values: ts): result<(frValueDistOrNumber, frValueDistOrNumber), err> => {
switch values {
| [FRValueDistOrNumber(a1), FRValueDistOrNumber(a2)] => Ok(a1, a2)
| _ => Error(impossibleError)
| [IEvDistribution(a1), IEvDistribution(a2)] => Ok(FRValueDist(a1), FRValueDist(a2))
| [IEvDistribution(a1), IEvNumber(a2)] => Ok(FRValueDist(a1), FRValueNumber(a2))
| [IEvNumber(a1), IEvDistribution(a2)] => Ok(FRValueNumber(a1), FRValueDist(a2))
| [IEvNumber(a1), IEvNumber(a2)] => Ok(FRValueNumber(a1), FRValueNumber(a2))
| _ => Error(impossibleErrorString)
}
}
@ -71,67 +80,55 @@ module Prepare = {
err,
> => {
switch values {
| [FRValueDist(a1), FRValueDist(a2)] => Ok(a1, a2)
| _ => Error(impossibleError)
| [IEvDistribution(a1), IEvDistribution(a2)] => Ok(a1, a2)
| _ => Error(impossibleErrorString)
}
}
let twoNumbers = (values: ts): result<(float, float), err> => {
switch values {
| [FRValueNumber(a1), FRValueNumber(a2)] => Ok(a1, a2)
| _ => Error(impossibleError)
| [IEvNumber(a1), IEvNumber(a2)] => Ok(a1, a2)
| _ => Error(impossibleErrorString)
}
}
let threeNumbers = (values: ts): result<(float, float, float), err> => {
switch values {
| [FRValueNumber(a1), FRValueNumber(a2), FRValueNumber(a3)] => Ok(a1, a2, a3)
| _ => Error(impossibleError)
| [IEvNumber(a1), IEvNumber(a2), IEvNumber(a3)] => Ok(a1, a2, a3)
| _ => Error(impossibleErrorString)
}
}
let oneDistOrNumber = (values: ts): result<frValueDistOrNumber, err> => {
switch values {
| [FRValueDistOrNumber(a1)] => Ok(a1)
| _ => Error(impossibleError)
| [IEvNumber(a1)] => FRValueNumber(a1)->Ok
| [IEvDistribution(a2)] => FRValueDist(a2)->Ok
| _ => Error(impossibleErrorString)
}
}
module Record = {
let twoDistOrNumber = (values: ts): result<(frValueDistOrNumber, frValueDistOrNumber), err> =>
values->ToValueArray.Record.twoArgs->E.R.bind(twoDistOrNumber)
let twoDistOrNumber = (values: ts, labels: (string, string)): result<(frValueDistOrNumber, frValueDistOrNumber), err> =>
values->ToValueArray.Record.twoArgs(labels)->E.R.bind(twoDistOrNumber)
let twoDist = (values: ts): result<
let twoDist = (values: ts, labels: (string, string)): result<
(DistributionTypes.genericDist, DistributionTypes.genericDist),
err,
> => values->ToValueArray.Record.twoArgs->E.R.bind(twoDist)
> => values->ToValueArray.Record.twoArgs(labels)->E.R.bind(twoDist)
}
}
module ToArrayRecordPairs = {
let twoArgs = (input: t): result<array<ts>, err> => {
let array = input->ToValueArray.Array.openA
let pairs =
array->E.R.bind(pairs =>
pairs
->E.A2.fmap(xyCoord => [xyCoord]->ToValueArray.Record.twoArgs)
->E.A.R.firstErrorOrOpen
)
pairs
let oneNumber = (value: t): result<float, err> => {
switch value {
| IEvNumber(a1) => Ok(a1)
| _ => Error(impossibleErrorString)
}
}
let oneNumber = (values: t): result<float, err> => {
switch values {
| FRValueNumber(a1) => Ok(a1)
| _ => Error(impossibleError)
}
}
let oneDict = (values: t): result<Js.Dict.t<frValue>, err> => {
switch values {
| FRValueDict(a1) => Ok(a1)
| _ => Error(impossibleError)
let oneDict = (value: t): result<Reducer_T.map, err> => {
switch value {
| IEvRecord(a1) => Ok(a1)
| _ => Error(impossibleErrorString)
}
}
@ -142,7 +139,7 @@ module Prepare = {
inputs->getOrError(0)->E.R.bind(ToValueArray.Array.openA)->E.R.bind(openNumbers)
}
let dicts = (inputs: ts): Belt.Result.t<array<Js.Dict.t<frValue>>, err> => {
let dicts = (inputs: ts): Belt.Result.t<array<Reducer_T.map>, err> => {
let openDicts = (elements: array<t>) => elements->E.A2.fmap(oneDict)->E.A.R.firstErrorOrOpen
inputs->getOrError(0)->E.R.bind(ToValueArray.Array.openA)->E.R.bind(openDicts)
}
@ -223,12 +220,11 @@ module DefineFn = {
FnDefinition.make(
~name,
~inputs=[FRTypeNumber],
~run=(_, inputs, _, _) => {
inputs
->getOrError(0)
->E.R.bind(Prepare.oneNumber)
->E.R2.fmap(fn)
->E.R2.fmap(Wrappers.evNumber)
~run=(inputs, _, _) => {
switch inputs {
| [IEvNumber(x)] => fn(x)->IEvNumber->Ok
| _ => Error(impossibleError)
}
},
(),
)
@ -236,8 +232,11 @@ module DefineFn = {
FnDefinition.make(
~name,
~inputs=[FRTypeNumber, FRTypeNumber],
~run=(_, inputs, _, _) => {
inputs->Prepare.ToValueTuple.twoNumbers->E.R2.fmap(fn)->E.R2.fmap(Wrappers.evNumber)
~run=(inputs, _, _) => {
switch inputs {
| [IEvNumber(x), IEvNumber(y)] => fn(x, y)->IEvNumber->Ok
| _ => Error(impossibleError)
}
},
(),
)
@ -245,10 +244,153 @@ module DefineFn = {
FnDefinition.make(
~name,
~inputs=[FRTypeNumber, FRTypeNumber, FRTypeNumber],
~run=(_, inputs, _, _) => {
inputs->Prepare.ToValueTuple.threeNumbers->E.R2.fmap(fn)->E.R2.fmap(Wrappers.evNumber)
~run=(inputs, _, _) => {
switch inputs {
| [IEvNumber(x), IEvNumber(y), IEvNumber(z)] => fn(x, y, z)->IEvNumber->Ok
| _ => Error(impossibleError)
}
},
(),
)
}
}
module Make = {
/*
Opinionated explanations for API choices here:
Q: Why such short names?
A: Because we have to type them a lot in definitions.
Q: Why not DefineFn.Numbers.oneToOne / DefineFn.Numbers.twoToOne / ...?
A: Because return values matter too, and we have many possible combinations: numbers to numbers, pairs of numbers to numbers, pair of numbers to bools.
Q: Does this approach scale?
A: It's good enough for most cases, and we can fall back on raw `Function.make` if necessary. We should figure out the better API powered by parameterized types, but it's hard (and might require PPX).
Q: What about `frValue` types?
A: I hope we'll get rid of them soon.
Q: What about polymorphic functions with multiple definitions? Why ~fn is not an array?
A: We often define the same function in multiple `FR_*` files, so that doesn't work well anyway. In 90%+ cases there's a single definition. And having to write `name` twice is annoying.
*/
let f2f = (
~name: string,
~fn: float => float,
~nameSpace="",
~requiresNamespace=false,
~examples=?,
(),
) => {
Function.make(
~name,
~nameSpace,
~requiresNamespace,
~examples=examples->E.O.default([], _),
~output=EvtNumber,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeNumber],
~run=(inputs, _, _) =>
switch inputs {
| [IEvNumber(x)] => fn(x)->IEvNumber->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
}
let ff2f = (
~name: string,
~fn: (float, float) => float,
~nameSpace="",
~requiresNamespace=false,
~examples=?,
(),
) => {
Function.make(
~name,
~nameSpace,
~requiresNamespace,
~examples=examples->E.O.default([], _),
~output=EvtNumber,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeNumber, FRTypeNumber],
~run=(inputs, _, _) =>
switch inputs {
| [IEvNumber(x), IEvNumber(y)] => fn(x, y)->IEvNumber->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
}
let ff2b = (
~name: string,
~fn: (float, float) => bool,
~nameSpace="",
~requiresNamespace=false,
~examples=?,
(),
) => {
Function.make(
~name,
~nameSpace,
~requiresNamespace,
~examples=examples->E.O.default([], _),
~output=EvtBool,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeNumber, FRTypeNumber],
~run=(inputs, _, _) =>
switch inputs {
| [IEvNumber(x), IEvNumber(y)] => fn(x, y)->IEvBool->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
}
let bb2b = (
~name: string,
~fn: (bool, bool) => bool,
~nameSpace="",
~requiresNamespace=false,
~examples=?,
(),
) => {
Function.make(
~name,
~nameSpace,
~requiresNamespace,
~examples=examples->E.O.default([], _),
~output=EvtBool,
~definitions=[
FnDefinition.make(
~name,
~inputs=[FRTypeBool, FRTypeBool],
~run=(inputs, _, _) =>
switch inputs {
| [IEvBool(x), IEvBool(y)] => fn(x, y)->IEvBool->Ok
| _ => Error(impossibleError)
},
(),
),
],
(),
)
}
}

View File

@ -1,4 +1,5 @@
let fnList = Belt.Array.concatMany([
FR_Builtin.library,
FR_Dict.library,
FR_Dist.library,
FR_Danger.library,
@ -8,7 +9,16 @@ let fnList = Belt.Array.concatMany([
FR_Number.library,
FR_Pointset.library,
FR_Scoring.library,
FR_GenericDist.library,
FR_Units.library,
FR_Date.library,
FR_Math.library,
])
let registry = FunctionRegistry_Core.Registry.make(fnList)
let dispatch = FunctionRegistry_Core.Registry.dispatch(registry)
let call = FunctionRegistry_Core.Registry.call(registry)
let nonRegistryLambdas: array<(string, Reducer_T.lambdaValue)> = [
("mx", FR_GenericDist.mxLambda),
("mixture", FR_GenericDist.mxLambda),
]

View File

@ -9,38 +9,38 @@ The main interface is fairly constrained. Basically, write functions like the fo
~name="Normal",
~definitions=[
FnDefinition.make(
~name="Normal",
~definitions=[
FnDefinition.make(~name="normal", ~inputs=[FRTypeDistOrNumber, FRTypeDistOrNumber], ~run=(
inputs,
env,
) =>
inputs
->Prepare.ToValueTuple.twoDistOrNumber
->E.R.bind(
Process.twoDistsOrNumbersToDistUsingSymbolicDist(
~fn=E.Tuple2.toFnCall(SymbolicDist.Normal.make),
~env,
~values=_,
),
)
->E.R2.fmap(Wrappers.evDistribution)
~name="normal",
~inputs=[FRTypeDistOrNumber, FRTypeDistOrNumber],
~run=(
inputs,
env,
) =>
inputs
->Prepare.ToValueTuple.twoDistOrNumber
->E.R.bind(
Process.twoDistsOrNumbersToDistUsingSymbolicDist(
~fn=E.Tuple2.toFnCall(SymbolicDist.Normal.make),
~env,
~values=_,
),
],
)
->E.R2.fmap(Wrappers.evDistribution)
)
],
)
```
The Function name is just there for future documentation. The function defintions
The Function name is just there for future documentation.
## Key Files
**FunctionRegistry_Core**
Key types, internal functionality, and a `Registry` module with a `matchAndRun` function to call function definitions.
Key types, internal functionality, and a `Registry` module with a `call` function to call function definitions.
**FunctionRegistry_Library**
A list of all the Functions defined in the Function Registry.
The definition arrays are stored in `FR_*` modules, by convention.
**FunctionRegistry_Helpers**
A list of helper functions for the FunctionRegistry_Library.
A list of helper functions for the `FunctionRegistry_Library`.

View File

@ -0,0 +1,47 @@
/*
Bindings describe the entire set of bound variables accessible to the squiggle code.
Bindings objects are stored as linked lists of scopes:
{ localX: ..., localY: ... } <- { globalZ: ..., ... } <- { importedT: ..., ... } <- { stdlibFunction: ..., ... }
*/
type t = Reducer_T.bindings
let rec get = ({namespace, parent}: t, id: string) => {
switch namespace->Reducer_Namespace.get(id) {
| Some(v) => Some(v)
| None =>
switch parent {
| Some(p) => p->get(id)
| None => None
}
}
}
let set = ({namespace} as bindings: t, id: string, value): t => {
{
...bindings,
namespace: namespace->Reducer_Namespace.set(id, value),
}
}
let rec toString = ({namespace, parent}: t) => {
let pairs = namespace->Reducer_Namespace.toString
switch parent {
| Some(p) => `{${pairs}} / ${toString(p)}`
| None => `{${pairs}}`
}
}
let extend = (bindings: t): t => {namespace: Reducer_Namespace.make(), parent: bindings->Some}
let make = (): t => {namespace: Reducer_Namespace.make(), parent: None}
let removeResult = ({namespace} as bindings: t): t => {
...bindings,
namespace: namespace->Belt.Map.String.remove("__result__"),
}
let locals = ({namespace}: t): Reducer_T.namespace => namespace
let fromNamespace = (namespace: Reducer_Namespace.t): t => {namespace: namespace, parent: None}

View File

@ -1,189 +0,0 @@
// Only Bindings as the global module is supported
// 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
let expressionValueToString = toString
type t = ReducerInterface_InternalExpressionValue.nameSpace
let typeAliasesKey = "_typeAliases_"
let typeReferencesKey = "_typeReferences_"
let getType = (NameSpace(container): t, id: string) => {
Belt.Map.String.get(container, typeAliasesKey)->Belt.Option.flatMap(aliases =>
switch aliases {
| IEvRecord(r) => Belt.Map.String.get(r, id)
| _ => None
}
)
}
let getTypeOf = (NameSpace(container): t, id: string) => {
Belt.Map.String.get(container, typeReferencesKey)->Belt.Option.flatMap(defs =>
switch defs {
| IEvRecord(r) => Belt.Map.String.get(r, id)
| _ => None
}
)
}
let getWithDefault = (NameSpace(container): t, id: string, default) =>
switch Belt.Map.String.get(container, id) {
| Some(v) => v
| None => default
}
let get = (NameSpace(container): t, id: string) => Belt.Map.String.get(container, id)
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 {
| IEvRecord(r) => r
| _ => emptyMap
}
let r2 = Belt.Map.String.set(r, id, value)->IEvRecord
NameSpace(Belt.Map.String.set(container, typeAliasesKey, r2))
}
let setTypeOf = (NameSpace(container): t, id: string, value): t => {
let rValue = Belt.Map.String.getWithDefault(container, typeReferencesKey, IEvRecord(emptyMap))
let r = switch rValue {
| IEvRecord(r) => r
| _ => emptyMap
}
let r2 = Belt.Map.String.set(r, id, value)->IEvRecord
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 emptyModule: t = NameSpace(emptyMap)
let emptyBindings = emptyModule
let emptyNameSpace = emptyModule
// let fromTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceFromTypeScriptBindings
// let toTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceToTypeScriptBindings
let toExpressionValue = (nameSpace: t): internalExpressionValue => IEvBindings(nameSpace)
let fromExpressionValue = (aValue: internalExpressionValue): t =>
switch aValue {
| IEvBindings(nameSpace) => nameSpace
| _ => emptyModule
}
let fromArray = a => NameSpace(Belt.Map.String.fromArray(a))
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 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
}),
)
}
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))
}
}
// -- Module definition
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 defineString = (nameSpace: t, identifier: string, value: string): t =>
nameSpace->define(identifier, IEvString(value))
let defineBool = (nameSpace: t, identifier: string, value: bool): t =>
nameSpace->define(identifier, IEvBool(value))
let defineModule = (nameSpace: t, identifier: string, value: t): t =>
nameSpace->define(identifier, toExpressionValue(value))
let defineFunction = (nameSpace: t, identifier: string, value: ExpressionT.optionFfiFn): t => {
nameSpace->define(identifier, convertOptionToFfiFn(identifier, value)->eLambdaFFIValue)
}
let defineFunctionReturningResult = (
nameSpace: t,
identifier: string,
value: ExpressionT.optionFfiFnReturningResult,
): t => {
nameSpace->define(
identifier,
convertOptionToFfiFnReturningResult(identifier, value)->eLambdaFFIValue,
)
}
let emptyStdLib: t = emptyModule->defineBool("_standardLibrary", true)
let chainTo = (nameSpace: t, previousNameSpaces: array<t>) => {
previousNameSpaces->Belt.Array.reduce(nameSpace, (topNameSpace, prevNameSpace) =>
mergeFrom(prevNameSpace, topNameSpace)
)
}
let removeResult = (NameSpace(container): t): t => {
container->Belt.Map.String.remove("__result__")->NameSpace
}

View File

@ -0,0 +1,12 @@
type t = Reducer_T.context
let defaultEnvironment: Reducer_T.environment = DistributionOperation.defaultEnv
let createContext = (stdLib: Reducer_Namespace.t, environment: Reducer_T.environment): t => {
{
bindings: stdLib->Reducer_Bindings.fromNamespace->Reducer_Bindings.extend,
environment: environment,
}
}
let createDefaultContext = (): t => createContext(SquiggleLibrary_StdLib.stdLib, defaultEnvironment)

View File

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

View File

@ -1,218 +0,0 @@
module Bindings = Reducer_Bindings
module BindingsReplacer = Reducer_Expression_BindingsReplacer
module Continuation = ReducerInterface_Value_Continuation
module ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
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
open Reducer_ErrorValue
/*
MathJs provides default implementations for built-ins
This is where all the expected built-ins like + = * / sin cos log ln etc are handled
DO NOT try to add external function mapping here!
*/
//TODO: pow to xor
exception TestRescriptException
let callInternal = (
call: functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): result<'b, errorValue> => {
let callMathJs = (call: functionCall): result<'b, errorValue> =>
switch call {
| ("javascriptraise", [msg]) => Js.Exn.raiseError(toString(msg)) // For Tests
| ("rescriptraise", _) => raise(TestRescriptException) // For Tests
| call => call->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)
}
)
->Belt.Map.String.fromArray
->IEvRecord
->Ok
}
let arrayAtIndex = (aValueArray: array<internalExpressionValue>, 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) =>
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) =>
switch Belt.Map.String.get(dict, sIndex) {
| Some(value) => value->Ok
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
}
let doAddArray = (originalA, b) => {
let a = originalA->Js.Array2.copy
let _ = Js.Array2.pushMany(a, b)
a->IEvArray->Ok
}
let doAddString = (a, b) => {
let answer = Js.String2.concat(a, b)
answer->IEvString->Ok
}
let inspect = (value: internalExpressionValue) => {
Js.log(value->toString)
value->Ok
}
let inspectLabel = (value: internalExpressionValue, label: string) => {
Js.log(`${label}: ${value->toString}`)
value->Ok
}
let doSetBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) => {
Bindings.set(bindings, symbol, value)->IEvBindings->Ok
}
let doSetTypeAliasBindings = (
bindings: nameSpace,
symbol: string,
value: internalExpressionValue,
) => Bindings.setTypeAlias(bindings, symbol, value)->IEvBindings->Ok
let doSetTypeOfBindings = (bindings: nameSpace, symbol: string, value: internalExpressionValue) =>
Bindings.setTypeOf(bindings, symbol, value)->IEvBindings->Ok
let doExportBindings = (bindings: nameSpace) => bindings->Bindings.toExpressionValue->Ok
let doIdentity = (value: internalExpressionValue) => 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))
}
}
}
switch call {
| ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
| ("$_atIndex_$", [IEvBindings(dict), IEvString(sIndex)]) => moduleAtIndex(dict, sIndex)
| ("$_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)
| ("$_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)
| ("$_typeModifier_memberOf_$", [IEvTypeIdentifier(typeIdentifier), IEvArray(arr)]) =>
TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
| ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) =>
TypeBuilder.typeModifier_memberOf_update(typeRecord, IEvArray(arr))
| ("$_typeModifier_min_$", [IEvTypeIdentifier(typeIdentifier), value]) =>
TypeBuilder.typeModifier_min(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_min_$", [IEvType(typeRecord), value]) =>
TypeBuilder.typeModifier_min_update(typeRecord, value)
| ("$_typeModifier_max_$", [IEvTypeIdentifier(typeIdentifier), value]) =>
TypeBuilder.typeModifier_max(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_max_$", [IEvType(typeRecord), value]) =>
TypeBuilder.typeModifier_max_update(typeRecord, value)
| ("$_typeModifier_opaque_$", [IEvType(typeRecord)]) =>
TypeBuilder.typeModifier_opaque_update(typeRecord)
| ("$_typeOr_$", [IEvArray(arr)]) => TypeBuilder.typeOr(IEvArray(arr))
| ("$_typeFunction_$", [IEvArray(arr)]) => TypeBuilder.typeFunction(arr)
| ("$_typeTuple_$", [IEvArray(elems)]) => TypeBuilder.typeTuple(elems)
| ("$_typeArray_$", [elem]) => TypeBuilder.typeArray(elem)
| ("$_typeRecord_$", [IEvRecord(propertyMap)]) => TypeBuilder.typeRecord(propertyMap)
| ("concat", [IEvArray(aValueArray), IEvArray(bValueArray)]) =>
doAddArray(aValueArray, bValueArray)
| ("concat", [IEvString(aValueString), IEvString(bValueString)]) =>
doAddString(aValueString, bValueString)
| ("inspect", [value, IEvString(label)]) => inspectLabel(value, label)
| ("inspect", [value]) => inspect(value)
| (_, [IEvBool(_)])
| (_, [IEvNumber(_)])
| (_, [IEvString(_)])
| (_, [IEvBool(_), IEvBool(_)])
| (_, [IEvNumber(_), IEvNumber(_)])
| (_, [IEvString(_), IEvString(_)]) =>
callMathJs(call)
| call =>
Error(REFunctionNotFound(call->functionCallToCallSignature->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 =>
try {
let (fn, args) = call
// There is a bug that prevents string match in patterns
// So we have to recreate a copy of the string
ExternalLibrary.dispatch(
(Js.String.make(fn), args),
accessors,
reducer,
callInternal,
)->InternalExpressionValue.resultToValue
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Reducer_ErrorValue.toException
}

View File

@ -1,189 +0,0 @@
/*
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
open Reducer_Expression_ExpressionBuilder
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 newBindings = Bindings.fromExpressionValue(nameSpaceValue)
let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
}
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
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName)
if setBindingsFn !== "" {
useExpressionToSetBindings(bindingExpr, accessors, statement, (
newBindingsExpr,
boundStatement,
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
} else {
defaultStatement->Reducer_ErrorValue.toException
}
}
| _ => defaultStatement->Reducer_ErrorValue.toException
}
}
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()
}
}
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 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)
}
| _ => REExpectedType("Boolean", "")->Reducer_ErrorValue.toException
}
}
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)
}
}

View File

@ -1,7 +1,9 @@
// types are disabled until review and rewrite for 0.5 interpreter compatibility
/*
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module T = Reducer_Dispatch_T
module TypeChecker = Reducer_Type_TypeChecker
open ReducerInterface_InternalExpressionValue
open Reducer_Value
type errorValue = Reducer_ErrorValue.errorValue
@ -21,3 +23,5 @@ let makeFromTypes = jumpTable => {
}
dispatchChainPiece
}
*/

View File

@ -1,22 +1,21 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionT = Reducer_Expression_T
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T
// module 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 = (
// Reducer_Value.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 = (
// Reducer_Value.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<Reducer_T.value>,
// ProjectAccessorsT.t,
// ) => 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>

View File

@ -1,108 +1,130 @@
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
/*
Recursively evaluate/reduce the expression (Lisp AST/Lambda calculus)
Recursively evaluate the expression
*/
let rec reduceExpressionInProject = (
expression: t,
continuation: T.bindings,
accessors: ProjectAccessorsT.t,
): InternalExpressionValue.t => {
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
let rec evaluate: T.reducerFn = (expression, context): (T.value, T.context) => {
// Js.log(`reduce: ${expression->Reducer_Expression_T.toString}`)
switch expression {
| T.EValue(value) => value
| T.EList(list) =>
switch list {
| list{EValue(IEvCall(fName)), ..._args} =>
switch Macro.isMacroName(fName) {
// A macro expands then reduces itself
| true => Macro.doMacroCall(expression, continuation, accessors, reduceExpressionInProject)
| false => reduceExpressionList(list, continuation, accessors)
}
| _ => reduceExpressionList(list, continuation, accessors)
| T.EBlock(statements) => {
let innerContext = {...context, bindings: context.bindings->Bindings.extend}
let (value, _) =
statements->Belt.Array.reduce((T.IEvVoid, innerContext), ((_, currentContext), statement) =>
statement->evaluate(currentContext)
)
(value, context)
}
}
}
and reduceExpressionList = (
expressions: list<t>,
continuation: T.bindings,
accessors: ProjectAccessorsT.t,
): InternalExpressionValue.t => {
let acc: list<InternalExpressionValue.t> =
expressions->Belt.List.reduceReverse(list{}, (acc, each: t) =>
acc->Belt.List.add(each->reduceExpressionInProject(continuation, accessors))
)
acc->reduceValueList(accessors)
}
/*
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
}
| T.EProgram(statements) => {
// Js.log(`bindings: ${context.bindings->Bindings.locals->Reducer_Namespace.toString}`)
let (value, finalContext) =
statements->Belt.Array.reduce((T.IEvVoid, context), ((_, currentContext), statement) =>
statement->evaluate(currentContext)
)
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
accessors,
reduceExpressionInProject,
// Js.log(`bindings after: ${finalContext.bindings->Bindings.locals->Reducer_Namespace.toString}`)
(value, finalContext)
}
| T.EArray(elements) => {
let value =
elements
->Belt.Array.map(element => {
let (value, _) = evaluate(element, context)
value
})
->T.IEvArray
(value, context)
}
| T.ERecord(pairs) => {
let value =
pairs
->Belt.Array.map(((eKey, eValue)) => {
let (key, _) = eKey->evaluate(context)
let keyString = switch key {
| IEvString(s) => s
| _ => REOther("Record keys must be strings")->Reducer_ErrorValue.ErrorException->raise
}
let (value, _) = eValue->evaluate(context)
(keyString, value)
})
->Belt.Map.String.fromArray
->T.IEvRecord
(value, context)
}
| T.EAssign(left, right) => {
let (result, _) = right->evaluate(context)
(
T.IEvVoid,
{
...context,
bindings: context.bindings->Bindings.set(left, result),
},
)
}
| 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 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)
| T.ESymbol(name) =>
switch context.bindings->Bindings.get(name) {
| Some(v) => (v, context)
| None => Reducer_ErrorValue.RESymbolNotFound(name)->Reducer_ErrorValue.ErrorException->raise
}
| T.EValue(value) => (value, context)
| T.ETernary(predicate, trueCase, falseCase) => {
let (predicateResult, _) = predicate->evaluate(context)
switch predicateResult {
| T.IEvBool(value) => (value ? trueCase : falseCase)->evaluate(context)
| _ => REExpectedType("Boolean", "")->Reducer_ErrorValue.ErrorException->raise
}
}
| T.ELambda(parameters, body) => (
Lambda.makeLambda(parameters, context.bindings, body)->T.IEvLambda,
context,
)
| T.ECall(fn, args) => {
let (lambda, _) = fn->evaluate(context)
let argValues = Js.Array2.map(args, arg => {
let (argValue, _) = arg->evaluate(context)
argValue
})
switch lambda {
| T.IEvLambda(lambda) => (
Lambda.doLambdaCall(lambda, argValues, context.environment, evaluate),
context,
)
| _ =>
RENotAFunction(lambda->Reducer_Value.toString)->Reducer_ErrorValue.ErrorException->raise
}
}
}
}
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<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: T.expression): result<T.value, errorValue> => {
let context = Reducer_Context.createDefaultContext()
try {
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
let (value, _) = expression->evaluate(context)
value->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
}
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>
let evaluateString = (peggyCode: string): result<T.value, errorValue> =>
parse(peggyCode)->Result.flatMap(evaluate)
}

View File

@ -1,62 +0,0 @@
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
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 expressionWithContext =
| ExpressionWithContext(expression, context)
| ExpressionNoContext(expression)
type t = expressionWithContext
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 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 toStringResult = rExpressionWithContext =>
switch rExpressionWithContext {
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
| Error(errorValue) => ErrorValue.errorToString(errorValue)
}
let resultToValue = (rExpressionWithContext: result<t, errorValue>): t => {
switch rExpressionWithContext {
| Ok(expressionWithContext) => expressionWithContext
| Error(errorValue) => ErrorValue.toException(errorValue)
}
}

View File

@ -1,45 +0,0 @@
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
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)
}
}
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
| _ =>
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->ErrorValue.toException
}

View File

@ -1,86 +1,43 @@
module BBindingsReplacer = Reducer_Expression_BindingsReplacer
module BErrorValue = Reducer_ErrorValue
module BExpressionT = Reducer_Expression_T
module BInternalExpressionValue = ReducerInterface_InternalExpressionValue
module BBindings = Reducer_Bindings
module T = Reducer_T
type errorValue = BErrorValue.errorValue
type expression = BExpressionT.expression
type expressionOrFFI = BExpressionT.expressionOrFFI
type ffiFn = BExpressionT.ffiFn
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
type expression = Reducer_T.expression
let eArray = anArray => anArray->BInternalExpressionValue.IEvArray->BExpressionT.EValue
let eArray = (anArray: array<T.expression>) => anArray->T.EArray
let eArrayString = anArray => anArray->BInternalExpressionValue.IEvArrayString->BExpressionT.EValue
let eBool = aBool => aBool->T.IEvBool->T.EValue
let eBindings = (anArray: array<(string, BInternalExpressionValue.t)>) =>
anArray->BBindings.fromArray->BBindings.toExpressionValue->BExpressionT.EValue
let eCall = (fn: expression, args: array<expression>): expression => T.ECall(fn, args)
let eBool = aBool => aBool->BInternalExpressionValue.IEvBool->BExpressionT.EValue
let eLambda = (parameters: array<string>, expr: expression) => T.ELambda(parameters, expr)
let eCall = (name: string): expression =>
name->BInternalExpressionValue.IEvCall->BExpressionT.EValue
let eNumber = aNumber => aNumber->T.IEvNumber->T.EValue
let eFunction = (fName: string, lispArgs: list<expression>): expression => {
let fn = fName->eCall
list{fn, ...lispArgs}->BExpressionT.EList
}
let eRecord = (aMap: array<(T.expression, T.expression)>) => aMap->T.ERecord
let eLambda = (
parameters: array<string>,
context: BInternalExpressionValue.nameSpace,
expr: expression,
) => {
BInternalExpressionValue.IEvLambda({
parameters: parameters,
context: context,
body: NotFFI(expr)->BBindings.castExpressionToInternalCode,
})->BExpressionT.EValue
}
let eString = aString => aString->T.IEvString->T.EValue
let eLambdaFFI = (ffiFn: ffiFn) => {
ffiFn->BBindings.eLambdaFFIValue->BExpressionT.EValue
}
let eSymbol = (name: string): expression => T.ESymbol(name)
let eNumber = aNumber => aNumber->BInternalExpressionValue.IEvNumber->BExpressionT.EValue
let eBlock = (exprs: array<expression>): expression => T.EBlock(exprs)
let eRecord = aMap => aMap->BInternalExpressionValue.IEvRecord->BExpressionT.EValue
let eProgram = (exprs: array<expression>): expression => T.EProgram(exprs)
let eString = aString => aString->BInternalExpressionValue.IEvString->BExpressionT.EValue
let eLetStatement = (symbol: string, valueExpression: expression): expression => T.EAssign(
symbol,
valueExpression,
)
let eSymbol = (name: string): expression =>
name->BInternalExpressionValue.IEvSymbol->BExpressionT.EValue
let eTernary = (
predicate: expression,
trueCase: expression,
falseCase: expression,
): expression => T.ETernary(predicate, trueCase, falseCase)
let eList = (list: list<expression>): expression => list->BExpressionT.EList
let eIdentifier = (name: string): expression => name->T.ESymbol
let eBlock = (exprs: list<expression>): expression => eFunction("$$_block_$$", exprs)
// let eTypeIdentifier = (name: string): expression =>
// name->T.IEvTypeIdentifier->T.EValue
let eModule = (nameSpace: BInternalExpressionValue.nameSpace): expression =>
nameSpace->BInternalExpressionValue.IEvBindings->BExpressionT.EValue
let eLetStatement = (symbol: string, valueExpression: expression): expression =>
eFunction("$_let_$", list{eSymbol(symbol), valueExpression})
let eBindStatement = (bindingExpr: expression, letStatement: expression): expression =>
eFunction("$$_bindStatement_$$", list{bindingExpr, letStatement})
let eBindStatementDefault = (letStatement: expression): expression =>
eFunction("$$_bindStatement_$$", list{letStatement})
let eBindExpression = (bindingExpr: expression, expression: expression): expression =>
eFunction("$$_bindExpression_$$", list{bindingExpr, expression})
let eBindExpressionDefault = (expression: expression): expression =>
eFunction("$$_bindExpression_$$", list{expression})
let eTernary = (truth: expression, trueCase: expression, falseCase: expression): expression =>
eFunction("$$_ternary_$$", list{truth, trueCase, falseCase})
let eIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvSymbol->BExpressionT.EValue
let eTypeIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvTypeIdentifier->BExpressionT.EValue
let eVoid: expression = BInternalExpressionValue.IEvVoid->BExpressionT.EValue
let eVoid: expression = T.IEvVoid->T.EValue

View File

@ -1,99 +1,60 @@
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 {
ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.toException
} 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) => ErrorValue.RESymbolNotFound(symbol)->ErrorValue.toException
| _ => 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) => value->ErrorValue.toException
}
}
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.bindings,
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.
// FunctionRegistry functions are unaffected by this, their API is too limited.
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
let localBindingsWithParameters = parameters->Belt.Array.reduceWithIndex(localBindings, (
currentBindings,
parameter,
index,
) => {
currentBindings->Reducer_Bindings.set(parameter, arguments[index])
})
let (value, _) = reducer(
body,
{bindings: localBindingsWithParameters, environment: environment},
)
value
}
{
// context: bindings,
body: lambda,
parameters: parameters,
}
}
let makeFFILambda = (body: Reducer_T.lambdaBody): Reducer_T.lambdaValue => {
body: body,
parameters: ["..."],
}

View File

@ -1,43 +0,0 @@
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
let expandMacroCallRs = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): result<expressionWithContext, 'e> =>
try {
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression,
bindings,
accessors,
reduceExpression,
)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
let doMacroCall = (
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("$$")

View File

@ -1,46 +1,31 @@
/*
An expression is a Lisp AST. An expression is either a primitive value or a list of expressions.
In the case of a list of expressions (e1, e2, e3, ...eN), the semantic is
apply e1, e2 -> apply e3 -> ... -> apply eN
This is Lisp semantics. It holds true in both eager and lazy evaluations.
A Lisp AST contains only expressions/primitive values to apply to their left.
The act of defining the semantics of a functional language is to write it in terms of Lisp AST.
An expression is an intermediate representation of a Squiggle code.
Expressions are evaluated by `Reducer_Expression.evaluate` function.
*/
module Extra = Reducer_Extra
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
type t = Reducer_T.expression
type internalExpressionValue = InternalExpressionValue.t
type environment = ReducerInterface_InternalExpressionValue.environment
type rec expression =
| EList(list<expression>) // A list to map-reduce
| EValue(internalExpressionValue) // Irreducible built-in value. Reducer should not know the internals. External libraries are responsible
and bindings = InternalExpressionValue.nameSpace
type t = expression
type reducerFn = (
expression,
bindings,
environment,
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue>
let commaJoin = values => values->Reducer_Extra_Array.intersperse(", ")->Js.String.concatMany("")
let semicolonJoin = values =>
values->Reducer_Extra_Array.intersperse("; ")->Js.String.concatMany("")
/*
Converts the expression to String
*/
let rec toString = expression =>
let rec toString = (expression: t) =>
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)
| EBlock(statements) =>
`{${Js.Array2.map(statements, aValue => toString(aValue))->semicolonJoin}}`
| EProgram(statements) => Js.Array2.map(statements, aValue => toString(aValue))->semicolonJoin
| EArray(aList) => `[${Js.Array2.map(aList, aValue => toString(aValue))->commaJoin}]`
| ERecord(map) =>
`{${map->Belt.Array.map(((key, value)) => `${key->toString}: ${value->toString}`)->commaJoin}}`
| 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) => Reducer_Value.toString(aValue)
}
let toStringResult = codeResult =>
@ -55,34 +40,19 @@ let toStringResultOkless = codeResult =>
| Error(m) => `Error(${Reducer_ErrorValue.errorToString(m)})`
}
let inspect = (expr: expression): expression => {
let inspect = (expr: t): t => {
Js.log(toString(expr))
expr
}
let inspectResult = (r: result<expression, Reducer_ErrorValue.errorValue>): result<
expression,
let inspectResult = (r: result<t, Reducer_ErrorValue.errorValue>): result<
t,
Reducer_ErrorValue.errorValue,
> => {
Js.log(toStringResult(r))
r
}
type ffiFn = (
array<internalExpressionValue>,
environment,
) => result<internalExpressionValue, Reducer_ErrorValue.errorValue>
type optionFfiFn = (array<internalExpressionValue>, environment) => option<internalExpressionValue>
type optionFfiFnReturningResult = (
array<internalExpressionValue>,
environment,
) => option<result<internalExpressionValue, Reducer_ErrorValue.errorValue>>
type expressionOrFFI =
| NotFFI(expression)
| FFI(ffiFn)
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
switch rExpression {
| Ok(expression) => expression

View File

@ -1 +0,0 @@
module Gate = Reducer_Js_Gate

Some files were not shown because too many files have changed in this diff Show More