basic type compiler

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

@@ -0,0 +1,62 @@
+module Expression = Reducer_Expression
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module Module = Reducer_Module
+module T = Reducer_Type_T
+module TypeCompile = Reducer_Type_Compile
+
+open Jest
+open Expect
+
+let myIevEval = (aTypeSourceCode: string) =>
+  TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpression)
+let myIevEvalToString = (aTypeSourceCode: string) =>
+  myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
+
+let myIevExpectEqual = (aTypeSourceCode, answer) =>
+  expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
+
+let _myIevTest = (test, aTypeSourceCode, answer) =>
+  test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
+
+let myTypeEval = (aTypeSourceCode: string) =>
+  TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpression)
+let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
+
+let myTypeExpectEqual = (aTypeSourceCode, answer) =>
+  expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
+
+let _myTypeTest = (test, aTypeSourceCode, answer) =>
+  test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
+
+let myIevTest = (aTypeSourceCode, answer) => _myIevTest(test, aTypeSourceCode, answer)
+let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(test, aTypeSourceCode, answer)
+module MySkip = {
+  let myIevTest = (aTypeSourceCode, answer) => _myIevTest(Skip.test, aTypeSourceCode, answer)
+  let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(Skip.test, aTypeSourceCode, answer)
+}
+module MyOnly = {
+  let myIevTest = (aTypeSourceCode, answer) => _myIevTest(Only.test, aTypeSourceCode, answer)
+  let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(Only.test, aTypeSourceCode, answer)
+}
+
+//   | ItTypeIdentifier(string)
+myTypeTest("number", "number")
+myTypeTest("(number)", "number")
+//   | ItModifiedType({modifiedType: iType})
+myIevTest("number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
+myTypeTest("number<-min(0)", "number<-min(0)")
+//   | ItTypeOr({typeOr: array<iType>})
+myTypeTest("number | string", "(number | string)")
+//   | ItTypeFunction({inputs: array<iType>, output: iType})
+myTypeTest("number => number => number", "(number => number => number)")
+//   | ItTypeArray({element: iType})
+myIevTest("[number]", "Ok({element: #number,typeTag: 'typeArray'})")
+myTypeTest("[number]", "[number]")
+//   | ItTypeTuple({elements: array<iType>})
+myTypeTest("[number, string]", "[number, string]")
+//   | ItTypeRecord({properties: Belt.Map.String.t<iType>})
+myIevTest(
+  "{age: number, name: string}",
+  "Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
+)
+myTypeTest("{age: number, name: string}", "{age: number, name: string}")

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

@@ -198,7 +198,7 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
   | ("$_typeFunction_$", [IEvArray(arr)]) => TypeBuilder.typeFunction(arr)
   | ("$_typeTuple_$", [IEvArray(elems)]) => TypeBuilder.typeTuple(elems)
   | ("$_typeArray_$", [elem]) => TypeBuilder.typeArray(elem)
-  | ("$_typeRecord_$", [IEvArray(arrayOfPairs)]) => TypeBuilder.typeRecord(arrayOfPairs)
+  | ("$_typeRecord_$", [IEvRecord(propertyMap)]) => TypeBuilder.typeRecord(propertyMap)
   | ("concat", [IEvArray(aValueArray), IEvArray(bValueArray)]) =>
     doAddArray(aValueArray, bValueArray)
   | ("concat", [IEvString(aValueString), IEvString(bValueString)]) =>

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

@@ -1,3 +1,3 @@
-// There are switch stament cases in the code which are impossible to reach by design.
+// There are switch statement cases in the code which are impossible to reach by design.
 // ImpossibleException is a sign of programming error.
-exception ImpossibleException
+exception ImpossibleException(string)

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

@@ -0,0 +1,36 @@
+module ErrorValue = Reducer_ErrorValue
+module ExpressionT = Reducer_Expression_T
+module InternalExpressionValue = ReducerInterface_InternalExpressionValue
+module Module = Reducer_Module
+module T = Reducer_Type_T
+
+let ievFromTypeExpression = (
+  typeExpressionSourceCode: string,
+  reducerFn: ExpressionT.reducerFn,
+): result<InternalExpressionValue.t, ErrorValue.t> => {
+  let sIndex = "compiled"
+  let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
+  Reducer_Expression.parse(sourceCode)->Belt.Result.flatMap(expr => {
+    let rContext = reducerFn(expr, Module.emptyBindings, InternalExpressionValue.defaultEnvironment)
+    Belt.Result.map(rContext, context =>
+      switch context {
+      | IEvModule(nameSpace) =>
+        switch Module.getType(nameSpace, sIndex) {
+        | Some(value) => value
+        | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
+        }
+      | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-raise"))
+      }
+    )
+  })
+}
+
+let fromTypeExpression = (
+  typeExpressionSourceCode: string,
+  reducerFn: ExpressionT.reducerFn,
+): result<T.t, ErrorValue.t> => {
+  ievFromTypeExpression(
+    (typeExpressionSourceCode: string),
+    (reducerFn: ExpressionT.reducerFn),
+  )->Belt.Result.map(T.fromIEvValue)
+}

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

@@ -3,13 +3,41 @@ open InternalExpressionValue
 
 type rec iType =
   | ItTypeIdentifier(string)
-  | ItModifiedType({modifiedType: iType})
+  | ItModifiedType({modifiedType: iType, modifiers: Belt.Map.String.t<InternalExpressionValue.t>})
   | ItTypeOr({typeOr: array<iType>})
   | ItTypeFunction({inputs: array<iType>, output: iType})
   | ItTypeArray({element: iType})
   | ItTypeTuple({elements: array<iType>})
   | ItTypeRecord({properties: Belt.Map.String.t<iType>})
 
+type t = iType
+
+let rec toString = (t: t): string => {
+  switch t {
+  | ItTypeIdentifier(s) => s
+  | ItModifiedType({modifiedType, modifiers}) =>
+    `${toString(modifiedType)}${modifiers->Belt.Map.String.reduce("", (acc, k, v) =>
+        Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
+      )}`
+  | ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
+  | ItTypeFunction({inputs, output}) =>
+    `(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
+  | ItTypeArray({element}) => `[${toString(element)}]`
+  | ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
+  | ItTypeRecord({properties}) =>
+    `{${properties
+      ->Belt.Map.String.toArray
+      ->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
+      ->Js.Array2.joinWith(", ")}}`
+  }
+}
+
+let toStringResult = (rt: result<t, ErrorValue.t>) =>
+  switch rt {
+  | Ok(t) => toString(t)
+  | Error(e) => ErrorValue.errorToString(e)
+  }
+
 let rec fromTypeMap = typeMap => {
   let default = IEvString("")
   let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
@@ -52,31 +80,39 @@ let rec fromTypeMap = typeMap => {
     "properties",
     default,
   )
-  //TODO: map type modifiers
+
-  switch evTypeTag {
+  let modifiers =
-  | IEvString("typeIdentifier") => ItModifiedType({modifiedType: fromIEvValue(evTypeIdentifier)})
+    typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
+
+  let makeIt = switch evTypeTag {
+  | IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
   | IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
   | IEvString("typeFunction") =>
     ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
   | IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
   | IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
   | IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
-  | _ => raise(Reducer_Exception.ImpossibleException)
+  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
   }
+
+  Belt.Map.String.isEmpty(modifiers)
+    ? makeIt
+    : ItModifiedType({modifiedType: makeIt, modifiers: modifiers})
 }
-and fromIEvValue = (ievValue: InternalExpressionValue.t) =>
+
+and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
   switch ievValue {
   | IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
   | IEvType(typeMap) => fromTypeMap(typeMap)
-  | _ => raise(Reducer_Exception.ImpossibleException)
+  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
   }
 and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
   switch ievArray {
   | IEvArray(array) => array->Belt.Array.map(fromIEvValue)
-  | _ => raise(Reducer_Exception.ImpossibleException)
+  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
   }
 and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
   switch ievRecord {
   | IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
-  | _ => raise(Reducer_Exception.ImpossibleException)
+  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
   }

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

@@ -56,7 +56,7 @@ let typeFunction = anArray => {
 
 let typeArray = element => {
   let newRecord = Belt.Map.String.fromArray([
-    ("typeTag", IEvString("typeTuple")),
+    ("typeTag", IEvString("typeArray")),
     ("element", element),
   ])
   newRecord->IEvType->Ok
@@ -64,22 +64,14 @@ let typeArray = element => {
 
 let typeTuple = anArray => {
   let newRecord = Belt.Map.String.fromArray([
-    ("typeTag", IEvString("typeArray")),
+    ("typeTag", IEvString("typeTuple")),
     ("elements", IEvArray(anArray)),
   ])
   newRecord->IEvType->Ok
 }
 
-let typeRecord = arrayOfPairs => {
+let typeRecord = propertyMap => {
-  let newProperties =
+  let newProperties = propertyMap->IEvRecord
-    Belt.Array.map(arrayOfPairs, pairValue =>
-      switch pairValue {
-      | IEvArray([IEvString(key), valueValue]) => (key, valueValue)
-      | _ => ("wrong key type", pairValue->toStringWithType->IEvString)
-      }
-    )
-    ->Belt.Map.String.fromArray
-    ->IEvRecord
   let newRecord = Belt.Map.String.fromArray([
     ("typeTag", IEvString("typeRecord")),
     ("properties", newProperties),

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

@@ -1,13 +1,10 @@
-module ExpressionT = Reducer_Expression_T
+// module ErrorValue = Reducer_ErrorValue
 module InternalExpressionValue = ReducerInterface_InternalExpressionValue
 module T = Reducer_Type_T
-module TypeBuilder = Reducer_Type_TypeBuilder
+// module TypeBuilder = Reducer_Type_TypeBuilder
 open InternalExpressionValue
 
-type typeErrorValue =
+type typeErrorValue = TypeError(T.t, InternalExpressionValue.t)
-  | TypeError(T.iType, InternalExpressionValue.t)
-  | TypeErrorWithPosition(T.iType, InternalExpressionValue.t, int)
-  | TypeErrorWithProperty(T.iType, InternalExpressionValue.t, string)
 
 let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorValue> => {
   let caseTypeIdentifier = (anUpperTypeName, aValue) => {
@@ -24,16 +21,16 @@ let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorVa
       Belt.Result.flatMap(acc, _ =>
         switch Belt.Map.String.get(map, property) {
         | Some(propertyValue) => isOfResolvedIType(propertyType, propertyValue)
-        | None => TypeErrorWithProperty(anIType, evValue, property)->Error
+        | None => TypeError(anIType, evValue)->Error
         }
       )
     })
   }
   let _caseArray = (anIType, evValue, elementType, anArray) => {
-    Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, index) => {
+    Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, _index) => {
       switch isOfResolvedIType(elementType, element) {
       | Ok(_) => acc
-      | Error(_) => TypeErrorWithPosition(anIType, evValue, index)->Error
+      | Error(_) => TypeError(anIType, evValue)->Error
       }
     })
   }
@@ -48,12 +45,12 @@ let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorVa
   // | ItTypeArray({element: anIType}) => raise(Reducer_Exception.ImpossibleException)
   // | ItTypeTuple({elements: anITypeArray}) => raise(Reducer_Exception.ImpossibleException)
   // | ItTypeRecord({properties: anITypeMap}) => raise(Reducer_Exception.ImpossibleException)
-  | _ => raise(Reducer_Exception.ImpossibleException)
+  | _ => raise(Reducer_Exception.ImpossibleException("Reducer_TypeChecker-isOfResolvedIType"))
   }
 }
 
-let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
+// let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
-  aType->T.fromIEvValue->isOfResolvedIType(aValue)
+//   aType->T.fromIEvValue->isOfResolvedIType(aValue)
 
 // TODO: Work in progress. Code is commented to make an a release of other features
 // let checkArguments = (
@@ -70,12 +67,5 @@ let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool,
 //   | _ => raise(Reducer_Exception.ImpossibleException)
 //   }
 //   let rTupleType = TypeBuilder.typeTuple(inputs)
-//   Belt.Result.flatMap(rTupleType, tuppleType => isOfResolvedType(tuppleType, args->IEvArray))
+//   Belt.Result.flatMap(rTupleType, tupleType => isOfResolvedType(tupleType, args->IEvArray))
 // }
-
-// let compileTypeExpression = (typeExpression: string, bindings: ExpressionT.bindings, reducerFn: ExpressionT.reducerFn) => {
-//     statement = `type compiled=${typeExpression}`
-
-// }
-
-//TODO: asGuard