Merge pull request #107 from umuro/reducer-dev
Reducer dev 2 (opened on behalf of Umur)
This commit is contained in:
Quinn
GitHub
commit
8cbfeec81c
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,12 +1,10 @@
|
|||
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
|
||||
|
|
@ -21,5 +19,7 @@ describe("builtin", () => {
|
|||
|
||||
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)")
|
||||
)
|
||||
})
|
||||
|
|
|
|||
|
|
@ -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')")
|
||||
)
|
||||
})
|
||||
|
|
@ -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")),
|
||||
)
|
||||
)
|
||||
})
|
||||
|
|
|
|||
|
|
@ -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'"))
|
||||
|
|
@ -33,8 +31,7 @@ describe("MathJs parse", () => {
|
|||
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]"))
|
||||
})
|
||||
|
|
@ -51,5 +48,4 @@ describe("MathJs parse", () => {
|
|||
describe("if statement", () => {
|
||||
Skip.test("define", () => expectParseToBe("if (true) { 1 } else { 0 }", "???"))
|
||||
})
|
||||
|
||||
})
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -3,11 +3,11 @@ 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)"))
|
||||
|
|
@ -23,14 +23,19 @@ describe("reducer using mathjs parse", () => {
|
|||
// [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("['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')))",
|
||||
)
|
||||
)
|
||||
})
|
||||
})
|
||||
|
||||
|
|
@ -54,23 +59,23 @@ describe("eval", () => {
|
|||
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)")
|
||||
)
|
||||
})
|
||||
|
|
|
|||
|
|
@ -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')")
|
||||
)
|
||||
})
|
||||
|
|
@ -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"
|
||||
},
|
||||
|
|
|
|||
|
|
@ -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)"))
|
||||
```
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
8
packages/squiggle-lang/src/rescript/Reducer/Reducer.resi
Normal file
8
packages/squiggle-lang/src/rescript/Reducer/Reducer.resi
Normal 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>
|
||||
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
| 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)) {
|
||||
let recordAtIndex = (dict: Js.Dict.t<expressionValue>, sIndex) =>
|
||||
switch Js.Dict.get(dict, sIndex) {
|
||||
| Some(value) => value->Ok
|
||||
| None => Rerr.RerrRecordPropertyNotFound("Record property not found", sIndex) -> Error
|
||||
| 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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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}`
|
||||
}
|
||||
|
|
@ -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}`
|
||||
}
|
||||
|
|
@ -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)
|
||||
|
|
@ -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>
|
||||
|
|
@ -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
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
module CodeTreeValue = Reducer_Extension_CodeTreeValue
|
||||
module ReducerLibrary = Reducer_Extension_ReducerLibrary
|
||||
|
|
@ -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)})`
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
/*
|
||||
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)}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,2 +1,3 @@
|
|||
module Eval = Reducer_MathJs_Eval
|
||||
module Parse = Reducer_MathJs_Parse
|
||||
module ToExpression = Reducer_MathJs_ToExpression
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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,7 +58,8 @@ type mjNode =
|
|||
| MjParenthesisNode(parenthesisNode)
|
||||
| MjSymbolNode(symbolNode)
|
||||
|
||||
let castNodeType = (node: node) => switch node["type"] {
|
||||
let castNodeType = (node: node) =>
|
||||
switch node["type"] {
|
||||
| "AccessorNode" => node->castAccessorNode->MjAccessorNode->Ok
|
||||
| "ArrayNode" => node->castArrayNode->MjArrayNode->Ok
|
||||
| "ConstantNode" => node->castConstantNode->MjConstantNode->Ok
|
||||
|
|
@ -105,54 +69,55 @@ let castNodeType = (node: node) => switch node["type"] {
|
|||
| "OperatorNode" => node->castOperatorNode->MjOperatorNode->Ok
|
||||
| "ParenthesisNode" => node->castParenthesisNode->MjParenthesisNode->Ok
|
||||
| "SymbolNode" => node->castSymbolNode->MjSymbolNode->Ok
|
||||
| _ => Rerr.RerrTodo(`Argg, unhandled MathJsNode: ${node["type"]}`)-> Error
|
||||
| _ => 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(", ")
|
||||
->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 =>
|
||||
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)}`)
|
||||
->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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
}})
|
||||
|
|
@ -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)
|
||||
}
|
||||
})
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
module ExpressionValue = ReducerInterface_ExpressionValue
|
||||
module ExternalLibrary = ReducerInterface_ExternalLibrary
|
||||
|
|
@ -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)})`
|
||||
}
|
||||
|
|
@ -1,8 +1,9 @@
|
|||
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
|
||||
*/
|
||||
|
|
@ -12,9 +13,9 @@ module Sample = { // In real life real libraries should be somewhere else
|
|||
/*
|
||||
Map external calls of Reducer
|
||||
*/
|
||||
let dispatch = (call: CTV.functionCall, chain): result<codeTreeValue, 'e> => switch call {
|
||||
|
||||
| ("add", [CtvNumber(a), CtvNumber(b)]) => Sample.customAdd(a, b) -> CtvNumber -> Ok
|
||||
let dispatch = (call: ExpressionValue.functionCall, chain): result<expressionValue, 'e> =>
|
||||
switch call {
|
||||
| ("add", [EvNumber(a), EvNumber(b)]) => Sample.customAdd(a, b)->EvNumber->Ok
|
||||
|
||||
| call => chain(call)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user