Reducer

packages/squiggle-lang/__tests__/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltIn_test.res

@@ -0,0 +1,25 @@
+module CT = Reducer.CodeTree
+module CTV = Reducer.Extension.CodeTreeValue
+module JsG = Reducer.Js.Gate
+
+open Jest
+open Expect
+
+let expectEvalToBe = (expr: string, answer: string) =>
+  Reducer.eval(expr) -> CTV.showResult -> 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')"))
+})
+
+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)"))
+})

packages/squiggle-lang/__tests__/Reducer/Reducer_Extension/ReducerExtension_CodeTreeValue_test.res

@@ -0,0 +1,15 @@
+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')")
+  )
+})

packages/squiggle-lang/__tests__/Reducer/Reducer_MathJs/Reducer_MathJsEval_test.res

@@ -0,0 +1,30 @@
+module CTV = Reducer.Extension.CodeTreeValue
+module ME = Reducer.MathJs.Eval
+module Rerr = Reducer.Error
+
+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))))
+})
+
+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 answer type", () => expect(ME.eval("1+1i"))
+  -> toEqual(Error(Rerr.RerrTodo("Unhandled MathJs literal type: object"))))
+})

packages/squiggle-lang/__tests__/Reducer/Reducer_MathJs/Reducer_MathJsParse_test.res

@@ -0,0 +1,55 @@
+module MJ=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)
+
+describe("MathJs parse", () => {
+
+  describe("literals operators paranthesis", () => {
+    test("1", () => expectParseToBe("1", "1"))
+    test("'hello'", () => expectParseToBe("'hello'", "'hello'"))
+    test("true", () => expectParseToBe("true", "true"))
+    test("1+2", () => expectParseToBe("1+2", "add(1, 2)"))
+    test("add(1,2)", () => expectParseToBe("add(1,2)", "add(1, 2)"))
+    test("(1)", () => expectParseToBe("(1)", "(1)"))
+    test("(1+2)", () => expectParseToBe("(1+2)", "(add(1, 2))"))
+  })
+
+  describe( "variables", () => {
+    Skip.test("define", () => expectParseToBe("x = 1", "???"))
+    Skip.test("use", () => expectParseToBe("x", "???"))
+  })
+
+  describe( "functions", () => {
+    Skip.test("define", () => expectParseToBe("identity(x) = x", "???"))
+    Skip.test("use", () => expectParseToBe("identity(x)", "???"))
+  })
+
+  describe( "arrays", () => {
+    test("empty", () => expectParseToBe("[]", "[]"))
+    test("define", () => expectParseToBe("[0, 1, 2]", "[0, 1, 2]"))
+    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", () => {
+    test("define", () => expectParseToBe("{a: 1, b: 2}", "{a: 1, b: 2}"))
+    test("use", () => expectParseToBe("record.property", "record['property']"))
+  })
+
+  describe( "comments", () => {
+    Skip.test("define", () => expectParseToBe("# This is a comment", "???"))
+  })
+
+  describe( "if statement", () => {
+    Skip.test("define", () => expectParseToBe("if (true) { 1 } else { 0 }", "???"))
+  })
+
+})

packages/squiggle-lang/__tests__/Reducer/Reducer_TestHelpers.res

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

packages/squiggle-lang/__tests__/Reducer/Reducer_test.res

@@ -0,0 +1,77 @@
+open Jest
+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
+  // Reducer.parse is called by Reducer.eval
+  // See https://mathjs.org/docs/expressions/syntax.html
+  // See https://mathjs.org/docs/reference/functions.html
+
+  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)))"))
+  })
+  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("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("use", () =>
+      expectParseToBe("{a: 1, b: 2}.a", "Ok((:$atIndex (:$constructRecord (('a' 1) ('b' 2))) ('a')))"))
+  })
+})
+
+describe("eval", () => {
+  // All MathJs operators and functions are builtin for string, float and boolean
+  // .e.g + - / * > >= < <= == /= not and or
+  // 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)"))
+    // TODO more built ins
+  })
+  describe("arrays", () => {
+    //Note. () is a empty list in Lisp
+    // The only builtin structure in Lisp is list
+    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)"))
+  })
+  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)"))
+  })
+})
+
+describe("test exceptions", () => {
+  test("javascript exception", () =>
+    expectEvalToBe( "jsraise('div by 0')", "Error(JS Exception: Error: 'div by 0')"))
+
+  test("rescript exception", () =>
+    expectEvalToBe( "resraise()", "Error(TODO: unhandled rescript exception)"))
+})

