Merge pull request #107 from umuro/reducer-dev

Reducer dev 2 (opened on behalf of Umur)
This commit is contained in:
Quinn 2022-03-30 11:39:57 -04:00 committed by GitHub
commit 8cbfeec81c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
34 changed files with 557 additions and 575 deletions

View File

@ -9,8 +9,8 @@
"@types/jest": "^27.4.0",
"@types/lodash": "^4.14.178",
"@types/node": "^17.0.16",
"@types/react": "^17.0.39",
"@types/react-dom": "^17.0.11",
"@types/react": "^17.0.43",
"@types/react-dom": "^17.0.14",
"cross-env": "^7.0.3",
"lodash": "^4.17.21",
"react": "^17.0.2",
@ -18,7 +18,7 @@
"react-scripts": "5.0.0",
"react-vega": "^7.4.4",
"tsconfig-paths-webpack-plugin": "^3.5.2",
"typescript": "^4.5.5",
"typescript": "^4.6.3",
"vega": "^5.21.0",
"vega-embed": "^6.20.6",
"vega-lite": "^5.2.0",
@ -77,7 +77,7 @@
"webpack-dev-server": "^4.7.4"
},
"resolutions": {
"@types/react": "17.0.39"
"@types/react": "17.0.43"
},
"source": "./src/index.ts",
"main": "dist/bundle.js",

View File

@ -22,8 +22,8 @@
"gh-pages": "3.2.3",
"jstat": "1.9.5",
"lenses-ppx": "6.1.10",
"less": "3.10.3",
"lodash": "4.17.15",
"less": "4.1.2",
"lodash": "4.17.21",
"mathjs": "10.4.1",
"moduleserve": "0.9.1",
"moment": "2.29.1",
@ -41,14 +41,14 @@
"devDependencies": {
"@emotion/babel-plugin": "^11.7.2",
"@parcel/core": "^2.4.0",
"@types/react": "^17.0.39",
"@types/react": "^17.0.43",
"autoprefixer": "^10.4.2",
"docsify": "^4.12.2",
"jest": "^27.5.1",
"parcel": "^2.3.2",
"parcel": "^2.4.0",
"postcss": "^8.4.7",
"postcss-cli": "^9.1.0",
"tailwindcss": "^3.0.23",
"typescript": "^4.6.2"
"typescript": "^4.6.3"
}
}

View File

@ -1,25 +1,25 @@
module CT = Reducer.CodeTree
module CTV = Reducer.Extension.CodeTreeValue
module JsG = Reducer.Js.Gate
module ExpressionValue = ReducerInterface.ExpressionValue
open Jest
open Expect
let expectEvalToBe = (expr: string, answer: string) =>
Reducer.eval(expr) -> CTV.showResult -> expect -> toBe(answer)
Reducer.eval(expr)->ExpressionValue.toStringResult->expect->toBe(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
test("-1", () => expectEvalToBe( "-1", "Ok(-1)"))
test("1-1", () => expectEvalToBe( "1-1", "Ok(0)"))
test("2>1", () => expectEvalToBe( "2>1", "Ok(true)"))
test("concat('a','b')", () => expectEvalToBe( "concat('a','b')", "Ok('ab')"))
test("-1", () => expectEvalToBe("-1", "Ok(-1)"))
test("1-1", () => expectEvalToBe("1-1", "Ok(0)"))
test("2>1", () => expectEvalToBe("2>1", "Ok(true)"))
test("concat('a','b')", () => expectEvalToBe("concat('a','b')", "Ok('ab')"))
})
describe("builtin exception", () => {
//It's a pity that MathJs does not return error position
test("MathJs Exception", () => expectEvalToBe( "testZadanga()", "Error(JS Exception: Error: Undefined function testZadanga)"))
test("MathJs Exception", () =>
expectEvalToBe("testZadanga()", "Error(JS Exception: Error: Undefined function testZadanga)")
)
})

View File

@ -1,15 +0,0 @@
module CTV = Reducer.Extension.CodeTreeValue
open Jest
open Expect
describe("CodeTreeValue", () => {
test("showArgs", () =>
expect([CTV.CtvNumber(1.), CTV.CtvString("a")]->CTV.showArgs)
->toBe("1, 'a'")
)
test("showFunctionCall", () =>
expect( ("fn", [CTV.CtvNumber(1.), CTV.CtvString("a")])->CTV.showFunctionCall )
->toBe("fn(1, 'a')")
)
})

View File

@ -1,30 +1,32 @@
module CTV = Reducer.Extension.CodeTreeValue
module ME = Reducer.MathJs.Eval
module Rerr = Reducer.Error
open ReducerInterface.ExpressionValue
module MathJs = Reducer.MathJs
module ErrorValue = Reducer.ErrorValue
open Jest
open ExpectJs
describe("eval", () => {
test("Number", () => expect(ME.eval("1"))
-> toEqual(Ok(CTV.CtvNumber(1.))))
test("Number expr", () => expect(ME.eval("1-1"))
-> toEqual(Ok(CTV.CtvNumber(0.))))
test("String", () => expect(ME.eval("'hello'"))
-> toEqual(Ok(CTV.CtvString("hello"))))
test("String expr", () => expect(ME.eval("concat('hello ','world')"))
-> toEqual(Ok(CTV.CtvString("hello world"))))
test("Boolean", () => expect(ME.eval("true"))
-> toEqual(Ok(CTV.CtvBool(true))))
test("Boolean expr", () => expect(ME.eval("2>1"))
-> toEqual(Ok(CTV.CtvBool(true))))
test("Number", () => expect(MathJs.Eval.eval("1"))->toEqual(Ok(EvNumber(1.))))
test("Number expr", () => expect(MathJs.Eval.eval("1-1"))->toEqual(Ok(EvNumber(0.))))
test("String", () => expect(MathJs.Eval.eval("'hello'"))->toEqual(Ok(EvString("hello"))))
test("String expr", () =>
expect(MathJs.Eval.eval("concat('hello ','world')"))->toEqual(Ok(EvString("hello world")))
)
test("Boolean", () => expect(MathJs.Eval.eval("true"))->toEqual(Ok(EvBool(true))))
test("Boolean expr", () => expect(MathJs.Eval.eval("2>1"))->toEqual(Ok(EvBool(true))))
})
describe("errors", () => {
// All those errors propagete up and are returned by the resolver
test("unknown function", () => expect(ME.eval("testZadanga()"))
-> toEqual(Error(Rerr.RerrJs(Some("Undefined function testZadanga"), Some("Error")))))
test("unknown function", () =>
expect(MathJs.Eval.eval("testZadanga()"))->toEqual(
Error(ErrorValue.REJavaScriptExn(Some("Undefined function testZadanga"), Some("Error"))),
)
)
test("unknown answer type", () => expect(ME.eval("1+1i"))
-> toEqual(Error(Rerr.RerrTodo("Unhandled MathJs literal type: object"))))
test("unknown answer type", () =>
expect(MathJs.Eval.eval("1+1i"))->toEqual(
Error(ErrorValue.RETodo("Unhandled MathJs literal type: object")),
)
)
})

View File

