quantified.uncertainty/squiggle
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Module.defineFFI

Browse Source
This commit is contained in:
Umur Ozkul 2022-06-27 02:40:31 +02:00
parent c0b632325e
commit 38cc93bdec
22 changed files with 388 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/squiggle-lang/__tests__/Reducer/Reducer_Helpers.res
View File

@ -2,7 +2,7 @@
module ErrorValue = Reducer_ErrorValue
module ExternalExpressionValue = ReducerInterface.ExternalExpressionValue
module InternalExpressionValue = ReducerInterface.InternalExpressionValue
module Module = Reducer_Category_Module
module Module = Reducer_Module
let removeDefaultsInternal = (iev: InternalExpressionValue.t) => {
switch iev {

2
packages/squiggle-lang/__tests__/Reducer/Reducer_TestMacroHelpers.res
View File

@ -8,7 +8,7 @@ module InternalExpressionValue = ReducerInterface.InternalExpressionValue
module ExpressionWithContext = Reducer_ExpressionWithContext
module Macro = Reducer_Expression_Macro
module T = Reducer_Expression_T
module Module = Reducer_Category_Module
module Module = Reducer_Module
let testMacro_ = (
tester,

16
packages/squiggle-lang/src/rescript/Reducer/Reducer_Category/Reducer_Category_Module_TypeChecker.res
View File

@ -1,16 +0,0 @@
module ExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionT = Reducer_Expression_T
open ExpressionValue
let isOfResolvedType = (aType, aValue) => {
let caseTypeIdentifier = (aTypeIdentifier0, aValue) => {
let valueType = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
let aTypeIdentifier = aTypeIdentifier0->Js.String2.toLowerCase
aTypeIdentifier === valueType
}
switch aType {
| IEvTypeIdentifier(aTypeIdentifier) => caseTypeIdentifier(aTypeIdentifier, aValue)
| _ => false
}
}

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

@ -3,8 +3,9 @@ module ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary
module Lambda = Reducer_Expression_Lambda
module MathJs = Reducer_MathJs
module Module = Reducer_Category_Module
module Module = Reducer_Module
module Result = Belt.Result
module TypeBuilder = Reducer_Type_TypeBuilder
open ReducerInterface_InternalExpressionValue
open Reducer_ErrorValue
@ -166,59 +167,6 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
)
}
let typeModifier_memberOf = (aType, anArray) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("memberOf", anArray)->IEvRecord->Ok
}
let typeModifier_memberOf_update = (aRecord, anArray) => {
aRecord->Belt.Map.String.set("memberOf", anArray)->IEvRecord->Ok
}
let typeModifier_min = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("min", value)->IEvRecord->Ok
}
let typeModifier_min_update = (aRecord, value) => {
aRecord->Belt.Map.String.set("min", value)->IEvRecord->Ok
}
let typeModifier_max = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("max", value)->IEvRecord->Ok
}
let typeModifier_max_update = (aRecord, value) =>
aRecord->Belt.Map.String.set("max", value)->IEvRecord->Ok
let typeModifier_opaque_update = aRecord =>
aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvRecord->Ok
let typeOr = evArray => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeOr")),
("typeOr", evArray),
])
newRecord->IEvRecord->Ok
}
let typeFunction = anArray => {
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeFunction")),
("inputs", IEvArray(inputs)),
("output", output),
])
newRecord->IEvRecord->Ok
}
switch call {
| ("$_atIndex_$", [IEvArray(aValueArray), IEvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
| ("$_atIndex_$", [IEvModule(dict), IEvString(sIndex)]) => moduleAtIndex(dict, sIndex)
@ -233,20 +181,24 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
| ("$_setTypeOfBindings_$", [IEvModule(nameSpace), IEvSymbol(symbol), value]) =>
doSetTypeOfBindings(nameSpace, symbol, value)
| ("$_typeModifier_memberOf_$", [IEvTypeIdentifier(typeIdentifier), IEvArray(arr)]) =>
typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
| ("$_typeModifier_memberOf_$", [IEvRecord(typeRecord), IEvArray(arr)]) =>
typeModifier_memberOf_update(typeRecord, IEvArray(arr))
TypeBuilder.typeModifier_memberOf(IEvTypeIdentifier(typeIdentifier), IEvArray(arr))
| ("$_typeModifier_memberOf_$", [IEvType(typeRecord), IEvArray(arr)]) =>
TypeBuilder.typeModifier_memberOf_update(typeRecord, IEvArray(arr))
| ("$_typeModifier_min_$", [IEvTypeIdentifier(typeIdentifier), value]) =>
typeModifier_min(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_min_$", [IEvRecord(typeRecord), value]) =>
typeModifier_min_update(typeRecord, value)
TypeBuilder.typeModifier_min(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_min_$", [IEvType(typeRecord), value]) =>
TypeBuilder.typeModifier_min_update(typeRecord, value)
| ("$_typeModifier_max_$", [IEvTypeIdentifier(typeIdentifier), value]) =>
typeModifier_max(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_max_$", [IEvRecord(typeRecord), value]) =>
typeModifier_max_update(typeRecord, value)
| ("$_typeModifier_opaque_$", [IEvRecord(typeRecord)]) => typeModifier_opaque_update(typeRecord)
| ("$_typeOr_$", [IEvArray(arr)]) => typeOr(IEvArray(arr))
| ("$_typeFunction_$", [IEvArray(arr)]) => typeFunction(arr)
TypeBuilder.typeModifier_max(IEvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_max_$", [IEvType(typeRecord), value]) =>
TypeBuilder.typeModifier_max_update(typeRecord, value)
| ("$_typeModifier_opaque_$", [IEvType(typeRecord)]) =>
TypeBuilder.typeModifier_opaque_update(typeRecord)
| ("$_typeOr_$", [IEvArray(arr)]) => TypeBuilder.typeOr(IEvArray(arr))
| ("$_typeFunction_$", [IEvArray(arr)]) => TypeBuilder.typeFunction(arr)
| ("$_typeTuple_$", [IEvArray(elems)]) => TypeBuilder.typeTuple(elems)
| ("$_typeArray_$", [elem]) => TypeBuilder.typeArray(elem)
| ("$_typeRecord_$", [IEvArray(arrayOfPairs)]) => TypeBuilder.typeRecord(arrayOfPairs)
| ("concat", [IEvArray(aValueArray), IEvArray(bValueArray)]) =>
doAddArray(aValueArray, bValueArray)
| ("concat", [IEvString(aValueString), IEvString(bValueString)]) =>

2
packages/squiggle-lang/src/rescript/Reducer/Reducer_Dispatch/Reducer_Dispatch_BuiltInMacros.res
View File

@ -9,7 +9,7 @@ module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ExpressionWithContext = Reducer_ExpressionWithContext
module Module = Reducer_Category_Module
module Module = Reducer_Module
module Result = Belt.Result
open Reducer_Expression_ExpressionBuilder

3
packages/squiggle-lang/src/rescript/Reducer/Reducer_Exception.res Normal file
View File

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

2
packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression.res
View File

@ -6,7 +6,7 @@ module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Lambda = Reducer_Expression_Lambda
module Macro = Reducer_Expression_Macro
module MathJs = Reducer_MathJs
module Module = Reducer_Category_Module
module Module = Reducer_Module
module Result = Belt.Result
module T = Reducer_Expression_T

2
packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_ExpressionWithContext.res
View File

@ -3,7 +3,7 @@ module ErrorValue = Reducer_ErrorValue
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Result = Belt.Result
module Module = Reducer_Category_Module
module Module = Reducer_Module
type bindings = ExpressionT.bindings
type context = bindings

2
packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression_BindingsReplacer.res
View File

@ -2,7 +2,7 @@ module ErrorValue = Reducer_ErrorValue
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Result = Belt.Result
module Module = Reducer_Category_Module
module Module = Reducer_Module
type errorValue = Reducer_ErrorValue.errorValue
type expression = ExpressionT.expression

18
packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression_ExpressionBuilder.res
View File

@ -2,7 +2,7 @@ module BBindingsReplacer = Reducer_Expression_BindingsReplacer
module BErrorValue = Reducer_ErrorValue
module BExpressionT = Reducer_Expression_T
module BInternalExpressionValue = ReducerInterface_InternalExpressionValue
module BModule = Reducer_Category_Module
module BModule = Reducer_Module
type errorValue = BErrorValue.errorValue
type expression = BExpressionT.expression
@ -10,8 +10,6 @@ type expressionOrFFI = BExpressionT.expressionOrFFI
type ffiFn = BExpressionT.ffiFn
type internalCode = ReducerInterface_InternalExpressionValue.internalCode
external castExpressionToInternalCode: expressionOrFFI => internalCode = "%identity"
let eArray = anArray => anArray->BInternalExpressionValue.IEvArray->BExpressionT.EValue
let eArrayString = anArray => anArray->BInternalExpressionValue.IEvArrayString->BExpressionT.EValue
@ -37,17 +35,12 @@ let eLambda = (
BInternalExpressionValue.IEvLambda({
parameters: parameters,
context: context,
body: NotFFI(expr)->castExpressionToInternalCode,
body: NotFFI(expr)->BModule.castExpressionToInternalCode,
})->BExpressionT.EValue
}
let eLambdaFFI = (parameters: array<string>, ffiFn: ffiFn) => {
let context = BModule.emptyModule
BInternalExpressionValue.IEvLambda({
parameters: parameters,
context: context,
body: FFI(ffiFn)->castExpressionToInternalCode,
})->BExpressionT.EValue
let eLambdaFFI = (ffiFn: ffiFn) => {
ffiFn->BModule.eLambdaFFIValue->BExpressionT.EValue
}
let eNumber = aNumber => aNumber->BInternalExpressionValue.IEvNumber->BExpressionT.EValue
@ -81,6 +74,9 @@ let eBindExpression = (bindingExpr: expression, expression: expression): express
let eBindExpressionDefault = (expression: expression): expression =>
eFunction("$$_bindExpression_$$", list{expression})
let eTernary = (truth: expression, trueCase: expression, falseCase: expression): expression =>
eFunction("$$_ternary_$$", list{truth, trueCase, falseCase})
let eIdentifier = (name: string): expression =>
name->BInternalExpressionValue.IEvSymbol->BExpressionT.EValue

2
packages/squiggle-lang/src/rescript/Reducer/Reducer_Expression/Reducer_Expression_Lambda.res
View File

@ -3,7 +3,7 @@ module ErrorValue = Reducer_ErrorValue
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface_InternalExpressionValue
module Module = Reducer_Category_Module
module Module = Reducer_Module
module Result = Belt.Result
type environment = ReducerInterface_InternalExpressionValue.environment

17
packages/squiggle-lang/src/rescript/Reducer/Reducer_Category/Reducer_Category_Module.res → packages/squiggle-lang/src/rescript/Reducer/Reducer_Module/Reducer_Module.res
View File

@ -1,5 +1,6 @@
module ExpressionT = Reducer_Expression_T
open ReducerInterface_InternalExpressionValue
let expressionValueToString = toString
type t = ReducerInterface_InternalExpressionValue.nameSpace
@ -66,7 +67,7 @@ let set = (nameSpace: t, id: string, value): t => {
Belt.Map.String.set(container, id, value)->NameSpace
}
let emptyModule: t = NameSpace(Belt.Map.String.empty)
let emptyModule: t = NameSpace(emptyMap)
let fromTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceFromTypeScriptBindings
let toTypeScriptBindings = ReducerInterface_InternalExpressionValue.nameSpaceToTypeScriptBindings
@ -100,13 +101,25 @@ let removeOther = (nameSpace: t, other: t): t => {
})->NameSpace
}
external castExpressionToInternalCode: ExpressionT.expressionOrFFI => internalCode = "%identity"
let eLambdaFFIValue = (ffiFn: ExpressionT.ffiFn) => {
IEvLambda({
parameters: [],
context: emptyModule,
body: FFI(ffiFn)->castExpressionToInternalCode,
})
}
// -- Module definition
let define = (nameSpace: t, identifier: string, ev: internalExpressionValue): t => {
let NameSpace(container) = nameSpace
Belt.Map.String.set(container, identifier, ev)->NameSpace // TODO build lambda for polymorphic functions here
Belt.Map.String.set(container, identifier, ev)->NameSpace
}
let defineNumber = (nameSpace: t, identifier: string, value: float): t =>
nameSpace->define(identifier, IEvNumber(value))
let defineModule = (nameSpace: t, identifier: string, value: t): t =>
nameSpace->define(identifier, toExpressionValue(value))
let defineFFI = (nameSpace: t, identifier: string, value: ExpressionT.ffiFn): t =>
nameSpace->define(identifier, value->eLambdaFFIValue)

29
packages/squiggle-lang/src/rescript/Reducer/Reducer_Module/Reducer_Module_Lambda.res Normal file
View File

@ -0,0 +1,29 @@
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
open Reducer_ErrorValue
open ReducerInterface_InternalExpressionValue
type expression = ExpressionT.expression
let defaultCase = (call: functionCall) =>
REFunctionNotFound(call->functionCallToCallSignature->functionCallSignatureToString)->Error
let defaultCaseFFIFn = (functionName: string): ExpressionT.ffiFn => {
(args: array<internalExpressionValue>, _environment: environment): result<
internalExpressionValue,
errorValue,
> => {
let call = (functionName, args)
defaultCase(call)
}
}
let defaultCaseFFI = (functionName: string): expression => {
ExpressionBuilder.eLambdaFFI(defaultCaseFFIFn(functionName))
}
let addGuard = (
guard: expression,
expression: expression,
previousExpression: expression,
): expression => ExpressionBuilder.eTernary(guard, expression, previousExpression)

15
packages/squiggle-lang/src/rescript/Reducer/Reducer_Peggy/Reducer_Peggy_GeneratedParser.peggy
View File

@ -343,11 +343,18 @@ typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
/ modifier:identifier _ noArguments
{ return {modifier: modifier, args: []}; }
basicType = typeConstructor / typeArray / typeRecord / typeInParanthesis / typeIdentifier
basicType = typeConstructor / typeArray / typeTuple / typeRecord / typeInParanthesis / typeIdentifier
typeArray = '[' _nl elem:typeExpression _nl ']'
{return h.apply('$_typeArray_$', elem)}
typeTuple = '[' _nl elems:array_typeTupleArguments _nl ']'
{ return h.apply('$_typeTuple_$', h.constructArray(elems))}
array_typeTupleArguments
= head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; }
typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
{ return h.apply('$_typeRecord_$', h.constructRecord(elems)); }
@ -375,9 +382,3 @@ typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
{ return h.makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}
// TODO: min max example
// TODO: Example of foo = {a: 2, b: 5}; type fooKeys = string $ memberOf(foo->keys)
// TODO: Example of memberOf( [1,2,3] )
// TODO: Example of $
// TODO: Cons(a, list) | EmptyList

6
packages/squiggle-lang/src/rescript/Reducer/Reducer_Peggy/Reducer_Peggy_Parse.res
View File

@ -5,7 +5,11 @@ type node = {"type": string}
@module("./Reducer_Peggy_GeneratedParser.js") external parse__: string => node = "parse"
let syntaxErrorToLocation: Js.Exn.t => Reducer_ErrorValue.location = error => %raw(`error.location`)
type withLocation = {"location": Reducer_ErrorValue.location}
external castWithLocation: Js.Exn.t => withLocation = "%identity"
let syntaxErrorToLocation = (error: Js.Exn.t): Reducer_ErrorValue.location =>
castWithLocation(error)["location"]
@genType
let parse = (expr: string): result<node, errorValue> =>

82
packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_T.res Normal file
View File

@ -0,0 +1,82 @@
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
open InternalExpressionValue
type rec iType =
| ItTypeIdentifier(string)
| ItModifiedType({modifiedType: iType})
| ItTypeOr({typeOr: array<iType>})
| ItTypeFunction({inputs: array<iType>, output: iType})
| ItTypeArray({element: iType})
| ItTypeTuple({elements: array<iType>})
| ItTypeRecord({properties: Belt.Map.String.t<iType>})
let rec fromTypeMap = typeMap => {
let default = IEvString("")
let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeTag",
default,
)
let evTypeIdentifier: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeIdentifier",
default,
)
let evTypeOr: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"typeOr",
default,
)
let evInputs: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"inputs",
default,
)
let evOutput: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"output",
default,
)
let evElement: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"element",
default,
)
let evElements: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"elements",
default,
)
let evProperties: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
typeMap,
"properties",
default,
)
//TODO: map type modifiers
switch evTypeTag {
| IEvString("typeIdentifier") => ItModifiedType({modifiedType: 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)
}
}
and fromIEvValue = (ievValue: InternalExpressionValue.t) =>
switch ievValue {
| IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
| IEvType(typeMap) => fromTypeMap(typeMap)
| _ => raise(Reducer_Exception.ImpossibleException)
}
and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
switch ievArray {
| IEvArray(array) => array->Belt.Array.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException)
}
and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
switch ievRecord {
| IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
| _ => raise(Reducer_Exception.ImpossibleException)
}