packages/squiggle-lang/src/rescript/Reducer/ReadMe.md

@@ -0,0 +1,15 @@
+To interface your library there only 2 files to be modified:
+- Reducer/Reducer_Extension/Reducer_Extension_CodeTreeValue.res
+
+  This is where your additional types are referred for the dispatcher.
+
+- Reducer/Reducer_Extension/Reducer_ReducerLibrary.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)"))
+```

packages/squiggle-lang/src/rescript/Reducer/Reducer.res

@@ -0,0 +1,10 @@
+module CodeTree = Reducer_CodeTree
+module Dispatch = Reducer_Dispatch
+module Error = Reducer_Error
+module Extension = Reducer_Extension
+module Js = Reducer_Js
+module Etra = Reducer_Extra
+module MathJs = Reducer_MathJs
+
+let eval = CodeTree.eval
+let parse = CodeTree.parse

packages/squiggle-lang/src/rescript/Reducer/Reducer_CodeTree/Reducer_CodeTree.res

@@ -0,0 +1,91 @@
+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)

packages/squiggle-lang/src/rescript/Reducer/Reducer_CodeTree/Reducer_CodeTree_T.res

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

packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch.res

@@ -0,0 +1 @@
+module Builtin = Reducer_Dispatch_BuiltIn

packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltIn.res

@@ -0,0 +1,72 @@
+module CTV = Reducer_Extension.CodeTreeValue
+module Lib = Reducer_Extension.ReducerLibrary
+module ME = Reducer_MathJs.Eval
+module Rerr = Reducer_Error
+/*
+  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> =>
+    switch call {
+      | ("jsraise", [msg]) => Js.Exn.raiseError(CTV.show(msg)) // For Tests
+      | ("resraise", _) => raise(TestRescriptException) // For Tests
+      | call => call->CTV.showFunctionCall-> ME.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
+  }
+
+  let arrayAtIndex = (aValueArray: array<codeTreeValue>, 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
+    }
+
+  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
+    }
+
+  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)])])  =>
+    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)
+  }
+
+}
+
+/*
+  Lisp engine uses Result monad while reducing expressions
+*/
+let dispatch = (call: CTV.functionCall): result<codeTreeValue, reducerError> =>
+  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)
+  } catch {
+  | Js.Exn.Error(obj) =>
+    RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
+  | _ => RerrTodo("unhandled rescript exception")->Error
+  }

packages/squiggle-lang/src/rescript/Reducer/Reducer_Error.res

@@ -0,0 +1,27 @@
+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}`
+  }

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extension/Reducer_Extension.res

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

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extension/Reducer_Extension_CodeTreeValue.res

@@ -0,0 +1,59 @@
+/*
+  Irreducable 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)})`
+}

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extension/Reducer_Extension_ReducerLibrary.res

@@ -0,0 +1,37 @@
+module CTV = Reducer_Extension_CodeTreeValue
+
+type codeTreeValue = CTV.codeTreeValue
+
+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}
+}
+
+/*
+  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
+
+|  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.
+
+Via chain(call), all MathJs operators and functions are available for string, number , boolean, array and record
+ .e.g + - / * > >= < <= == /= not and or sin cos log ln concat, etc.
+
+// See https://mathjs.org/docs/expressions/syntax.html
+// See https://mathjs.org/docs/reference/functions.html
+
+Remember from the users point of view, there are no different modules:
+// "doSth( constructorType1 )"
+// "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.
+*/
+}

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extra/Reducer_Extra.res

@@ -0,0 +1,2 @@
+module Array = Reducer_Extra_Array
+module List = Reducer_Extra_List

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extra/Reducer_Extra_Array.res

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

packages/squiggle-lang/src/rescript/Reducer/Reducer_Extra/Reducer_Extra_List.res

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

packages/squiggle-lang/src/rescript/Reducer/Reducer_Js/Reducer_Js.res

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

packages/squiggle-lang/src/rescript/Reducer/Reducer_Js/Reducer_Js_Gate.res

@@ -0,0 +1,21 @@
+module CTV = Reducer_Extension.CodeTreeValue
+module Rerr = Reducer_Error
+
+type codeTreeValue = CTV.codeTreeValue
+type reducerError = Rerr.reducerError
+
+external castBool: unit => bool = "%identity"
+external castNumber: unit => float = "%identity"
+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> => {
+  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
+  }
+}

packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs.res

@@ -0,0 +1,2 @@
+module Eval = Reducer_MathJs_Eval
+module Parse = Reducer_MathJs_Parse

packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs_Eval.res

