Merge pull request #900 from quantified-uncertainty/reducer-typecheck-example

Reducer real life type checking example to build a library

packages/squiggle-lang/__tests__/Reducer/Reducer_Category/Reducer_Category_Module_TypeChecker_test.res

@@ -1,4 +0,0 @@
-open Jest
-open Expect
-
-test("todo", () => expect("1")->toBe("1"))

packages/squiggle-lang/__tests__/Reducer/Reducer_Type/Reducer_Type_TypeChecker_test.res

@@ -68,3 +68,5 @@ myTypeCheckTest(test, "number | string", "1", "Ok")
 myTypeCheckTest(test, "date | string", "1", "Expected type: (date | string) but got: 1")
 myTypeCheckTest(test, "number<-min(10)", "10", "Ok")
 myTypeCheckTest(test, "number<-min(10)", "0", "Expected type: number<-min(10) but got: 0")
+myTypeCheckTest(test, "any", "0", "Ok")
+myTypeCheckTest(test, "any", "'a'", "Ok")

packages/squiggle-lang/__tests__/Reducer/Reducer_Type/Reducer_Type_switch_replacement_test.res

@@ -0,0 +1,123 @@
+open Jest
+open Expect
+
+module DispatchT = Reducer_Dispatch_T
+module Expression = Reducer_Expression
+module ExpressionT = Reducer_Expression_T
+module TypeCompile = Reducer_Type_Compile
+module TypeChecker = Reducer_Type_TypeChecker
+open ReducerInterface_InternalExpressionValue
+
+type errorValue = Reducer_ErrorValue.errorValue
+
+// Let's build a function to replace switch statements
+// In dispatchChainPiece, we execute an return the result of execution if there is a type match.
+// Otherwise we return None so that the call chain can continue.
+// So we want to build a function like
+// dispatchChainPiece = (call: functionCall, environment): option<result<internalExpressionValue, errorValue>>
+
+// Now lets make the dispatchChainPiece itself.
+// Note that I am not passing the reducer to the dispatchChainPiece as an argument because it is in the context anyway.
+// Keep in mind that reducerFn is necessary for map/reduce so dispatchChainPiece should have a reducerFn in context.
+
+let makeMyDispatchChainPiece = (reducer: ExpressionT.reducerFn): DispatchT.dispatchChainPiece => {
+  // Let's have a pure implementations
+  module Implementation = {
+    let stringConcat = (a: string, b: string): string => Js.String2.concat(a, b)
+    let arrayConcat = (
+      a: Js.Array2.t<internalExpressionValue>,
+      b: Js.Array2.t<internalExpressionValue>,
+    ): Js.Array2.t<internalExpressionValue> => Js.Array2.concat(a, b)
+    let plot = _r => "yey, plotted"
+  }
+
+  let extractStringString = args =>
+    switch args {
+    | [IEvString(a), IEvString(b)] => (a, b)
+    | _ => raise(Reducer_Exception.ImpossibleException("extractStringString developer error"))
+    }
+
+  let extractArrayArray = args =>
+    switch args {
+    | [IEvArray(a), IEvArray(b)] => (a, b)
+    | _ => raise(Reducer_Exception.ImpossibleException("extractArrayArray developer error"))
+    }
+
+  // Let's bridge the pure implementation to expression values
+  module Bridge = {
+    let stringConcat: DispatchT.genericIEvFunction = (args, _environment) => {
+      let (a, b) = extractStringString(args)
+      Implementation.stringConcat(a, b)->IEvString->Ok
+    }
+    let arrayConcat: DispatchT.genericIEvFunction = (args, _environment) => {
+      let (a, b) = extractArrayArray(args)
+      Implementation.arrayConcat(a, b)->IEvArray->Ok
+    }
+    let plot: DispatchT.genericIEvFunction = (args, _environment) => {
+      switch args {
+      // Just assume that we are doing the business of extracting and converting the deep record
+      | [IEvRecord(_)] => Implementation.plot({"title": "This is a plot"})->IEvString->Ok
+      | _ => raise(Reducer_Exception.ImpossibleException("plot developer error"))
+      }
+    }
+  }
+
+  // concat functions are to illustrate polymoprhism. And the plot function is to illustrate complex types
+  let jumpTable = [
+    (
+      "concat",
+      TypeCompile.fromTypeExpressionExn("string=>string=>string", reducer),
+      Bridge.stringConcat,
+    ),
+    (
+      "concat",
+      TypeCompile.fromTypeExpressionExn("[any]=>[any]=>[any]", reducer),
+      Bridge.arrayConcat,
+    ),
+    (
+      "plot",
+      TypeCompile.fromTypeExpressionExn(
+        // Nested complex types are available
+        // records {property: type}
+        // arrays [type]
+        // tuples [type, type]
+        // <- type contracts are available naturally and they become part of dispatching
+        // Here we are not enumerating the possibilities because type checking has a dedicated test
+        "{title: string, line: {width: number, color: string}}=>string",
+        reducer,
+      ),
+      Bridge.plot,
+    ),
+  ]
+
+  //Here we are creating a dispatchChainPiece function that will do the actual dispatch from the jumpTable
+  Reducer_Dispatch_ChainPiece.makeFromTypes(jumpTable)
+}
+
+// And finally, let's write a library dispatch for our external library
+// Exactly the same as the one used in real life
+let _dispatch = (
+  call: functionCall,
+  environment,
+  reducer: Reducer_Expression_T.reducerFn,
+  chain,
+): result<internalExpressionValue, 'e> => {
+  let dispatchChainPiece = makeMyDispatchChainPiece(reducer)
+  dispatchChainPiece(call, environment)->E.O2.defaultFn(() => chain(call, environment, reducer))
+}
+
+// What is important about this implementation?
+// A) Exactly the same function jump table can be used to create type guarded lambda functions
+// Guarded lambda functions will be the basis of the next version of Squiggle
+// B) Complicated recursive record types are not a problem.
+
+describe("Type Dispatch", () => {
+  let reducerFn = Expression.reduceExpression
+  let dispatchChainPiece = makeMyDispatchChainPiece(reducerFn)
+  test("stringConcat", () => {
+    let call: functionCall = ("concat", [IEvString("hello"), IEvString("world")])
+
+    let result = dispatchChainPiece(call, defaultEnvironment)
+    expect(result)->toEqual(Some(Ok(IEvString("helloworld"))))
+  })
+})

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