88
packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_TypeBuilder.res Normal file
View File

@ -0,0 +1,88 @@
open ReducerInterface_InternalExpressionValue
let typeModifier_memberOf = (aType, anArray) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
}
let typeModifier_memberOf_update = (aRecord, anArray) => {
aRecord->Belt.Map.String.set("memberOf", anArray)->IEvType->Ok
}
let typeModifier_min = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("min", value)->IEvType->Ok
}
let typeModifier_min_update = (aRecord, value) => {
aRecord->Belt.Map.String.set("min", value)->IEvType->Ok
}
let typeModifier_max = (aType, value) => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Belt.Map.String.set("max", value)->IEvType->Ok
}
let typeModifier_max_update = (aRecord, value) =>
aRecord->Belt.Map.String.set("max", value)->IEvType->Ok
let typeModifier_opaque_update = aRecord =>
aRecord->Belt.Map.String.set("opaque", IEvBool(true))->IEvType->Ok
let typeOr = evArray => {
let newRecord = Belt.Map.String.fromArray([("typeTag", IEvString("typeOr")), ("typeOr", evArray)])
newRecord->IEvType->Ok
}
let typeFunction = anArray => {
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeFunction")),
("inputs", IEvArray(inputs)),
("output", output),
])
newRecord->IEvType->Ok
}
let typeArray = element => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeTuple")),
("element", element),
])
newRecord->IEvType->Ok
}
let typeTuple = anArray => {
let newRecord = Belt.Map.String.fromArray([
("typeTag", IEvString("typeArray")),
("elements", IEvArray(anArray)),
])
newRecord->IEvType->Ok
}
let typeRecord = arrayOfPairs => {
let newProperties =
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),
])
newRecord->IEvType->Ok
}