@@ -0,0 +1,33 @@
+module CTV = Reducer_Extension.CodeTreeValue
+module JsG = Reducer_Js_Gate
+module Rerr = Reducer_Error
+
+type codeTreeValue = CTV.codeTreeValue
+type reducerError = Rerr.reducerError
+
+@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
+}
+
+/*
+ The result has to be delivered in an object so that we can type cast.
+ Rescript cannot type cast on basic values passed on their own.
+ This is why we call evalua inside Javascript and wrap the result in an Object
+ */
+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> => {
+  try {
+  let answer = eval__(expr)
+  answer["value"]->JsG.jsToCtv
+  } catch {
+  | Js.Exn.Error(obj) =>
+    RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
+  }
+}

packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs_Parse.res

@@ -0,0 +1,158 @@
+/*
+  MathJs Nodes
+  We make MathJs Nodes strong-typed
+*/
+module AE = Reducer_Extra_Array
+module JsG = Reducer_Js_Gate
+module Rerr = Reducer_Error
+
+type reducerError = Rerr.reducerError
+
+type rec node = {
+  "type": string,
+  "isNode": bool,
+  "comment": string
+}
+type arrayNode = {
+  ...node,
+  "items": array<node>
+}
+//assignmentNode
+//blockNode
+//conditionalNode
+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,
+}
+
+//parenthesisNode
+type parenthesisNode = {
+  ...node,
+  "content": node
+}
+//rangeNode
+//relationalNode
+type symbolNode = {
+  ...node,
+  "name": string
+}
+
+external castAccessorNode: node => accessorNode = "%identity"
+external castArrayNode: node => arrayNode = "%identity"
+external castConstantNode: node => constantNode = "%identity"
+external castFunctionNode: node => functionNode = "%identity"
+external castIndexNode: node => indexNode = "%identity"
+external castObjectNode: node => objectNode = "%identity"
+external castOperatorNode: node => operatorNode = "%identity"
+external castOperatorNodeToFunctionNode: operatorNode => functionNode = "%identity"
+external castParenthesisNode: node => parenthesisNode = "%identity"
+external castSymbolNode: node => symbolNode = "%identity"
+
+/*
+  MathJs Parser
+*/
+@module("mathjs") external parse__: string => node = "parse"
+
+let parse = (expr: string): result<node, reducerError> =>
+  try {
+    Ok(parse__(expr))
+  } catch {
+  | Js.Exn.Error(obj) =>
+    RerrJs(Js.Exn.message(obj), Js.Exn.name(obj))->Error
+  }
+
+type mjNode =
+  | MjAccessorNode(accessorNode)
+  | MjArrayNode(arrayNode)
+  | MjConstantNode(constantNode)
+  | MjFunctionNode(functionNode)
+  | MjIndexNode(indexNode)
+  | MjObjectNode(objectNode)
+  | MjOperatorNode(operatorNode)
+  | 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 rec show = (mjNode: mjNode): string => {
+  let showValue = (a: 'a): string => if (Js.typeof(a) == "string") {
+    `'${Js.String.make(a)}'`
+  } else {
+    Js.String.make(a)
+  }
+
+  let showNodeArray = (nodeArray: array<node>): string =>
+    nodeArray
+    -> Belt.Array.map( a => showMathJsNode(a) )
+    -> AE.interperse(", ")
+    -> Js.String.concatMany("")
+
+  let showFunctionNode = (fnode: functionNode): string =>
+    `${fnode["fn"]}(${fnode["args"]->showNodeArray})`
+
+  let showObjectEntry = ( (key: string, value: node) ): string =>
+    `${key}: ${value->showMathJsNode}`
+
+  let showObjectNode = (oNode: objectNode): string =>
+    `{${  oNode["properties"]
+          ->Js.Dict.entries
+          ->Belt.Array.map(entry=>entry->showObjectEntry)
+          ->AE.interperse(", ")->Js.String.concatMany("")
+    }}`
+
+  let showIndexNode = (iNode: indexNode): string =>
+    iNode["dimensions"]
+    -> Belt.Array.map( each => `${showResult(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"])})`
+  | 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

packages/squiggle-lang/src/rescript/Reducer/Reducer_MathJs/Reducer_MathJs_ToCodeTree.res

@@ -0,0 +1,111 @@
+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
+
+// TODO:
+// AccessorNode
+// AssignmentNode
+// BlockNode
+// ConditionalNode
+// FunctionAssignmentNode
+// IndexNode
+// ObjectNode
+// RangeNode
+// RelationalNode
+// SymbolNode
+
+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)
+      }})