@ -1,15 +1,13 @@
module MJ=Reducer.MathJs.Parse
module Parse = Reducer.MathJs.Parse
module Result = Belt.Result
open Jest
open Expect
let expectParseToBe = (expr, answer) =>
MJ.parse(expr) -> Result.flatMap(MJ.castNodeType) -> MJ.showResult
-> expect -> toBe(answer)
Parse.parse(expr)->Result.flatMap(Parse.castNodeType)->Parse.toStringResult->expect->toBe(answer)
describe("MathJs parse", () => {
describe("literals operators paranthesis", () => {
test("1", () => expectParseToBe("1", "1"))
test("'hello'", () => expectParseToBe("'hello'", "'hello'"))
@ -20,36 +18,34 @@ describe("MathJs parse", () => {
test("(1+2)", () => expectParseToBe("(1+2)", "(add(1, 2))"))
})
describe( "variables", () => {
describe("variables", () => {
Skip.test("define", () => expectParseToBe("x = 1", "???"))
Skip.test("use", () => expectParseToBe("x", "???"))
})
describe( "functions", () => {
describe("functions", () => {
Skip.test("define", () => expectParseToBe("identity(x) = x", "???"))
Skip.test("use", () => expectParseToBe("identity(x)", "???"))
})
describe( "arrays", () => {
describe("arrays", () => {
test("empty", () => expectParseToBe("[]", "[]"))
test("define", () => expectParseToBe("[0, 1, 2]", "[0, 1, 2]"))
test("define with strings", () =>
expectParseToBe("['hello', 'world']", "['hello', 'world']"))
test("define with strings", () => expectParseToBe("['hello', 'world']", "['hello', 'world']"))
Skip.test("range", () => expectParseToBe("range(0, 4)", "range(0, 4)"))
test("index", () => expectParseToBe("([0,1,2])[1]", "([0, 1, 2])[1]"))
})
describe( "records", () => {
describe("records", () => {
test("define", () => expectParseToBe("{a: 1, b: 2}", "{a: 1, b: 2}"))
test("use", () => expectParseToBe("record.property", "record['property']"))
})
describe( "comments", () => {
describe("comments", () => {
Skip.test("define", () => expectParseToBe("# This is a comment", "???"))
})
describe( "if statement", () => {
describe("if statement", () => {
Skip.test("define", () => expectParseToBe("if (true) { 1 } else { 0 }", "???"))
})
})

View File

@ -1,14 +1,14 @@
module CT = Reducer.CodeTree
module CTV = Reducer.Extension.CodeTreeValue
module Expression = Reducer.Expression
module ExpressionValue = ReducerInterface.ExpressionValue
open Jest
open Expect
let expectParseToBe = (expr: string, answer: string) =>
Reducer.parse(expr) -> CT.showResult -> expect -> toBe(answer)
Reducer.parse(expr)->Expression.toStringResult->expect->toBe(answer)
let expectEvalToBe = (expr: string, answer: string) =>
Reducer.eval(expr) -> CTV.showResult -> expect -> toBe(answer)
Reducer.eval(expr)->ExpressionValue.toStringResult->expect->toBe(answer)
// Current configuration does not ignore this file so we have to have a test
test("test helpers", () => expect(1)->toBe(1))

View File

@ -3,34 +3,39 @@ open Reducer_TestHelpers
describe("reducer using mathjs parse", () => {
// Test the MathJs parser compatibility
// Those tests show that there is a semantic mapping from MathJs to CodeTree
// Those tests toString that there is a semantic mapping from MathJs to Expression
// Reducer.parse is called by Reducer.eval
// See https://mathjs.org/docs/expressions/syntax.html
// See https://mathjs.org/docs/reference/functions.html
// Those tests show that we are converting mathjs parse tree to what we need
// Those tests toString that we are converting mathjs parse tree to what we need
describe("expressions", () => {
test("1", () => expectParseToBe("1", "Ok(1)"))
test("(1)", () => expectParseToBe( "(1)", "Ok(1)"))
test("1+2", () => expectParseToBe( "1+2", "Ok((:add 1 2))"))
test("(1+2)", () => expectParseToBe( "1+2", "Ok((:add 1 2))"))
test("add(1,2)", () => expectParseToBe( "1+2", "Ok((:add 1 2))"))
test("1+2*3", () => expectParseToBe( "1+2*3", "Ok((:add 1 (:multiply 2 3)))"))
test("(1)", () => expectParseToBe("(1)", "Ok(1)"))
test("1+2", () => expectParseToBe("1+2", "Ok((:add 1 2))"))
test("(1+2)", () => expectParseToBe("1+2", "Ok((:add 1 2))"))
test("add(1,2)", () => expectParseToBe("1+2", "Ok((:add 1 2))"))
test("1+2*3", () => expectParseToBe("1+2*3", "Ok((:add 1 (:multiply 2 3)))"))
})
describe("arrays", () => {
//Note. () is a empty list in Lisp
// The only builtin structure in Lisp is list. There are no arrays
// [1,2,3] becomes (1 2 3)
test("empty", () => expectParseToBe( "[]", "Ok(())"))
test("[1, 2, 3]", () => expectParseToBe( "[1, 2, 3]", "Ok((1 2 3))"))
test("['hello', 'world']", () =>
expectParseToBe( "['hello', 'world']", "Ok(('hello' 'world'))"))
test("empty", () => expectParseToBe("[]", "Ok(())"))
test("[1, 2, 3]", () => expectParseToBe("[1, 2, 3]", "Ok((1 2 3))"))
test("['hello', 'world']", () => expectParseToBe("['hello', 'world']", "Ok(('hello' 'world'))"))
test("index", () => expectParseToBe("([0,1,2])[1]", "Ok((:$atIndex (0 1 2) (1)))"))
})
describe("records", () => {
test("define", () => expectParseToBe("{a: 1, b: 2}", "Ok((:$constructRecord (('a' 1) ('b' 2))))"))
test("define", () =>
expectParseToBe("{a: 1, b: 2}", "Ok((:$constructRecord (('a' 1) ('b' 2))))")
)
test("use", () =>
expectParseToBe("{a: 1, b: 2}.a", "Ok((:$atIndex (:$constructRecord (('a' 1) ('b' 2))) ('a')))"))
expectParseToBe(
"{a: 1, b: 2}.a",
"Ok((:$atIndex (:$constructRecord (('a' 1) ('b' 2))) ('a')))",
)
)
})
})
@ -40,37 +45,37 @@ describe("eval", () => {
// See https://mathjs.org/docs/expressions/syntax.html
// See https://mathjs.org/docs/reference/functions.html
describe("expressions", () => {
test("1", () => expectEvalToBe( "1", "Ok(1)"))
test("1+2", () => expectEvalToBe( "1+2", "Ok(3)"))
test("(1+2)*3", () => expectEvalToBe( "(1+2)*3", "Ok(9)"))
test("2>1", () => expectEvalToBe( "2>1", "Ok(true)"))
test("concat('a ', 'b')", () => expectEvalToBe( "concat('a ', 'b')", "Ok('a b')"))
test("log(10)", () => expectEvalToBe( "log(10)", "Ok(2.302585092994046)"))
test("cos(10)", () => expectEvalToBe( "cos(10)", "Ok(-0.8390715290764524)"))
test("1", () => expectEvalToBe("1", "Ok(1)"))
test("1+2", () => expectEvalToBe("1+2", "Ok(3)"))
test("(1+2)*3", () => expectEvalToBe("(1+2)*3", "Ok(9)"))
test("2>1", () => expectEvalToBe("2>1", "Ok(true)"))
test("concat('a ', 'b')", () => expectEvalToBe("concat('a ', 'b')", "Ok('a b')"))
test("log(10)", () => expectEvalToBe("log(10)", "Ok(2.302585092994046)"))
test("cos(10)", () => expectEvalToBe("cos(10)", "Ok(-0.8390715290764524)"))
// TODO more built ins
})
describe("arrays", () => {
test("empty array", () => expectEvalToBe( "[]", "Ok([])"))
test("[1, 2, 3]", () => expectEvalToBe( "[1, 2, 3]", "Ok([1, 2, 3])"))
test("['hello', 'world']", () => expectEvalToBe( "['hello', 'world']", "Ok(['hello', 'world'])"))
test("empty array", () => expectEvalToBe("[]", "Ok([])"))
test("[1, 2, 3]", () => expectEvalToBe("[1, 2, 3]", "Ok([1, 2, 3])"))
test("['hello', 'world']", () => expectEvalToBe("['hello', 'world']", "Ok(['hello', 'world'])"))
test("index", () => expectEvalToBe("([0,1,2])[1]", "Ok(1)"))
test("index not found", ()
=> expectEvalToBe("([0,1,2])[10]", "Error(Array index not found: 10)"))
test("index not found", () =>
expectEvalToBe("([0,1,2])[10]", "Error(Array index not found: 10)")
)
})
describe("records", () => {
test("define", () =>
expectEvalToBe("{a: 1, b: 2}", "Ok({a: 1, b: 2})"))
test("index", () =>
expectEvalToBe("{a: 1}.a", "Ok(1)"))
test("index not found", () =>
expectEvalToBe("{a: 1}.b", "Error(Record property not found: b)"))
test("define", () => expectEvalToBe("{a: 1, b: 2}", "Ok({a: 1, b: 2})"))
test("index", () => expectEvalToBe("{a: 1}.a", "Ok(1)"))
test("index not found", () => expectEvalToBe("{a: 1}.b", "Error(Record property not found: b)"))
})
})
describe("test exceptions", () => {
test("javascript exception", () =>
expectEvalToBe( "jsraise('div by 0')", "Error(JS Exception: Error: 'div by 0')"))
expectEvalToBe("jsraise('div by 0')", "Error(JS Exception: Error: 'div by 0')")
)
test("rescript exception", () =>
expectEvalToBe( "resraise()", "Error(TODO: unhandled rescript exception)"))
expectEvalToBe("resraise()", "Error(TODO: unhandled rescript exception)")
)
})

View File

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

View File

@ -35,9 +35,9 @@
"gentype": "^4.3.0",
"jest": "^27.5.1",
"moduleserve": "0.9.1",
"ts-jest": "^27.1.3",
"ts-jest": "^27.1.4",
"ts-loader": "^9.2.8",
"typescript": "^4.5.5",
"typescript": "^4.6.3",
"webpack": "^5.70.0",
"webpack-cli": "^4.9.2"
},

View File

@ -1,15 +1,17 @@
To interface your library there only 2 files to be modified:
- Reducer/Reducer_Extension/Reducer_Extension_CodeTreeValue.res
- Reducer/ReducerInterface/ReducerInterface_ExpressionValue.res
This is where your additional types are referred for the dispatcher.
- Reducer/Reducer_Extension/Reducer_ReducerLibrary.res
- Reducer/ReducerInterface/ReducerInterface_ExternalLibrary.res
This is where dispatching to your library is done. If the dispatcher becomes beastly then feel free to divide it into submodules.
The Reducer is built to use different external libraries as well as different external parsers. Both external parsers and external libraries are plugins.
And finally try using Reducer.eval to how your extentions look:
```rescript
test("1+2", () => expectEvalToBe( "1+2", "Ok(3)"))
```

View File

@ -1,10 +1,9 @@
module CodeTree = Reducer_CodeTree
module Dispatch = Reducer_Dispatch
module Error = Reducer_Error
module Extension = Reducer_Extension
module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression
module Extra = Reducer_Extra
module Js = Reducer_Js
module Etra = Reducer_Extra
module MathJs = Reducer_MathJs
let eval = CodeTree.eval
let parse = CodeTree.parse
let eval = Expression.eval
let parse = Expression.parse

View File

@ -0,0 +1,8 @@
module Dispatch = Reducer_Dispatch
module ErrorValue = Reducer_ErrorValue
module Expression = Reducer_Expression
module Extra = Reducer_Extra
module Js = Reducer_Js
module MathJs = Reducer_MathJs
let eval: string => result<Expression.expressionValue, ErrorValue.errorValue>
let parse: string => result<Expression.expression, ErrorValue.errorValue>

View File

@ -1,91 +0,0 @@
module BuiltIn = Reducer_Dispatch_BuiltIn
module T = Reducer_CodeTree_T
module CTV = Reducer_Extension.CodeTreeValue
module MJ = Reducer_MathJs_Parse
module MJT = Reducer_MathJs_ToCodeTree
module RLE = Reducer_Extra_List
module Rerr = Reducer_Error
module Result = Belt.Result
type codeTree = T.codeTree
type codeTreeValue = CTV.codeTreeValue
type reducerError = Rerr.reducerError
/*
Shows the Lisp Code as text lisp code
*/
let rec show = codeTree => switch codeTree {
| T.CtList(aList) => `(${(Belt.List.map(aList, aValue => show(aValue))
-> RLE.interperse(" ")
-> Belt.List.toArray -> Js.String.concatMany(""))})`
| CtValue(aValue) => CTV.show(aValue)
}
let showResult = (codeResult) => switch codeResult {
| Ok(a) => `Ok(${show(a)})`
| Error(m) => `Error(${Js.String.make(m)})`
}
/*
Converts a MathJs code to Lisp Code
*/
let parse_ = (expr: string, parser, converter): result<codeTree, reducerError> =>
expr -> parser -> Result.flatMap(node => converter(node))
let parse = (mathJsCode: string): result<codeTree, reducerError> =>
mathJsCode -> parse_( MJ.parse, MJT.fromNode )
module MapString = Belt.Map.String
type bindings = MapString.t<unit>
let defaultBindings: bindings = MapString.fromArray([])
// TODO Define bindings for function execution context
/*
After reducing each level of code tree, we have a value list to evaluate
*/
let reduceValueList = (valueList: list<codeTreeValue>): result<codeTreeValue, 'e> =>
switch valueList {
| list{CtvSymbol(fName), ...args} =>
(fName, args->Belt.List.toArray) -> BuiltIn.dispatch
| _ =>
valueList -> Belt.List.toArray -> CTV.CtvArray -> Ok
}
/*
Recursively evaluate/reduce the code tree
*/
let rec reduceCodeTree = (codeTree: codeTree, bindings): result<codeTreeValue, 'e> =>
switch codeTree {
| T.CtValue( value ) => value -> Ok
| T.CtList( list ) => {
let racc: result<list<codeTreeValue>, 'e> = list -> Belt.List.reduceReverse(
Ok(list{}),
(racc, each: codeTree) => racc->Result.flatMap( acc => {
each
-> reduceCodeTree(bindings)
-> Result.flatMap( newNode => {
acc->Belt.List.add(newNode)->Ok
})
})
)
racc -> Result.flatMap( acc => acc->reduceValueList )}
}
let evalWBindingsCodeTree = (aCodeTree, bindings): result<codeTreeValue, 'e> =>
reduceCodeTree(aCodeTree, bindings)
/*
Evaluates MathJs code via Lisp using bindings and answers the result
*/
let evalWBindings = (codeText:string, bindings: bindings) => {
parse(codeText) -> Result.flatMap(code => code -> evalWBindingsCodeTree(bindings))
}
/*
Evaluates MathJs code via Lisp and answers the result
*/
let eval = (code: string) => evalWBindings(code, defaultBindings)

View File

@ -1,7 +0,0 @@
module CTV = Reducer_Extension.CodeTreeValue
type codeTreeValue = CTV.codeTreeValue
type rec codeTree =
| CtList(list<codeTree>) // A list to map-reduce
| CtValue(codeTreeValue) // Irreducible built-in value. Reducer should not know the internals. External libraries are responsible

View File

@ -1,72 +1,72 @@
module CTV = Reducer_Extension.CodeTreeValue
module Lib = Reducer_Extension.ReducerLibrary
module ME = Reducer_MathJs.Eval
module Rerr = Reducer_Error
module ExternalLibrary = ReducerInterface.ExternalLibrary
module MathJs = Reducer_MathJs
open ReducerInterface.ExpressionValue
open Reducer_ErrorValue
/*
MathJs provides default implementations for builtins
This is where all the expected builtins like + = * / sin cos log ln etc are handled
DO NOT try to add external function mapping here!
*/
type codeTreeValue = CTV.codeTreeValue
type reducerError = Rerr.reducerError
exception TestRescriptException
let callInternal = (call: CTV.functionCall): result<'b, reducerError> =>{
let callMatjJs = (call: CTV.functionCall): result<'b, reducerError> =>
let callInternal = (call: functionCall): result<'b, errorValue> => {
let callMathJs = (call: functionCall): result<'b, errorValue> =>
switch call {
| ("jsraise", [msg]) => Js.Exn.raiseError(CTV.show(msg)) // For Tests
| ("jsraise", [msg]) => Js.Exn.raiseError(toString(msg)) // For Tests
| ("resraise", _) => raise(TestRescriptException) // For Tests
| call => call->CTV.showFunctionCall-> ME.eval
| call => call->toStringFunctionCall->MathJs.Eval.eval
}
let constructRecord = arrayOfPairs => {
Belt.Array.map(arrayOfPairs, pairValue => {
switch pairValue {
| CTV.CtvArray([CTV.CtvString(key), valueValue]) =>
(key, valueValue)
| _ => ("wrong key type", pairValue->CTV.showWithType->CTV.CtvString)}
}) -> Js.Dict.fromArray -> CTV.CtvRecord -> Ok
| EvArray([EvString(key), valueValue]) => (key, valueValue)
| _ => ("wrong key type", pairValue->toStringWithType->EvString)
}
})
->Js.Dict.fromArray
->EvRecord
->Ok
}
let arrayAtIndex = (aValueArray: array<codeTreeValue>, fIndex: float) =>
let arrayAtIndex = (aValueArray: array<expressionValue>, fIndex: float) =>
switch Belt.Array.get(aValueArray, Belt.Int.fromFloat(fIndex)) {
| Some(value) => value -> Ok
| None => Rerr.RerrArrayIndexNotFound("Array index not found", Belt.Int.fromFloat(fIndex)) -> Error
| Some(value) => value->Ok
| None => REArrayIndexNotFound("Array index not found", Belt.Int.fromFloat(fIndex))->Error
}
let recordAtIndex = (dict: Js.Dict.t<codeTreeValue>, sIndex) =>
switch (Js.Dict.get(dict, sIndex)) {
| Some(value) => value -> Ok
| None => Rerr.RerrRecordPropertyNotFound("Record property not found", sIndex) -> Error
let recordAtIndex = (dict: Js.Dict.t<expressionValue>, sIndex) =>
switch Js.Dict.get(dict, sIndex) {
| Some(value) => value->Ok
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
}
switch call {
// | ("$constructRecord", pairArray)
// | ("$atIndex", [CTV.CtvArray(anArray), CTV.CtvNumber(fIndex)]) => arrayAtIndex(anArray, fIndex)
// | ("$atIndex", [CTV.CtvRecord(aRecord), CTV.CtvString(sIndex)]) => recordAtIndex(aRecord, sIndex)
| ("$constructRecord", [CTV.CtvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs)
| ("$atIndex", [CTV.CtvArray(aValueArray), CTV.CtvArray([CTV.CtvNumber(fIndex)])]) =>
// | ("$atIndex", [EvArray(anArray), EvNumber(fIndex)]) => arrayAtIndex(anArray, fIndex)
// | ("$atIndex", [EvRecord(aRecord), EvString(sIndex)]) => recordAtIndex(aRecord, sIndex)
| ("$constructRecord", [EvArray(arrayOfPairs)]) => constructRecord(arrayOfPairs)
| ("$atIndex", [EvArray(aValueArray), EvArray([EvNumber(fIndex)])]) =>
arrayAtIndex(aValueArray, fIndex)
| ("$atIndex", [CTV.CtvRecord(dict), CTV.CtvArray([CTV.CtvString(sIndex)])]) => recordAtIndex(dict, sIndex)
| ("$atIndex", [obj, index]) => (CTV.showWithType(obj) ++ "??~~~~" ++ CTV.showWithType(index))->CTV.CtvString->Ok
| call => callMatjJs(call)
| ("$atIndex", [EvRecord(dict), EvArray([EvString(sIndex)])]) => recordAtIndex(dict, sIndex)
| ("$atIndex", [obj, index]) =>
(toStringWithType(obj) ++ "??~~~~" ++ toStringWithType(index))->EvString->Ok
| call => callMathJs(call)
}
}
/*
Lisp engine uses Result monad while reducing expressions
*/
let dispatch = (call: CTV.functionCall): result<codeTreeValue, reducerError> =>
let dispatch = (call: functionCall): result<expressionValue, errorValue> =>
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
Lib.dispatch((Js.String.make(fn), args), callInternal)
ExternalLibrary.dispatch((Js.String.make(fn), args), callInternal)
} catch {
| Js.Exn.Error(obj) =>
RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
| _ => RerrTodo("unhandled rescript exception")->Error
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error
| _ => RETodo("unhandled rescript exception")->Error
}

View File

@ -1,27 +0,0 @@
type reducerError =
| RerrFunctionExpected( string )
| RerrJs(option<string>, option<string>) // Javascript Exception
| RerrTodo(string) // To do
| RerrUnexecutedCode( string )
| RerrArrayIndexNotFound(string, int)
| RerrRecordPropertyNotFound(string, string)
let showError = (err) => switch err {
| RerrTodo( msg ) => `TODO: ${msg}`
| RerrJs( omsg, oname ) => {
let answer = "JS Exception:"
let answer = switch oname {
| Some(name) => `${answer} ${name}`
| _ => answer
}
let answer = switch omsg {
| Some(msg) => `${answer}: ${msg}`
| _ => answer
}
answer
}
| RerrArrayIndexNotFound(msg, index) => `${msg}: ${Js.String.make(index)}`
| RerrRecordPropertyNotFound(msg, index) => `${msg}: ${index}`
| RerrUnexecutedCode( codeString ) => `Unexecuted code remaining: ${codeString}`
| RerrFunctionExpected( msg ) => `Function expected: ${msg}`
}

View File

@ -0,0 +1,28 @@
type errorValue =
| REArrayIndexNotFound(string, int)
| REFunctionExpected(string)
| REJavaScriptExn(option<string>, option<string>) // Javascript Exception
| RERecordPropertyNotFound(string, string)
| RETodo(string) // To do
type t = errorValue
let errorToString = err =>
switch err {
| REArrayIndexNotFound(msg, index) => `${msg}: ${Js.String.make(index)}`
| REFunctionExpected(msg) => `Function expected: ${msg}`
| REJavaScriptExn(omsg, oname) => {
let answer = "JS Exception:"
let answer = switch oname {
| Some(name) => `${answer} ${name}`
| _ => answer
}
let answer = switch omsg {
| Some(msg) => `${answer}: ${msg}`
| _ => answer
}
answer
}
| RERecordPropertyNotFound(msg, index) => `${msg}: ${index}`
| RETodo(msg) => `TODO: ${msg}`
}

View File

@ -0,0 +1,91 @@
module BuiltIn = Reducer_Dispatch_BuiltIn
module ExpressionValue = ReducerInterface.ExpressionValue
module Extra = Reducer_Extra
module MathJs = Reducer_MathJs
module Result = Belt.Result
module T = Reducer_Expression_T
open Reducer_ErrorValue
type expression = T.expression
type expressionValue = ExpressionValue.expressionValue
type t = expression
/*
Shows the Lisp Code as text lisp code
*/
let rec toString = expression =>
switch expression {
| T.EList(aList) =>
`(${Belt.List.map(aList, aValue => toString(aValue))
->Extra.List.interperse(" ")
->Belt.List.toArray
->Js.String.concatMany("")})`
| EValue(aValue) => ExpressionValue.toString(aValue)
}
let toStringResult = codeResult =>
switch codeResult {
| Ok(a) => `Ok(${toString(a)})`
| Error(m) => `Error(${Js.String.make(m)})`
}
/*
Converts a MathJs code to Lisp Code
*/
let parse_ = (expr: string, parser, converter): result<t, errorValue> =>
expr->parser->Result.flatMap(node => converter(node))
let parse = (mathJsCode: string): result<t, errorValue> =>
mathJsCode->parse_(MathJs.Parse.parse, MathJs.ToExpression.fromNode)
module MapString = Belt.Map.String
type bindings = MapString.t<unit>
let defaultBindings: bindings = MapString.fromArray([])
// TODO Define bindings for function execution context
/*
After reducing each level of code tree, we have a value list to evaluate
*/
let reduceValueList = (valueList: list<expressionValue>): result<expressionValue, 'e> =>
switch valueList {
| list{EvSymbol(fName), ...args} => (fName, args->Belt.List.toArray)->BuiltIn.dispatch
| _ => valueList->Belt.List.toArray->ExpressionValue.EvArray->Ok
}
/*
Recursively evaluate/reduce the code tree
*/
let rec reduceExpression = (expression: t, bindings): result<expressionValue, 'e> =>
switch expression {
| T.EValue(value) => value->Ok
| T.EList(list) => {
let racc: result<list<expressionValue>, 'e> = list->Belt.List.reduceReverse(Ok(list{}), (
racc,
each: expression,
) =>
racc->Result.flatMap(acc => {
each
->reduceExpression(bindings)
->Result.flatMap(newNode => {
acc->Belt.List.add(newNode)->Ok
})
})
)
racc->Result.flatMap(acc => acc->reduceValueList)
}
}
let evalWBindingsExpression = (aExpression, bindings): result<expressionValue, 'e> =>
reduceExpression(aExpression, bindings)
/*
Evaluates MathJs code via Lisp using bindings and answers the result
*/
let evalWBindings = (codeText: string, bindings: bindings) => {
parse(codeText)->Result.flatMap(code => code->evalWBindingsExpression(bindings))
}
/*
Evaluates MathJs code via Lisp and answers the result
*/
let eval = (code: string) => evalWBindings(code, defaultBindings)

View File

@ -0,0 +1,28 @@
module Result = Belt.Result
module T = Reducer_Expression_T
type expression = T.expression
type expressionValue = ReducerInterface.ExpressionValue.expressionValue
type t = expression
let toString: T.expression => Js.String.t
let toStringResult: result<T.expression, 'a> => string
let parse: string => result<expression, Reducer_ErrorValue.t>
module MapString = Belt.Map.String
type bindings = MapString.t<unit>
let defaultBindings: bindings
let reduceValueList: list<expressionValue> => result<
expressionValue,
Reducer_ErrorValue.t,
>
let reduceExpression: (expression, 'a) => result<
expressionValue,
Reducer_ErrorValue.t,
>
let evalWBindingsExpression: (expression, 'a) => result<
expressionValue,
Reducer_ErrorValue.t,
>
let evalWBindings: (string, bindings) => Result.t<
expressionValue,
Reducer_ErrorValue.t,
>
let eval: string => Result.t<expressionValue, Reducer_ErrorValue.t>

View File

@ -0,0 +1,5 @@
open ReducerInterface.ExpressionValue
type rec expression =
| EList(list<expression>) // A list to map-reduce
| EValue(expressionValue) // Irreducible built-in value. Reducer should not know the internals. External libraries are responsible

View File

@ -1,2 +0,0 @@
module CodeTreeValue = Reducer_Extension_CodeTreeValue
module ReducerLibrary = Reducer_Extension_ReducerLibrary

View File

@ -1,59 +0,0 @@
/*
Irreducible values. Reducer does not know about those. Only used for external calls
This is a configuration to to make external calls of those types
*/
module AE = Reducer_Extra_Array
module Rerr = Reducer_Error
type rec codeTreeValue =
| CtvBool(bool)
| CtvNumber(float)
| CtvString(string)
| CtvSymbol(string)
| CtvArray(array<codeTreeValue>)
| CtvRecord(Js.Dict.t<codeTreeValue>)
type functionCall = (string, array<codeTreeValue>)
let rec show = aValue => switch aValue {
| CtvBool( aBool ) => Js.String.make( aBool )
| CtvNumber( aNumber ) => Js.String.make( aNumber )
| CtvString( aString ) => `'${aString}'`
| CtvSymbol( aString ) => `:${aString}`
| CtvArray( anArray ) => {
let args = anArray
-> Belt.Array.map(each => show(each))
-> AE.interperse(", ")
-> Js.String.concatMany("")
`[${args}]`}
| CtvRecord( aRecord ) => {
let pairs = aRecord
-> Js.Dict.entries
-> Belt.Array.map( ((eachKey, eachValue)) => `${eachKey}: ${show(eachValue)}` )
-> AE.interperse(", ")
-> Js.String.concatMany("")
`{${pairs}}`
}
}
let showWithType = aValue => switch aValue {
| CtvBool( _ ) => `Bool::${show(aValue)}`
| CtvNumber( _ ) => `Number::${show(aValue)}`
| CtvString( _ ) => `String::${show(aValue)}`
| CtvSymbol( _ ) => `Symbol::${show(aValue)}`
| CtvArray( _ ) => `Array::${show(aValue)}`
| CtvRecord( _ ) => `Record::${show(aValue)}`
}
let showArgs = (args: array<codeTreeValue>): string => {
args
-> Belt.Array.map(arg => arg->show)
-> AE.interperse(", ")
-> Js.String.concatMany("") }
let showFunctionCall = ((fn, args)): string => `${fn}(${ showArgs(args) })`
let showResult = (x) => switch x {
| Ok(a) => `Ok(${ show(a) })`
| Error(m) => `Error(${Rerr.showError(m)})`
}

View File

@ -1,7 +1,7 @@
/*
Insert seperator between the elements of an array
*/
module LE = Reducer_Extra_List
module ExtraList = Reducer_Extra_List
let interperse = (anArray, seperator) =>
anArray -> Belt.List.fromArray -> LE.interperse(seperator) -> Belt.List.toArray
anArray->Belt.List.fromArray->ExtraList.interperse(seperator)->Belt.List.toArray

View File

@ -1,8 +1,9 @@
/*
Insert seperator between the elements of a list
*/
let rec interperse = (aList, seperator) => switch aList {
let rec interperse = (aList, seperator) =>
switch aList {
| list{} => list{}
| list{a} => list{a}
| list{a, ...rest} => list{a, seperator, ...interperse(rest, seperator)}
}
}

View File

@ -1,8 +1,5 @@
module CTV = Reducer_Extension.CodeTreeValue
module Rerr = Reducer_Error
type codeTreeValue = CTV.codeTreeValue
type reducerError = Rerr.reducerError
open ReducerInterface.ExpressionValue
open Reducer_ErrorValue
external castBool: unit => bool = "%identity"
external castNumber: unit => float = "%identity"
@ -11,11 +8,11 @@ external castString: unit => string = "%identity"
/*
As JavaScript returns us any type, we need to type check and cast type propertype before using it
*/
let jsToCtv = (jsValue): result<codeTreeValue, reducerError> => {
let jsToEv = (jsValue): result<expressionValue, errorValue> => {
switch Js.typeof(jsValue) {
| "boolean" => jsValue -> castBool -> CTV.CtvBool -> Ok
| "number" => jsValue -> castNumber -> CTV.CtvNumber -> Ok
| "string" => jsValue -> castString -> CTV.CtvString -> Ok
| other => Rerr.RerrTodo(`Unhandled MathJs literal type: ${Js.String.make(other)}`) -> Error
| "boolean" => jsValue->castBool->EvBool->Ok
| "number" => jsValue->castNumber->EvNumber->Ok
| "string" => jsValue->castString->EvString->Ok
| other => RETodo(`Unhandled MathJs literal type: ${Js.String.make(other)}`)->Error
}
}

View File

@ -1,2 +1,3 @@
module Eval = Reducer_MathJs_Eval
module Parse = Reducer_MathJs_Parse
module ToExpression = Reducer_MathJs_ToExpression

View File

@ -1,16 +1,11 @@
module CTV = Reducer_Extension.CodeTreeValue
module JsG = Reducer_Js_Gate
module Rerr = Reducer_Error
type codeTreeValue = CTV.codeTreeValue
type reducerError = Rerr.reducerError
module JavaScript = Reducer_Js
open ReducerInterface.ExpressionValue
open Reducer_ErrorValue
@module("mathjs") external dummy_: string => unit = "evaluate"
let dummy1_ = dummy_ //Deceive the compiler to make the import although we wont make a call from rescript. Otherwise the optimizer deletes the import
type answer = {
"value": unit
}
type answer = {"value": unit}
/*
The result has to be delivered in an object so that we can type cast.
@ -22,12 +17,11 @@ let eval__ = %raw(`function (expr) { return {value: Mathjs.evaluate(expr)}; }`)
/*
Call MathJs evaluate and return as a variant
*/
let eval = (expr: string): result<codeTreeValue, reducerError> => {
let eval = (expr: string): result<expressionValue, errorValue> => {
try {
let answer = eval__(expr)
answer["value"]->JsG.jsToCtv
answer["value"]->JavaScript.Gate.jsToEv
} catch {
| Js.Exn.Error(obj) =>
RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error
}
}

View File

@ -2,63 +2,27 @@
MathJs Nodes
We make MathJs Nodes strong-typed
*/
module AE = Reducer_Extra_Array
module JsG = Reducer_Js_Gate
module Rerr = Reducer_Error
module Extra = Reducer_Extra
open Reducer_ErrorValue
type reducerError = Rerr.reducerError
type node = {
"type": string,
"isNode": bool,
"comment": string
}
type arrayNode = {
...node,
"items": array<node>
}
type node = {"type": string, "isNode": bool, "comment": string}
type arrayNode = {...node, "items": array<node>}
//assignmentNode
//blockNode
//conditionalNode
type constantNode = {
...node,
"value": unit
}
type constantNode = {...node, "value": unit}
//functionAssignmentNode
type functionNode = {
...node,
"fn": string,
"args": array<node>
}
type indexNode = {
...node,
"dimensions": array<node>
}
type objectNode = {
...node,
"properties": Js.Dict.t<node>
}
type accessorNode = {
...node,
"object": node,
"index": indexNode
}
type operatorNode = {
...functionNode,
"op": string,
}
type functionNode = {...node, "fn": string, "args": array<node>}
type indexNode = {...node, "dimensions": array<node>}
type objectNode = {...node, "properties": Js.Dict.t<node>}
type accessorNode = {...node, "object": node, "index": indexNode}
type operatorNode = {...functionNode, "op": string}
//parenthesisNode
type parenthesisNode = {
...node,
"content": node
}
type parenthesisNode = {...node, "content": node}
//rangeNode
//relationalNode
type symbolNode = {
...node,
"name": string
}
type symbolNode = {...node, "name": string}
external castAccessorNode: node => accessorNode = "%identity"
external castArrayNode: node => arrayNode = "%identity"
@ -76,15 +40,14 @@ external castSymbolNode: node => symbolNode = "%identity"
*/
@module("mathjs") external parse__: string => node = "parse"
let parse = (expr: string): result<node, reducerError> =>
let parse = (expr: string): result<node, errorValue> =>
try {
Ok(parse__(expr))
} catch {
| Js.Exn.Error(obj) =>
RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error
}
type mjNode =
type mathJsNode =
| MjAccessorNode(accessorNode)
| MjArrayNode(arrayNode)
| MjConstantNode(constantNode)
@ -95,64 +58,66 @@ type mjNode =
| MjParenthesisNode(parenthesisNode)
| MjSymbolNode(symbolNode)
let castNodeType = (node: node) => switch node["type"] {
| "AccessorNode" => node -> castAccessorNode -> MjAccessorNode -> Ok
| "ArrayNode" => node -> castArrayNode -> MjArrayNode -> Ok
| "ConstantNode" => node -> castConstantNode -> MjConstantNode -> Ok
| "FunctionNode" => node -> castFunctionNode -> MjFunctionNode -> Ok
| "IndexNode" => node -> castIndexNode -> MjIndexNode -> Ok
| "ObjectNode" => node -> castObjectNode -> MjObjectNode -> Ok
| "OperatorNode" => node -> castOperatorNode -> MjOperatorNode -> Ok
| "ParenthesisNode" => node -> castParenthesisNode -> MjParenthesisNode -> Ok
| "SymbolNode" => node -> castSymbolNode -> MjSymbolNode -> Ok
| _ => Rerr.RerrTodo(`Argg, unhandled MathJsNode: ${node["type"]}`)-> Error
}
let castNodeType = (node: node) =>
switch node["type"] {
| "AccessorNode" => node->castAccessorNode->MjAccessorNode->Ok
| "ArrayNode" => node->castArrayNode->MjArrayNode->Ok
| "ConstantNode" => node->castConstantNode->MjConstantNode->Ok
| "FunctionNode" => node->castFunctionNode->MjFunctionNode->Ok
| "IndexNode" => node->castIndexNode->MjIndexNode->Ok
| "ObjectNode" => node->castObjectNode->MjObjectNode->Ok
| "OperatorNode" => node->castOperatorNode->MjOperatorNode->Ok
| "ParenthesisNode" => node->castParenthesisNode->MjParenthesisNode->Ok
| "SymbolNode" => node->castSymbolNode->MjSymbolNode->Ok
| _ => RETodo(`Argg, unhandled MathJsNode: ${node["type"]}`)->Error
}
let rec show = (mjNode: mjNode): string => {
let showValue = (a: 'a): string => if (Js.typeof(a) == "string") {
let rec toString = (mathJsNode: mathJsNode): string => {
let toStringValue = (a: 'a): string =>
if Js.typeof(a) == "string" {
`'${Js.String.make(a)}'`
} else {
Js.String.make(a)
}
let showNodeArray = (nodeArray: array<node>): string =>
let toStringNodeArray = (nodeArray: array<node>): string =>
nodeArray
-> Belt.Array.map( a => showMathJsNode(a) )
-> AE.interperse(", ")
-> Js.String.concatMany("")
->Belt.Array.map(a => toStringMathJsNode(a))
->Extra.Array.interperse(", ")
->Js.String.concatMany("")
let showFunctionNode = (fnode: functionNode): string =>
`${fnode["fn"]}(${fnode["args"]->showNodeArray})`
let toStringFunctionNode = (fnode: functionNode): string =>
`${fnode["fn"]}(${fnode["args"]->toStringNodeArray})`
let showObjectEntry = ( (key: string, value: node) ): string =>
`${key}: ${value->showMathJsNode}`
let toStringObjectEntry = ((key: string, value: node)): string => `${key}: ${value->toStringMathJsNode}`
let showObjectNode = (oNode: objectNode): string =>
`{${ oNode["properties"]
let toStringObjectNode = (oNode: objectNode): string =>
`{${oNode["properties"]
->Js.Dict.entries
->Belt.Array.map(entry=>entry->showObjectEntry)
->AE.interperse(", ")->Js.String.concatMany("")
}}`
->Belt.Array.map(entry => entry->toStringObjectEntry)
->Extra.Array.interperse(", ")
->Js.String.concatMany("")}}`
let showIndexNode = (iNode: indexNode): string =>
let toStringIndexNode = (iNode: indexNode): string =>
iNode["dimensions"]
-> Belt.Array.map( each => `${showResult(each->castNodeType)}`)
-> Js.String.concatMany("")
->Belt.Array.map(each => toStringResult(each->castNodeType))
->Js.String.concatMany("")
switch mjNode {
| MjAccessorNode(aNode) => `${aNode["object"]->showMathJsNode}[${aNode["index"]->showIndexNode}]`
| MjArrayNode(aNode) => `[${aNode["items"]->showNodeArray}]`
| MjConstantNode(cNode) => cNode["value"]->showValue
| MjFunctionNode(fNode) => fNode -> showFunctionNode
| MjIndexNode(iNode) => iNode -> showIndexNode
| MjObjectNode(oNode) => oNode -> showObjectNode
| MjOperatorNode(opNode) => opNode -> castOperatorNodeToFunctionNode -> showFunctionNode
| MjParenthesisNode(pNode) => `(${showMathJsNode(pNode["content"])})`
switch mathJsNode {
| MjAccessorNode(aNode) => `${aNode["object"]->toStringMathJsNode}[${aNode["index"]->toStringIndexNode}]`
| MjArrayNode(aNode) => `[${aNode["items"]->toStringNodeArray}]`
| MjConstantNode(cNode) => cNode["value"]->toStringValue
| MjFunctionNode(fNode) => fNode->toStringFunctionNode
| MjIndexNode(iNode) => iNode->toStringIndexNode
| MjObjectNode(oNode) => oNode->toStringObjectNode
| MjOperatorNode(opNode) => opNode->castOperatorNodeToFunctionNode->toStringFunctionNode
| MjParenthesisNode(pNode) => `(${toStringMathJsNode(pNode["content"])})`
| MjSymbolNode(sNode) => sNode["name"]
}}
and let showResult = (rmjnode: result<mjNode, reducerError>): string =>
switch rmjnode {
| Error(e) => Rerr.showError(e)
| Ok(mjNode) => show(mjNode)
}
and let showMathJsNode = (node) => node -> castNodeType -> showResult
}
and toStringResult = (rMathJsNode: result<mathJsNode, errorValue>): string =>
switch rMathJsNode {
| Error(e) => errorToString(e)
| Ok(mathJsNode) => toString(mathJsNode)
}
and toStringMathJsNode = node => node->castNodeType->toStringResult

View File

@ -1,99 +0,0 @@
module CTT = Reducer_CodeTree_T
module CTV = Reducer_Extension.CodeTreeValue
module JsG = Reducer_Js_Gate
module MJ = Reducer_MathJs_Parse
module Rerr = Reducer_Error
module Result = Belt.Result
type codeTree = CTT.codeTree
type codeTreeValue = CTV.codeTreeValue
type reducerError = Rerr.reducerError
let rec fromNode =
(mjnode: MJ.node): result<codeTree, reducerError> =>
MJ.castNodeType(mjnode) -> Result.flatMap(typedMjNode => {
let fromNodeList = (nodeList: list<MJ.node>): result<list<codeTree>, 'e> =>
Belt.List.reduceReverse(nodeList, Ok(list{}), (racc, currNode) =>
racc -> Result.flatMap(
acc => fromNode(currNode) -> Result.map(
currCode => list{currCode, ...acc})))
let caseFunctionNode = (fNode) => {
let fn = fNode["fn"] -> CTV.CtvSymbol -> CTT.CtValue
let lispArgs = fNode["args"] -> Belt.List.fromArray -> fromNodeList
lispArgs -> Result.map(
argsCode => list{fn, ...argsCode} -> CTT.CtList )
}
let caseObjectNode = oNode => {
let fromObjectEntries = ( entryList ) => {
let rargs = Belt.List.reduceReverse(
entryList,
Ok(list{}),
(racc, (key: string, value: MJ.node))
=>
racc
-> Result.flatMap( acc =>
fromNode(value) -> Result.map(valueCodeTree => {
let entryCode = list{key->CTV.CtvString->CTT.CtValue, valueCodeTree}
-> CTT.CtList
list{entryCode, ...acc}})))
let lispName = "$constructRecord" -> CTV.CtvSymbol -> CTT.CtValue
rargs -> Result.map(args => list{lispName, CTT.CtList(args)} -> CTT.CtList)
}
oNode["properties"]
-> Js.Dict.entries
-> Belt.List.fromArray
-> fromObjectEntries
}
let caseIndexNode = iNode => {
let rpropertyCodeList = Belt.List.reduceReverse(
iNode["dimensions"]->Belt.List.fromArray,
Ok(list{}),
(racc, currentPropertyMjNode)
=>
racc -> Result.flatMap( acc =>
fromNode(currentPropertyMjNode)
-> Result.map( propertyCode =>
list{ propertyCode, ...acc} )
)
)
rpropertyCodeList -> Result.map(
propertyCodeList => CTT.CtList(propertyCodeList))
}
let caseAccessorNode = ( objectNode, indexNode ) => {
let fn = "$atIndex" -> CTV.CtvSymbol -> CTT.CtValue
caseIndexNode( indexNode ) -> Result.flatMap(
indexCode => {
fromNode( objectNode ) -> Result.map(
objectCode => list{fn, objectCode, indexCode} -> CTT.CtList )
}
)
}
switch typedMjNode {
| MjArrayNode(aNode) =>
aNode["items"]
-> Belt.List.fromArray
-> fromNodeList
-> Result.map(list => CTT.CtList(list))
| MjConstantNode(cNode) =>
cNode["value"]-> JsG.jsToCtv -> Result.map( v => v->CTT.CtValue)
| MjFunctionNode(fNode) => fNode
-> caseFunctionNode
| MjOperatorNode(opNode) => opNode
-> MJ.castOperatorNodeToFunctionNode -> caseFunctionNode
| MjParenthesisNode(pNode) => pNode["content"] -> fromNode
| MjAccessorNode(aNode) => caseAccessorNode(aNode["object"], aNode["index"])
| MjObjectNode(oNode) => caseObjectNode(oNode)
| MjSymbolNode(sNode) =>
sNode["name"]-> CTV.CtvSymbol -> CTT.CtValue -> Ok
| MjIndexNode(iNode) => caseIndexNode(iNode)
}})

View File

@ -0,0 +1,86 @@
module ErrorValue = Reducer_ErrorValue
module ExpressionValue = ReducerInterface.ExpressionValue
module ExtressionT = Reducer_Expression_T
module JavaScript = Reducer_Js
module Parse = Reducer_MathJs_Parse
module Result = Belt.Result
type expression = ExtressionT.expression
type expressionValue = ExpressionValue.expressionValue
type errorValue = ErrorValue.errorValue
let rec fromNode = (mathJsNode: Parse.node): result<expression, errorValue> =>
Parse.castNodeType(mathJsNode)->Result.flatMap(typedMathJsNode => {
let fromNodeList = (nodeList: list<Parse.node>): result<list<expression>, 'e> =>
Belt.List.reduceReverse(nodeList, Ok(list{}), (racc, currNode) =>
racc->Result.flatMap(acc =>
fromNode(currNode)->Result.map(currCode => list{currCode, ...acc})
)
)
let castFunctionNode = fNode => {
let fn = fNode["fn"]->ExpressionValue.EvSymbol->ExtressionT.EValue
let lispArgs = fNode["args"]->Belt.List.fromArray->fromNodeList
lispArgs->Result.map(argsCode => list{fn, ...argsCode}->ExtressionT.EList)
}
let caseObjectNode = oNode => {
let fromObjectEntries = entryList => {
let rargs = Belt.List.reduceReverse(entryList, Ok(list{}), (
racc,
(key: string, value: Parse.node),
) =>
racc->Result.flatMap(acc =>
fromNode(value)->Result.map(valueExpression => {
let entryCode =
list{
key->ExpressionValue.EvString->ExtressionT.EValue,
valueExpression,
}->ExtressionT.EList
list{entryCode, ...acc}
})
)
)
let lispName = "$constructRecord"->ExpressionValue.EvSymbol->ExtressionT.EValue
rargs->Result.map(args => list{lispName, ExtressionT.EList(args)}->ExtressionT.EList)
}
oNode["properties"]->Js.Dict.entries->Belt.List.fromArray->fromObjectEntries
}
let caseIndexNode = iNode => {
let rpropertyCodeList = Belt.List.reduceReverse(
iNode["dimensions"]->Belt.List.fromArray,
Ok(list{}),
(racc, currentPropertyMathJsNode) =>
racc->Result.flatMap(acc =>
fromNode(currentPropertyMathJsNode)->Result.map(propertyCode => list{propertyCode, ...acc})
),
)
rpropertyCodeList->Result.map(propertyCodeList => ExtressionT.EList(propertyCodeList))
}
let caseAccessorNode = (objectNode, indexNode) => {
let fn = "$atIndex"->ExpressionValue.EvSymbol->ExtressionT.EValue
caseIndexNode(indexNode)->Result.flatMap(indexCode => {
fromNode(objectNode)->Result.map(objectCode =>
list{fn, objectCode, indexCode}->ExtressionT.EList
)
})
}
switch typedMathJsNode {
| MjArrayNode(aNode) =>
aNode["items"]->Belt.List.fromArray->fromNodeList->Result.map(list => ExtressionT.EList(list))
| MjConstantNode(cNode) =>
cNode["value"]->JavaScript.Gate.jsToEv->Result.map(v => v->ExtressionT.EValue)
| MjFunctionNode(fNode) => fNode->castFunctionNode
| MjOperatorNode(opNode) => opNode->Parse.castOperatorNodeToFunctionNode->castFunctionNode
| MjParenthesisNode(pNode) => pNode["content"]->fromNode
| MjAccessorNode(aNode) => caseAccessorNode(aNode["object"], aNode["index"])
| MjObjectNode(oNode) => caseObjectNode(oNode)
| MjSymbolNode(sNode) => sNode["name"]->ExpressionValue.EvSymbol->ExtressionT.EValue->Ok
| MjIndexNode(iNode) => caseIndexNode(iNode)
}
})

View File

@ -0,0 +1,2 @@
module ExpressionValue = ReducerInterface_ExpressionValue
module ExternalLibrary = ReducerInterface_ExternalLibrary

View File

@ -0,0 +1,60 @@
/*
Irreducible values. Reducer does not know about those. Only used for external calls
This is a configuration to to make external calls of those types
*/
module Extra_Array = Reducer_Extra_Array
module ErrorValue = Reducer_ErrorValue
type rec expressionValue =
| EvBool(bool)
| EvNumber(float)
| EvString(string)
| EvSymbol(string)
| EvArray(array<expressionValue>)
| EvRecord(Js.Dict.t<expressionValue>)
type functionCall = (string, array<expressionValue>)
let rec toString = aValue =>
switch aValue {
| EvBool(aBool) => Js.String.make(aBool)
| EvNumber(aNumber) => Js.String.make(aNumber)
| EvString(aString) => `'${aString}'`
| EvSymbol(aString) => `:${aString}`
| EvArray(anArray) => {
let args =
anArray->Belt.Array.map(each => toString(each))->Extra_Array.interperse(", ")->Js.String.concatMany("")
`[${args}]`
}
| EvRecord(aRecord) => {
let pairs =
aRecord
->Js.Dict.entries
->Belt.Array.map(((eachKey, eachValue)) => `${eachKey}: ${toString(eachValue)}`)
->Extra_Array.interperse(", ")
->Js.String.concatMany("")
`{${pairs}}`
}
}
let toStringWithType = aValue =>
switch aValue {
| EvBool(_) => `Bool::${toString(aValue)}`
| EvNumber(_) => `Number::${toString(aValue)}`
| EvString(_) => `String::${toString(aValue)}`
| EvSymbol(_) => `Symbol::${toString(aValue)}`
| EvArray(_) => `Array::${toString(aValue)}`
| EvRecord(_) => `Record::${toString(aValue)}`
}
let argsToString = (args: array<expressionValue>): string => {
args->Belt.Array.map(arg => arg->toString)->Extra_Array.interperse(", ")->Js.String.concatMany("")
}
let toStringFunctionCall = ((fn, args)): string => `${fn}(${argsToString(args)})`
let toStringResult = x =>
switch x {
| Ok(a) => `Ok(${toString(a)})`
| Error(m) => `Error(${ErrorValue.errorToString(m)})`
}

View File

@ -1,24 +1,25 @@
module CTV = Reducer_Extension_CodeTreeValue
module ExpressionValue = ReducerInterface_ExpressionValue
type codeTreeValue = CTV.codeTreeValue
type expressionValue = ExpressionValue.expressionValue
module Sample = { // In real life real libraries should be somewhere else
module Sample = {
// In real life real libraries should be somewhere else
/*
For an example of mapping polymorphic custom functions. To be deleted after real integration
*/
let customAdd = (a:float, b:float):float => {a +. b}
let customAdd = (a: float, b: float): float => {a +. b}
}
/*
Map external calls of Reducer
*/
let dispatch = (call: CTV.functionCall, chain): result<codeTreeValue, 'e> => switch call {
let dispatch = (call: ExpressionValue.functionCall, chain): result<expressionValue, 'e> =>
switch call {
| ("add", [EvNumber(a), EvNumber(b)]) => Sample.customAdd(a, b)->EvNumber->Ok
| ("add", [CtvNumber(a), CtvNumber(b)]) => Sample.customAdd(a, b) -> CtvNumber -> Ok
| call => chain(call)
| call => chain(call)
/*
/*
If your dispatch is too big you can divide it into smaller dispatches and pass the call so that it gets called finally.
The final chain(call) invokes the builtin default functions of the interpreter.
@ -34,4 +35,4 @@ Remember from the users point of view, there are no different modules:
// "doSth( constructorType2 )"
doSth gets dispatched to the correct module because of the type signature. You get function and operator abstraction for free. You don't need to combine different implementations into one type. That would be duplicating the repsonsibility of the dispatcher.
*/
}
}