81
packages/squiggle-lang/src/rescript/Reducer/Reducer_Type/Reducer_Type_TypeChecker.res Normal file
View File

@ -0,0 +1,81 @@
//TODO: Work in progress. Code is commented to make an a release of other features
module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module T = Reducer_Type_T
module TypeBuilder = Reducer_Type_TypeBuilder
open InternalExpressionValue
type typeErrorValue =
| 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) => {
let aTypeName = anUpperTypeName->Js.String2.toLowerCase
let valueTypeName = aValue->valueToValueType->valueTypeToString->Js.String2.toLowerCase
switch aTypeName === valueTypeName {
| true => Ok(true)
| false => TypeError(anIType, aValue)->Error
}
}
let _caseRecord = (anIType, evValue, propertyMap, map) => {
Belt.Map.String.reduce(propertyMap, Ok(true), (acc, property, propertyType) => {
Belt.Result.flatMap(acc, _ =>
switch Belt.Map.String.get(map, property) {
| Some(propertyValue) => isOfResolvedIType(propertyType, propertyValue)
| None => TypeErrorWithProperty(anIType, evValue, property)->Error
}
)
})
}
let _caseArray = (anIType, evValue, elementType, anArray) => {
Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, index) => {
switch isOfResolvedIType(elementType, element) {
| Ok(_) => acc
| Error(_) => TypeErrorWithPosition(anIType, evValue, index)->Error
}
})
}
switch anIType {
| ItTypeIdentifier(name) => caseTypeIdentifier(name, aValue)
// | ItModifiedType({modifiedType: anIType}) => raise(Reducer_Exception.ImpossibleException)
// | ItTypeOr({typeOr: anITypeArray}) => raise(Reducer_Exception.ImpossibleException)
// | ItTypeFunction({inputs: anITypeArray, output: anIType}) =>
// raise(Reducer_Exception.ImpossibleException)
// | 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)
}
}
let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
aType->T.fromIEvValue->isOfResolvedIType(aValue)
// let checkArguments = (
// evFunctionType: InternalExpressionValue.t,
// args: array<InternalExpressionValue.t>,
// ) => {
// let functionType = switch evFunctionType {
// | IEvRecord(functionType) => functionType
// | _ => raise(Reducer_Exception.ImpossibleException)
// }
// let evInputs = functionType->Belt.Map.String.getWithDefault("inputs", []->IEvArray)
// let inputs = switch evInputs {
// | IEvArray(inputs) => inputs
// | _ => raise(Reducer_Exception.ImpossibleException)
// }
// let rTupleType = TypeBuilder.typeTuple(inputs)
// Belt.Result.flatMap(rTupleType, tuppleType => isOfResolvedType(tuppleType, args->IEvArray))
// }
// let compileTypeExpression = (typeExpression: string, bindings: ExpressionT.bindings, reducerFn: ExpressionT.reducerFn) => {
// statement = `type compiled=${typeExpression}`
// }
//TODO: asGuard