@@ -0,0 +1,19 @@
+module TypeChecker = Reducer_Type_TypeChecker
+module T = Reducer_Dispatch_T
+open ReducerInterface_InternalExpressionValue
+
+type errorValue = Reducer_ErrorValue.errorValue
+
+let makeFromTypes = jumpTable => {
+  let dispatchChainPiece: T.dispatchChainPiece = ((fnName, fnArgs): functionCall, environment) => {
+    let jumpTableEntry = jumpTable->Js.Array2.find(elem => {
+      let (candidName, candidType, _) = elem
+      candidName == fnName && TypeChecker.checkITypeArgumentsBool(candidType, fnArgs)
+    })
+    switch jumpTableEntry {
+    | Some((_, _, bridgeFn)) => bridgeFn(fnArgs, environment)->Some
+    | _ => None
+    }
+  }
+  dispatchChainPiece
+}

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

@@ -0,0 +1,20 @@
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module ExpressionT = Reducer_Expression_T
+
+// Each piece of the dispatch chain computes the result or returns None so that the chain can continue
+type dispatchChainPiece = (
+  InternalExpressionValue.functionCall,
+  InternalExpressionValue.environment,
+) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
+
+type dispatchChainPieceWithReducer = (
+  InternalExpressionValue.functionCall,
+  InternalExpressionValue.environment,
+  ExpressionT.reducerFn,
+) => option<result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>>
+
+// This is a switch statement case implementation: get the arguments and compute the result
+type genericIEvFunction = (
+  array<InternalExpressionValue.t>,
+  InternalExpressionValue.environment,
+) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>

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

@@ -38,3 +38,12 @@ let fromTypeExpression = (
     (reducerFn: ExpressionT.reducerFn),
   )->Belt.Result.map(T.fromIEvValue)
 }
+
+let fromTypeExpressionExn = (
+  typeExpressionSourceCode: string,
+  reducerFn: ExpressionT.reducerFn,
+): T.t =>
+  switch fromTypeExpression(typeExpressionSourceCode, reducerFn) {
+  | Ok(value) => value
+  | _ => `Cannot compile ${typeExpressionSourceCode}`->Reducer_Exception.ImpossibleException->raise
+  }

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

@@ -7,10 +7,15 @@ open InternalExpressionValue
 let rec isITypeOf = (anIType: T.iType, aValue): result<bool, T.typeErrorValue> => {
   let caseTypeIdentifier = (anUpperTypeName, aValue) => {
     let aTypeName = anUpperTypeName->Js.String2.toLowerCase
-    let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
-    switch aTypeName == valueTypeName {
-    | true => Ok(true)
-    | false => T.TypeMismatch(anIType, aValue)->Error
+    switch aTypeName {
+    | "any" => Ok(true)
+    | _ => {
+        let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
+        switch aTypeName == valueTypeName {
+        | true => Ok(true)
+        | false => T.TypeMismatch(anIType, aValue)->Error
+        }
+      }
     }
   }
 
@@ -149,6 +154,13 @@ let checkITypeArguments = (anIType: T.iType, args: array<InternalExpressionValue
   }
 }
 
+let checkITypeArgumentsBool = (anIType: T.iType, args: array<InternalExpressionValue.t>): bool => {
+  switch checkITypeArguments(anIType, args) {
+  | Ok(_) => true
+  | _ => false
+  }
+}
+
 let checkArguments = (
   typeExpressionSourceCode: string,
   args: array<InternalExpressionValue.t>,