81
packages/squiggle-lang/src/rescript/ReducerInterface/ReducerInterface_ExternalExpressionValue.res
View File

@ -24,6 +24,7 @@ type rec externalExpressionValue =
| EvDeclaration(lambdaDeclaration)
| EvTypeIdentifier(string)
| EvModule(record)
| EvType(record)
and record = Js.Dict.t<externalExpressionValue>
and externalBindings = record
and lambdaValue = {
@ -50,17 +51,18 @@ let rec toString = aValue =>
}
| EvBool(aBool) => Js.String.make(aBool)
| EvCall(fName) => `:${fName}`
| EvDate(date) => DateTime.Date.toString(date)
| EvDeclaration(d) => Declaration.toString(d, r => toString(EvLambda(r)))
| EvDistribution(dist) => GenericDist.toString(dist)
| EvLambda(lambdaValue) => `lambda(${Js.Array2.toString(lambdaValue.parameters)}=>internal code)`
| EvModule(m) => `@${m->toStringRecord}`
| EvNumber(aNumber) => Js.String.make(aNumber)
| EvRecord(aRecord) => aRecord->toStringRecord
| EvString(aString) => `'${aString}'`
| EvSymbol(aString) => `:${aString}`
| EvRecord(aRecord) => aRecord->toStringRecord
| EvDistribution(dist) => GenericDist.toString(dist)
| EvDate(date) => DateTime.Date.toString(date)
| EvTimeDuration(t) => DateTime.Duration.toString(t)
| EvDeclaration(d) => Declaration.toString(d, r => toString(EvLambda(r)))
| EvType(t) => `type${t->toStringRecord}`
| EvTypeIdentifier(id) => `#${id}`
| EvModule(m) => `@${m->toStringRecord}`
}
and toStringRecord = aRecord => {
let pairs =
@ -88,72 +90,3 @@ type environment = DistributionOperation.env
@genType
let defaultEnvironment: environment = DistributionOperation.defaultEnv
type expressionValueType =
| EvtArray
| EvtArrayString
| EvtBool
| EvtCall
| EvtDistribution
| EvtLambda
| EvtNumber
| EvtRecord
| EvtString
| EvtSymbol
| EvtDate
| EvtTimeDuration
| EvtDeclaration
| EvtTypeIdentifier
| EvtModule
type functionCallSignature = CallSignature(string, array<expressionValueType>)
type functionDefinitionSignature =
FunctionDefinitionSignature(functionCallSignature, expressionValueType)
let valueToValueType = value =>
switch value {
| EvArray(_) => EvtArray
| EvArrayString(_) => EvtArrayString
| EvBool(_) => EvtBool
| EvCall(_) => EvtCall
| EvDistribution(_) => EvtDistribution
| EvLambda(_) => EvtLambda
| EvNumber(_) => EvtNumber
| EvRecord(_) => EvtRecord
| EvString(_) => EvtString
| EvSymbol(_) => EvtSymbol
| EvDate(_) => EvtDate
| EvTimeDuration(_) => EvtTimeDuration
| EvDeclaration(_) => EvtDeclaration
| EvTypeIdentifier(_) => EvtTypeIdentifier
| EvModule(_) => EvtModule
}
let functionCallToCallSignature = (functionCall: functionCall): functionCallSignature => {
let (fn, args) = functionCall
CallSignature(fn, args->Js.Array2.map(valueToValueType))
}
let valueTypeToString = (valueType: expressionValueType): string =>
switch valueType {
| EvtArray => `Array`
| EvtArrayString => `ArrayString`
| EvtBool => `Bool`
| EvtCall => `Call`
| EvtDistribution => `Distribution`
| EvtLambda => `Lambda`
| EvtNumber => `Number`
| EvtRecord => `Record`
| EvtString => `String`
| EvtSymbol => `Symbol`
| EvtDate => `Date`
| EvtTimeDuration => `Duration`
| EvtDeclaration => `Declaration`
| EvtTypeIdentifier => `TypeIdentifier`
| EvtModule => `Module`
}
let functionCallSignatureToString = (functionCallSignature: functionCallSignature): string => {
let CallSignature(fn, args) = functionCallSignature
`${fn}(${args->Js.Array2.map(valueTypeToString)->Js.Array2.toString})`
}

62
packages/squiggle-lang/src/rescript/ReducerInterface/ReducerInterface_InternalExpressionValue.res
View File

@ -7,8 +7,8 @@ type environment = ExternalExpressionValue.environment
let defaultEnvironment = ExternalExpressionValue.defaultEnvironment
type rec t =
| IEvArray(array<t>) // FIXME: Convert
| IEvArrayString(array<string>) // FIXME: Convert
| IEvArray(array<t>) // FIXME: Convert to MapInt
| IEvArrayString(array<string>)
| IEvBool(bool)
| IEvCall(string) // External function call
| IEvDate(Js.Date.t)
@ -21,6 +21,7 @@ type rec t =
| IEvString(string)
| IEvSymbol(string)
| IEvTimeDuration(float)
| IEvType(map)
| IEvTypeIdentifier(string)
and map = Belt.Map.String.t<t>
and nameSpace = NameSpace(Belt.Map.String.t<t>)
@ -56,6 +57,7 @@ let rec toString = aValue =>
| IEvRecord(aMap) => aMap->toStringMap
| IEvString(aString) => `'${aString}'`
| IEvSymbol(aString) => `:${aString}`
| IEvType(aMap) => aMap->toStringMap
| IEvTimeDuration(t) => DateTime.Duration.toString(t)
| IEvTypeIdentifier(id) => `#${id}`
}
@ -78,17 +80,18 @@ let toStringWithType = aValue =>
| IEvArrayString(_) => `ArrayString::${toString(aValue)}`
| IEvBool(_) => `Bool::${toString(aValue)}`
| IEvCall(_) => `Call::${toString(aValue)}`
| IEvDate(_) => `Date::${toString(aValue)}`
| IEvDeclaration(_) => `Declaration::${toString(aValue)}`
| IEvDistribution(_) => `Distribution::${toString(aValue)}`
| IEvLambda(_) => `Lambda::${toString(aValue)}`
| IEvModule(_) => `Module::${toString(aValue)}`
| IEvNumber(_) => `Number::${toString(aValue)}`
| IEvRecord(_) => `Record::${toString(aValue)}`
| IEvString(_) => `String::${toString(aValue)}`
| IEvSymbol(_) => `Symbol::${toString(aValue)}`
| IEvDate(_) => `Date::${toString(aValue)}`
| IEvTimeDuration(_) => `Date::${toString(aValue)}`
| IEvDeclaration(_) => `Declaration::${toString(aValue)}`
| IEvType(_) => `Type::${toString(aValue)}`
| IEvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}`
| IEvModule(_) => `Module::${toString(aValue)}`
}
let argsToString = (args: array<t>): string => {
@ -120,17 +123,18 @@ type internalExpressionValueType =
| EvtArrayString
| EvtBool
| EvtCall
| EvtDate
| EvtDeclaration
| EvtDistribution
| EvtLambda
| EvtModule
| EvtNumber
| EvtRecord
| EvtString
| EvtSymbol
| EvtDate
| EvtTimeDuration
| EvtDeclaration
| EvtType
| EvtTypeIdentifier
| EvtModule
type functionCallSignature = CallSignature(string, array<internalExpressionValueType>)
type functionDefinitionSignature =
@ -142,17 +146,18 @@ let valueToValueType = value =>
| IEvArrayString(_) => EvtArrayString
| IEvBool(_) => EvtBool
| IEvCall(_) => EvtCall
| IEvDate(_) => EvtDate
| IEvDeclaration(_) => EvtDeclaration
| IEvDistribution(_) => EvtDistribution
| IEvLambda(_) => EvtLambda
| IEvModule(_) => EvtModule
| IEvNumber(_) => EvtNumber
| IEvRecord(_) => EvtRecord
| IEvString(_) => EvtString
| IEvSymbol(_) => EvtSymbol
| IEvDate(_) => EvtDate
| IEvTimeDuration(_) => EvtTimeDuration
| IEvDeclaration(_) => EvtDeclaration
| IEvType(_) => EvtType
| IEvTypeIdentifier(_) => EvtTypeIdentifier
| IEvModule(_) => EvtModule
}
let functionCallToCallSignature = (functionCall: functionCall): functionCallSignature => {
@ -166,17 +171,18 @@ let valueTypeToString = (valueType: internalExpressionValueType): string =>
| EvtArrayString => `ArrayString`
| EvtBool => `Bool`
| EvtCall => `Call`
| EvtDate => `Date`
| EvtDeclaration => `Declaration`
| EvtDistribution => `Distribution`
| EvtLambda => `Lambda`
| EvtModule => `Module`
| EvtNumber => `Number`
| EvtRecord => `Record`
| EvtString => `String`
| EvtSymbol => `Symbol`
| EvtDate => `Date`
| EvtTimeDuration => `Duration`
| EvtDeclaration => `Declaration`
| EvtType => `Type`
| EvtTypeIdentifier => `TypeIdentifier`
| EvtModule => `Module`
}
let functionCallSignatureToString = (functionCallSignature: functionCallSignature): string => {
@ -190,6 +196,11 @@ let rec toExternal = (iev: t): ExternalExpressionValue.t => {
| IEvArrayString(v) => EvArrayString(v)
| IEvBool(v) => EvBool(v)
| IEvCall(v) => EvCall(v)
| IEvDeclaration(v) => {
let fn = lambdaValueToExternal(v.fn)
let args = v.args
EvDeclaration({fn: fn, args: args})
}
| IEvDistribution(v) => EvDistribution(v)
| IEvLambda(v) => EvLambda(lambdaValueToExternal(v))
| IEvNumber(v) => EvNumber(v)
@ -198,11 +209,7 @@ let rec toExternal = (iev: t): ExternalExpressionValue.t => {
| IEvSymbol(v) => EvSymbol(v)
| IEvDate(v) => EvDate(v)
| IEvTimeDuration(v) => EvTimeDuration(v)
| IEvDeclaration(v) => {
let fn = lambdaValueToExternal(v.fn)
let args = v.args
EvDeclaration({fn: fn, args: args})
}
| IEvType(v) => v->mapToExternal->EvType
| IEvTypeIdentifier(v) => EvTypeIdentifier(v)
| IEvModule(v) => v->nameSpaceToTypeScriptBindings->EvModule
}
@ -228,21 +235,22 @@ let rec toInternal = (ev: ExternalExpressionValue.t): t => {
| EvArrayString(v) => IEvArrayString(v)
| EvBool(v) => IEvBool(v)
| EvCall(v) => IEvCall(v)
| EvDistribution(v) => IEvDistribution(v)
| EvLambda(v) => IEvLambda(lambdaValueToInternal(v))
| EvNumber(v) => IEvNumber(v)
| EvRecord(v) => v->recordToInternal->IEvRecord
| EvString(v) => IEvString(v)
| EvSymbol(v) => IEvSymbol(v)
| EvDate(v) => IEvDate(v)
| EvTimeDuration(v) => IEvTimeDuration(v)
| EvDeclaration(v) => {
let fn = lambdaValueToInternal(v.fn)
let args = v.args
IEvDeclaration({fn: fn, args: args})
}
| EvTypeIdentifier(v) => IEvTypeIdentifier(v)
| EvDistribution(v) => IEvDistribution(v)
| EvLambda(v) => IEvLambda(lambdaValueToInternal(v))
| EvModule(v) => v->nameSpaceFromTypeScriptBindings->IEvModule
| EvNumber(v) => IEvNumber(v)
| EvRecord(v) => v->recordToInternal->IEvRecord
| EvString(v) => IEvString(v)
| EvSymbol(v) => IEvSymbol(v)
| EvTimeDuration(v) => IEvTimeDuration(v)
| EvType(v) => v->recordToInternal->IEvType
| EvTypeIdentifier(v) => IEvTypeIdentifier(v)
}
}
and recordToInternal = v =>

2
packages/squiggle-lang/src/rescript/ReducerInterface/ReducerInterface_StdLib.res
View File

@ -1,4 +1,4 @@
module Module = Reducer_Category_Module
module Module = Reducer_Module
let internalStdLib = Module.emptyModule->SquiggleLibrary_Math.makeBindings

4
packages/squiggle-lang/src/rescript/SquiggleLibrary/SquiggleLibrary_Math.res
View File

@ -1,5 +1,5 @@
module Bindings = Reducer_Category_Module
module Module = Reducer_Category_Module
module Bindings = Reducer_Module
module Module = Reducer_Module
let availableNumbers: array<(string, float)> = [
("pi", Js.Math._PI),