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

Merge remote-tracking branch 'origin/develop' into fix-nixbuild

Browse Source
This commit is contained in:
Quinn Dougherty 2022-09-12 11:53:46 +08:00
commit 3677b9582e
44 changed files with 1107 additions and 1162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
.github/CODEOWNERS vendored
View File

@ -9,22 +9,22 @@
# This also holds true for GitHub teams. # This also holds true for GitHub teams.
# Rescript # Rescript
*.res @OAGr *.res @berekuk @OAGr
*.resi @OAGr *.resi @berekuk @OAGr
# Typescript # Typescript
*.tsx @Hazelfire @OAGr *.tsx @Hazelfire @berekuk @OAGr
*.ts @Hazelfire @OAGr *.ts @Hazelfire @berekuk @OAGr
# Javascript # Javascript
*.js @Hazelfire @OAGr *.js @Hazelfire @berekuk @OAGr
# Any opsy files # Any opsy files
.github/** @quinn-dougherty @OAGr .github/** @quinn-doughert @berekuky @OAGr
*.json @quinn-dougherty @Hazelfire @OAGr *.json @quinn-dougherty @Hazelfire @berekuk @OAGr
*.y*ml @quinn-dougherty @OAGr *.y*ml @quinn-dougherty @berekuk @OAGr
*.config.js @Hazelfire @OAGr *.config.js @Hazelfire @berekuk @OAGr
netlify.toml @quinn-dougherty @OAGr @Hazelfire netlify.toml @quinn-dougherty @OAGr @berekuk @Hazelfire
# Documentation # Documentation
*.md @quinn-dougherty @OAGr @Hazelfire *.md @quinn-dougherty @OAGr @Hazelfire

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

@ -19,7 +19,7 @@ let testMacro_ = (
let bindings = Bindings.fromArray(bindArray) let bindings = Bindings.fromArray(bindArray)
tester(expr->T.toString, () => tester(expr->T.toString, () =>
expr expr
->Macro.expandMacroCall( ->Macro.expandMacroCallRs(
bindings, bindings,
ProjectAccessorsT.identityAccessors, ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject, Expression.reduceExpressionInProject,
@ -44,6 +44,7 @@ let testMacroEval_ = (
ProjectAccessorsT.identityAccessors, ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject, Expression.reduceExpressionInProject,
) )
->Ok
->InternalExpressionValue.toStringResult ->InternalExpressionValue.toStringResult
->expect ->expect
->toEqual(expectedValue) ->toEqual(expectedValue)

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

@ -16,7 +16,7 @@ let checkArgumentsSourceCode = (aTypeSourceCode: string, sourceCode: string): re
> => { > => {
let reducerFn = Expression.reduceExpressionInProject let reducerFn = Expression.reduceExpressionInProject
let rResult = let rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors) reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
) )
rResult->Belt.Result.flatMap(result => rResult->Belt.Result.flatMap(result =>

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

@ -19,7 +19,7 @@ let isTypeOfSourceCode = (aTypeSourceCode: string, sourceCode: string): result<
> => { > => {
let reducerFn = Expression.reduceExpressionInProject let reducerFn = Expression.reduceExpressionInProject
let rResult = let rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors) reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
) )
rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn)) rResult->Belt.Result.flatMap(result => TypeChecker.isTypeOf(aTypeSourceCode, result, reducerFn))

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

@ -56,7 +56,7 @@ describe("test exceptions", () => {
testDescriptionEvalToBe( testDescriptionEvalToBe(
"javascript exception", "javascript exception",
"javascriptraise('div by 0')", "javascriptraise('div by 0')",
"Error(JS Exception: Error: 'div by 0')", "Error(Error: 'div by 0')",
) )
// testDescriptionEvalToBe( // testDescriptionEvalToBe(
// "rescript exception", // "rescript exception",

15
packages/squiggle-lang/src/rescript/FunctionRegistry/Library/FR_Danger.res
View File

@ -74,12 +74,11 @@ module Integration = {
reducer, reducer,
) )
let result = switch resultAsInternalExpression { let result = switch resultAsInternalExpression {
| Ok(IEvNumber(x)) => Ok(x) | IEvNumber(x) => Ok(x)
| Error(_) => | _ =>
Error( Error(
"Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead", "Error 1 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
) )
| _ => Error("Error 2 in Danger.integrate")
} }
result result
} }
@ -143,7 +142,7 @@ module Integration = {
} }
| Error(b) => | Error(b) =>
Error( Error(
"Integration error 3 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead." ++ "Integration error 2 in Danger.integrate. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead." ++
"Original error: " ++ "Original error: " ++
b, b,
) )
@ -309,14 +308,10 @@ module DiminishingReturns = {
reducer, reducer,
) )
switch resultAsInternalExpression { switch resultAsInternalExpression {
| Ok(IEvNumber(x)) => Ok(x) | IEvNumber(x) => Ok(x)
| Error(_) =>
Error(
"Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
)
| _ => | _ =>
Error( Error(
"Error 2 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions", "Error 1 in Danger.optimalAllocationGivenDiminishingMarginalReturnsForManyFunctions. It's possible that your function doesn't return a number, try definining auxiliaryFunction(x) = mean(yourFunction(x)) and integrate auxiliaryFunction instead",
) )
} }
} }

81
packages/squiggle-lang/src/rescript/FunctionRegistry/Library/FR_List.res
View File

@ -32,19 +32,15 @@ module Internals = {
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
eLambdaValue, eLambdaValue,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
): result<ReducerInterface_InternalExpressionValue.t, Reducer_ErrorValue.errorValue> => { ): ReducerInterface_InternalExpressionValue.t => {
let rMappedList = array->E.A.reduceReverse(Ok(list{}), (rAcc, elem) => Belt.Array.map(array, elem =>
rAcc->E.R.bind(_, acc => { Reducer_Expression_Lambda.doLambdaCall(
let rNewElem = Reducer_Expression_Lambda.doLambdaCall( eLambdaValue,
eLambdaValue, list{elem},
list{elem}, (accessors: ProjectAccessorsT.t),
(accessors: ProjectAccessorsT.t), (reducer: ProjectReducerFnT.t),
(reducer: ProjectReducerFnT.t), )
) )->Wrappers.evArray
rNewElem->E.R2.fmap(newElem => list{newElem, ...acc})
})
)
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
} }
let reduce = ( let reduce = (
@ -54,10 +50,8 @@ module Internals = {
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
) => { ) => {
aValueArray->E.A.reduce(Ok(initialValue), (rAcc, elem) => aValueArray->E.A.reduce(initialValue, (acc, elem) =>
rAcc->E.R.bind(_, acc => Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
)
) )
} }
@ -68,10 +62,8 @@ module Internals = {
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
) => { ) => {
aValueArray->Belt.Array.reduceReverse(Ok(initialValue), (rAcc, elem) => aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) =>
rAcc->Belt.Result.flatMap(acc => Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
)
) )
} }
@ -81,25 +73,18 @@ module Internals = {
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
) => { ) => {
let rMappedList = aValueArray->Belt.Array.reduceReverse(Ok(list{}), (rAcc, elem) => Js.Array2.filter(aValueArray, elem => {
rAcc->E.R.bind(_, acc => { let result = Reducer_Expression_Lambda.doLambdaCall(
let rNewElem = Reducer_Expression_Lambda.doLambdaCall( aLambdaValue,
aLambdaValue, list{elem},
list{elem}, accessors,
accessors, reducer,
reducer, )
) switch result {
rNewElem->E.R2.fmap(newElem => { | IEvBool(true) => true
switch newElem { | _ => false
| IEvBool(true) => list{elem, ...acc} }
| _ => acc })->Wrappers.evArray
}
})
})
)
let result =
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
result
} }
} }
@ -216,7 +201,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), IEvLambda(lambda)] => | [IEvArray(array), IEvLambda(lambda)] =>
Internals.map(array, accessors, lambda, reducer)->E.R2.errMap(_ => "Error!") Ok(Internals.map(array, accessors, lambda, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -236,9 +221,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) => ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
switch inputs { switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] => | [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Internals.reduce(array, initialValue, lambda, accessors, reducer)->E.R2.errMap(_ => Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer))
"Error!"
)
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -258,13 +241,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
switch inputs { switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] => | [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Internals.reduceReverse( Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer))
array,
initialValue,
lambda,
accessors,
reducer,
)->E.R2.errMap(_ => "Error!")
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),
@ -284,7 +261,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) => ~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
switch inputs { switch inputs {
| [IEvArray(array), IEvLambda(lambda)] => | [IEvArray(array), IEvLambda(lambda)] =>
Internals.filter(array, lambda, accessors, reducer)->E.R2.errMap(_ => "Error!") Ok(Internals.filter(array, lambda, accessors, reducer))
| _ => Error(impossibleError) | _ => Error(impossibleError)
}, },
(), (),

2
packages/squiggle-lang/src/rescript/FunctionRegistry/Library/FR_Pointset.res
View File

@ -37,7 +37,7 @@ module Internal = {
let doLambdaCall = (aLambdaValue, list, environment, reducer) => let doLambdaCall = (aLambdaValue, list, environment, reducer) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) { switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
| Ok(IEvNumber(f)) => Ok(f) | IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction) | _ => Error(Operation.SampleMapNeedsNtoNFunction)
} }

2
packages/squiggle-lang/src/rescript/FunctionRegistry/Library/FR_Sampleset.res
View File

@ -16,7 +16,7 @@ module Internal = {
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
) => ) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) { switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
| Ok(IEvNumber(f)) => Ok(f) | IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction) | _ => Error(Operation.SampleMapNeedsNtoNFunction)
} }

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

@ -3,6 +3,7 @@ module BindingsReplacer = Reducer_Expression_BindingsReplacer
module Continuation = ReducerInterface_Value_Continuation module Continuation = ReducerInterface_Value_Continuation
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary module ExternalLibrary = ReducerInterface.ExternalLibrary
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Lambda = Reducer_Expression_Lambda module Lambda = Reducer_Expression_Lambda
module MathJs = Reducer_MathJs module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
@ -111,7 +112,7 @@ let callInternal = (
module SampleMap = { module SampleMap = {
let doLambdaCall = (aLambdaValue, list) => let doLambdaCall = (aLambdaValue, list) =>
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) { switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
| Ok(IEvNumber(f)) => Ok(f) | IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction) | _ => Error(Operation.SampleMapNeedsNtoNFunction)
} }
@ -201,13 +202,17 @@ let dispatch = (
call: functionCall, call: functionCall,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
): result<internalExpressionValue, errorValue> => ): internalExpressionValue =>
try { try {
let (fn, args) = call let (fn, args) = call
// There is a bug that prevents string match in patterns // There is a bug that prevents string match in patterns
// So we have to recreate a copy of the string // So we have to recreate a copy of the string
ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal) ExternalLibrary.dispatch(
(Js.String.make(fn), args),
accessors,
reducer,
callInternal,
)->InternalExpressionValue.resultToValue
} catch { } catch {
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error | exn => Reducer_ErrorValue.fromException(exn)->Reducer_ErrorValue.toException
| _ => RETodo("unhandled rescript exception")->Error
} }

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

@ -12,11 +12,9 @@ module ExpressionWithContext = Reducer_ExpressionWithContext
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
module ProjectReducerFnT = ReducerProject_ReducerFn_T module ProjectReducerFnT = ReducerProject_ReducerFn_T
module Result = Belt.Result
open Reducer_Expression_ExpressionBuilder open Reducer_Expression_ExpressionBuilder
type errorValue = ErrorValue.errorValue
type expression = ExpressionT.expression type expression = ExpressionT.expression
type expressionWithContext = ExpressionWithContext.expressionWithContext type expressionWithContext = ExpressionWithContext.expressionWithContext
@ -25,21 +23,15 @@ let dispatchMacroCall = (
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t, reduceExpression: ProjectReducerFnT.t,
): result<expressionWithContext, errorValue> => { ): expressionWithContext => {
let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => { let useExpressionToSetBindings = (bindingExpr: expression, accessors, statement, newCode) => {
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, accessors) let nameSpaceValue = reduceExpression(bindingExpr, bindings, accessors)
rExternalBindingsValue->Result.flatMap(nameSpaceValue => { let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
let newBindings = Bindings.fromExpressionValue(nameSpaceValue)
let rNewStatement = BindingsReplacer.replaceSymbols(newBindings, statement) let boundStatement = BindingsReplacer.replaceSymbols(newBindings, statement)
rNewStatement->Result.map(boundStatement =>
ExpressionWithContext.withContext( ExpressionWithContext.withContext(newCode(newBindings->eModule, boundStatement), newBindings)
newCode(newBindings->eModule, boundStatement),
newBindings,
)
)
})
} }
let correspondingSetBindingsFn = (fnName: string): string => let correspondingSetBindingsFn = (fnName: string): string =>
@ -52,7 +44,7 @@ let dispatchMacroCall = (
} }
let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => { let doBindStatement = (bindingExpr: expression, statement: expression, accessors) => {
let defaultStatement = ErrorValue.REAssignmentExpected->Error let defaultStatement = ErrorValue.REAssignmentExpected
switch statement { switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => { | ExpressionT.EList(list{ExpressionT.EValue(IEvCall(callName)), symbolExpr, statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName) let setBindingsFn = correspondingSetBindingsFn(callName)
@ -62,17 +54,18 @@ let dispatchMacroCall = (
boundStatement, boundStatement,
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})) ) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
} else { } else {
defaultStatement defaultStatement->Reducer_ErrorValue.toException
} }
} }
| _ => defaultStatement | _ => defaultStatement->Reducer_ErrorValue.toException
} }
} }
let doBindExpression = (bindingExpr: expression, statement: expression, accessors): result< let doBindExpression = (
expressionWithContext, bindingExpr: expression,
errorValue, statement: expression,
> => { accessors,
): expressionWithContext => {
let defaultStatement = () => let defaultStatement = () =>
useExpressionToSetBindings(bindingExpr, accessors, statement, ( useExpressionToSetBindings(bindingExpr, accessors, statement, (
_newBindingsExpr, _newBindingsExpr,
@ -100,10 +93,11 @@ let dispatchMacroCall = (
} }
} }
let doBlock = (exprs: list<expression>, _bindings: ExpressionT.bindings, _accessors): result< let doBlock = (
expressionWithContext, exprs: list<expression>,
errorValue, _bindings: ExpressionT.bindings,
> => { _accessors,
): expressionWithContext => {
let exprsArray = Belt.List.toArray(exprs) let exprsArray = Belt.List.toArray(exprs)
let maxIndex = Js.Array2.length(exprsArray) - 1 let maxIndex = Js.Array2.length(exprsArray) - 1
let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) => let newStatement = exprsArray->Js.Array2.reducei((acc, statement, index) =>
@ -119,14 +113,14 @@ let dispatchMacroCall = (
eBindStatement(acc, statement) eBindStatement(acc, statement)
} }
, eSymbol("undefined block")) , eSymbol("undefined block"))
ExpressionWithContext.noContext(newStatement)->Ok ExpressionWithContext.noContext(newStatement)
} }
let doLambdaDefinition = ( let doLambdaDefinition = (
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,
parameters: array<string>, parameters: array<string>,
lambdaDefinition: ExpressionT.expression, lambdaDefinition: ExpressionT.expression,
) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))->Ok ) => ExpressionWithContext.noContext(eLambda(parameters, bindings, lambdaDefinition))
let doTernary = ( let doTernary = (
condition: expression, condition: expression,
@ -134,28 +128,28 @@ let dispatchMacroCall = (
ifFalse: expression, ifFalse: expression,
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,
accessors, accessors,
): result<expressionWithContext, errorValue> => { ): expressionWithContext => {
let blockCondition = ExpressionBuilder.eBlock(list{condition}) let blockCondition = ExpressionBuilder.eBlock(list{condition})
let rCondition = reduceExpression(blockCondition, bindings, accessors) let conditionValue = reduceExpression(blockCondition, bindings, accessors)
rCondition->Result.flatMap(conditionValue =>
switch conditionValue { switch conditionValue {
| InternalExpressionValue.IEvBool(false) => { | InternalExpressionValue.IEvBool(false) => {
let ifFalseBlock = eBlock(list{ifFalse}) let ifFalseBlock = eBlock(list{ifFalse})
ExpressionWithContext.withContext(ifFalseBlock, bindings)->Ok ExpressionWithContext.withContext(ifFalseBlock, bindings)
}
| InternalExpressionValue.IEvBool(true) => {
let ifTrueBlock = eBlock(list{ifTrue})
ExpressionWithContext.withContext(ifTrueBlock, bindings)->Ok
}
| _ => REExpectedType("Boolean", "")->Error
} }
) | InternalExpressionValue.IEvBool(true) => {
let ifTrueBlock = eBlock(list{ifTrue})
ExpressionWithContext.withContext(ifTrueBlock, bindings)
}
| _ => REExpectedType("Boolean", "")->Reducer_ErrorValue.toException
}
} }
let expandExpressionList = (aList, bindings: ExpressionT.bindings, accessors): result< let expandExpressionList = (
expressionWithContext, aList,
errorValue, bindings: ExpressionT.bindings,
> => accessors,
): expressionWithContext =>
switch aList { switch aList {
| list{ | list{
ExpressionT.EValue(IEvCall("$$_bindStatement_$$")), ExpressionT.EValue(IEvCall("$$_bindStatement_$$")),
@ -185,11 +179,11 @@ let dispatchMacroCall = (
doLambdaDefinition(bindings, parameters, lambdaDefinition) doLambdaDefinition(bindings, parameters, lambdaDefinition)
| list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} => | list{ExpressionT.EValue(IEvCall("$$_ternary_$$")), condition, ifTrue, ifFalse} =>
doTernary(condition, ifTrue, ifFalse, bindings, accessors) doTernary(condition, ifTrue, ifFalse, bindings, accessors)
| _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))->Ok | _ => ExpressionWithContext.noContext(ExpressionT.EList(aList))
} }
switch macroExpression { switch macroExpression {
| EList(aList) => expandExpressionList(aList, bindings, accessors) | EList(aList) => expandExpressionList(aList, bindings, accessors)
| _ => ExpressionWithContext.noContext(macroExpression)->Ok | _ => ExpressionWithContext.noContext(macroExpression)
} }
} }

19
packages/squiggle-lang/src/rescript/Reducer/Reducer_ErrorValue.res
View File

@ -26,6 +26,8 @@ type errorValue =
type t = errorValue type t = errorValue
exception ErrorException(errorValue)
let errorToString = err => let errorToString = err =>
switch err { switch err {
| REArityError(_oFnName, arity, usedArity) => | REArityError(_oFnName, arity, usedArity) =>
@ -62,3 +64,20 @@ let errorToString = err =>
| RENeedToRun => "Need to run" | RENeedToRun => "Need to run"
| REOther(msg) => `Error: ${msg}` | REOther(msg) => `Error: ${msg}`
} }
let fromException = exn =>
switch exn {
| ErrorException(e) => e
| Js.Exn.Error(e) =>
switch Js.Exn.message(e) {
| Some(message) => REOther(message)
| None =>
switch Js.Exn.name(e) {
| Some(name) => REOther(name)
| None => REOther("Unknown error")
}
}
| _e => REOther("Unknown error")
}
let toException = (errorValue: t) => raise(ErrorException(errorValue))

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

@ -21,10 +21,10 @@ let rec reduceExpressionInProject = (
expression: t, expression: t,
continuation: T.bindings, continuation: T.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
): result<InternalExpressionValue.t, 'e> => { ): InternalExpressionValue.t => {
// Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`) // Js.log(`reduce: ${T.toString(expression)} bindings: ${bindings->Bindings.toString}`)
switch expression { switch expression {
| T.EValue(value) => value->Ok | T.EValue(value) => value
| T.EList(list) => | T.EList(list) =>
switch list { switch list {
| list{EValue(IEvCall(fName)), ..._args} => | list{EValue(IEvCall(fName)), ..._args} =>
@ -41,20 +41,12 @@ and reduceExpressionList = (
expressions: list<t>, expressions: list<t>,
continuation: T.bindings, continuation: T.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
): result<InternalExpressionValue.t, 'e> => { ): InternalExpressionValue.t => {
let racc: result< let acc: list<InternalExpressionValue.t> =
list<InternalExpressionValue.t>, expressions->Belt.List.reduceReverse(list{}, (acc, each: t) =>
'e, acc->Belt.List.add(each->reduceExpressionInProject(continuation, accessors))
> = expressions->Belt.List.reduceReverse(Ok(list{}), (racc, each: t) => )
racc->Result.flatMap(acc => { acc->reduceValueList(accessors)
each
->reduceExpressionInProject(continuation, accessors)
->Result.map(newNode => {
acc->Belt.List.add(newNode)
})
})
)
racc->Result.flatMap(acc => acc->reduceValueList(accessors))
} }
/* /*
@ -63,48 +55,34 @@ and reduceExpressionList = (
and reduceValueList = ( and reduceValueList = (
valueList: list<InternalExpressionValue.t>, valueList: list<InternalExpressionValue.t>,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
): result<InternalExpressionValue.t, 'e> => ): InternalExpressionValue.t =>
switch valueList { switch valueList {
| list{IEvCall(fName), ...args} => { | list{IEvCall(fName), ...args} => {
let rCheckedArgs = switch fName { let checkedArgs = switch fName {
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args->Ok | "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args
| _ => args->Lambda.checkIfReduced | _ => args->Lambda.checkIfReduced
} }
rCheckedArgs->Result.flatMap(checkedArgs => (fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch(
(fName, checkedArgs->Belt.List.toArray)->BuiltIn.dispatch( accessors,
accessors, reduceExpressionInProject,
reduceExpressionInProject,
)
) )
} }
| list{IEvLambda(_)} => | list{IEvLambda(_)} =>
// TODO: remove on solving issue#558 // TODO: remove on solving issue#558
valueList valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
->Lambda.checkIfReduced
->Result.flatMap(reducedValueList =>
reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok
)
| list{IEvLambda(lambdaCall), ...args} => | list{IEvLambda(lambdaCall), ...args} =>
args args
->Lambda.checkIfReduced ->Lambda.checkIfReduced
->Result.flatMap(checkedArgs => ->Lambda.doLambdaCall(lambdaCall, _, accessors, reduceExpressionInProject)
Lambda.doLambdaCall(lambdaCall, checkedArgs, accessors, reduceExpressionInProject) | _ => valueList->Lambda.checkIfReduced->Belt.List.toArray->InternalExpressionValue.IEvArray
)
| _ =>
valueList
->Lambda.checkIfReduced
->Result.flatMap(reducedValueList =>
reducedValueList->Belt.List.toArray->InternalExpressionValue.IEvArray->Ok
)
} }
let reduceReturningBindings = ( let reduceReturningBindings = (
expression: t, expression: t,
continuation: T.bindings, continuation: T.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
): (result<InternalExpressionValue.t, 'e>, T.bindings) => { ): (InternalExpressionValue.t, T.bindings) => {
let states = accessors.states let states = accessors.states
let result = reduceExpressionInProject(expression, continuation, accessors) let result = reduceExpressionInProject(expression, continuation, accessors)
(result, states.continuation) (result, states.continuation)
@ -118,7 +96,11 @@ module BackCompatible = {
let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => { let evaluate = (expression: t): result<InternalExpressionValue.t, errorValue> => {
let accessors = ProjectAccessorsT.identityAccessors let accessors = ProjectAccessorsT.identityAccessors
expression->reduceExpressionInProject(accessors.stdLib, accessors) try {
expression->reduceExpressionInProject(accessors.stdLib, accessors)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
} }
let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> => let evaluateString = (peggyCode: string): result<InternalExpressionValue.t, errorValue> =>

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

@ -18,12 +18,14 @@ type expressionWithContext =
| ExpressionWithContext(expression, context) | ExpressionWithContext(expression, context)
| ExpressionNoContext(expression) | ExpressionNoContext(expression)
type t = expressionWithContext
let callReducer = ( let callReducer = (
expressionWithContext: expressionWithContext, expressionWithContext: expressionWithContext,
bindings: bindings, bindings: bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
): result<internalExpressionValue, errorValue> => { ): internalExpressionValue => {
switch expressionWithContext { switch expressionWithContext {
| ExpressionNoContext(expr) => | ExpressionNoContext(expr) =>
// Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`) // Js.log(`callReducer: bindings ${Bindings.toString(bindings)} expr ${ExpressionT.toString(expr)}`)
@ -51,3 +53,10 @@ let toStringResult = rExpressionWithContext =>
| Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})` | Ok(expressionWithContext) => `Ok(${toString(expressionWithContext)})`
| Error(errorValue) => ErrorValue.errorToString(errorValue) | Error(errorValue) => ErrorValue.errorToString(errorValue)
} }
let resultToValue = (rExpressionWithContext: result<t, errorValue>): t => {
switch rExpressionWithContext {
| Ok(expressionWithContext) => expressionWithContext
| Error(errorValue) => ErrorValue.toException(errorValue)
}
}

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

@ -1,7 +1,6 @@
module ErrorValue = Reducer_ErrorValue module ErrorValue = Reducer_ErrorValue
module ExpressionT = Reducer_Expression_T module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Result = Belt.Result
module Bindings = Reducer_Bindings module Bindings = Reducer_Bindings
type errorValue = Reducer_ErrorValue.errorValue type errorValue = Reducer_ErrorValue.errorValue
@ -10,19 +9,15 @@ type internalExpressionValue = InternalExpressionValue.t
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$") let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")
let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): result< let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression): expression =>
expression,
errorValue,
> =>
switch expression { switch expression {
| ExpressionT.EValue(value) => | ExpressionT.EValue(value) => replaceSymbolOnValue(bindings, value)->ExpressionT.EValue
replaceSymbolOnValue(bindings, value)->Result.map(evValue => evValue->ExpressionT.EValue)
| ExpressionT.EList(list) => | ExpressionT.EList(list) =>
switch list { switch list {
| list{EValue(IEvCall(fName)), ..._args} => | list{EValue(IEvCall(fName)), ..._args} =>
switch isMacroName(fName) { switch isMacroName(fName) {
// A macro reduces itself so we dont dive in it // A macro reduces itself so we dont dive in it
| true => expression->Ok | true => expression
| false => replaceSymbolsOnExpressionList(bindings, list) | false => replaceSymbolsOnExpressionList(bindings, list)
} }
| _ => replaceSymbolsOnExpressionList(bindings, list) | _ => replaceSymbolsOnExpressionList(bindings, list)
@ -30,23 +25,21 @@ let rec replaceSymbols = (bindings: ExpressionT.bindings, expression: expression
} }
and replaceSymbolsOnExpressionList = (bindings, list) => { and replaceSymbolsOnExpressionList = (bindings, list) => {
let racc = list->Belt.List.reduceReverse(Ok(list{}), (racc, each: expression) => let racc =
racc->Result.flatMap(acc => { list->Belt.List.reduceReverse(list{}, (acc, each: expression) =>
replaceSymbols(bindings, each)->Result.flatMap(newNode => { replaceSymbols(bindings, each)->Belt.List.add(acc, _)
acc->Belt.List.add(newNode)->Ok )
}) ExpressionT.EList(racc)
})
)
racc->Result.map(acc => acc->ExpressionT.EList)
} }
and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) => and replaceSymbolOnValue = (bindings, evValue: internalExpressionValue) =>
switch evValue { switch evValue {
| IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->Ok | IEvSymbol(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)
| IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable | IEvCall(symbol) => Bindings.getWithDefault(bindings, symbol, evValue)->checkIfCallable
| _ => evValue->Ok | _ => evValue
} }
and checkIfCallable = (evValue: internalExpressionValue) => and checkIfCallable = (evValue: internalExpressionValue) =>
switch evValue { switch evValue {
| IEvCall(_) | IEvLambda(_) => evValue->Ok | IEvCall(_) | IEvLambda(_) => evValue
| _ => ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->Error | _ =>
ErrorValue.RENotAFunction(InternalExpressionValue.toString(evValue))->ErrorValue.toException
} }

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

@ -23,26 +23,24 @@ let checkArity = (
let argsLength = Belt.List.length(args) let argsLength = Belt.List.length(args)
let parametersLength = Js.Array2.length(lambdaValue.parameters) let parametersLength = Js.Array2.length(lambdaValue.parameters)
if argsLength !== parametersLength { if argsLength !== parametersLength {
ErrorValue.REArityError(None, parametersLength, argsLength)->Error ErrorValue.REArityError(None, parametersLength, argsLength)->ErrorValue.toException
} else { } else {
args->Ok args
} }
} }
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body) let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
switch exprOrFFI { switch exprOrFFI {
| NotFFI(_) => reallyCheck | NotFFI(_) => reallyCheck
| FFI(_) => args->Ok | FFI(_) => args
} }
} }
let checkIfReduced = (args: list<internalExpressionValue>) => let checkIfReduced = (args: list<internalExpressionValue>) =>
args->Belt.List.reduceReverse(Ok(list{}), (rAcc, arg) => args->Belt.List.reduceReverse(list{}, (acc, arg) =>
rAcc->Result.flatMap(acc => switch arg {
switch arg { | IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->ErrorValue.toException
| IEvSymbol(symbol) => ErrorValue.RESymbolNotFound(symbol)->Error | _ => list{arg, ...acc}
| _ => list{arg, ...acc}->Ok }
}
)
) )
let caseNotFFI = ( let caseNotFFI = (
@ -63,7 +61,10 @@ let caseNotFFI = (
} }
let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => { let caseFFI = (ffiFn: ExpressionT.ffiFn, args, accessors: ProjectAccessorsT.t) => {
ffiFn(args->Belt.List.toArray, accessors.environment) switch ffiFn(args->Belt.List.toArray, accessors.environment) {
| Ok(value) => value
| Error(value) => value->ErrorValue.toException
}
} }
let applyParametersToLambda = ( let applyParametersToLambda = (
@ -71,16 +72,13 @@ let applyParametersToLambda = (
args, args,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
): result<internalExpressionValue, 'e> => { ): internalExpressionValue => {
checkArity(lambdaValue, args)->Result.flatMap(args => let args = checkArity(lambdaValue, args)->checkIfReduced
checkIfReduced(args)->Result.flatMap(args => { let exprOrFFI = castInternalCodeToExpression(lambdaValue.body)
let exprOrFFI = castInternalCodeToExpression(lambdaValue.body) switch exprOrFFI {
switch exprOrFFI { | NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer)
| NotFFI(expr) => caseNotFFI(lambdaValue, expr, args, accessors, reducer) | FFI(ffiFn) => caseFFI(ffiFn, args, accessors)
| FFI(ffiFn) => caseFFI(ffiFn, args, accessors) }
}
})
)
} }
let doLambdaCall = ( let doLambdaCall = (
@ -95,7 +93,7 @@ let foreignFunctionInterface = (
argArray: array<internalExpressionValue>, argArray: array<internalExpressionValue>,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t, reducer: ProjectReducerFnT.t,
): result<internalExpressionValue, Reducer_ErrorValue.errorValue> => { ): internalExpressionValue => {
let args = argArray->Belt.List.fromArray let args = argArray->Belt.List.fromArray
applyParametersToLambda(lambdaValue, args, accessors, reducer) applyParametersToLambda(lambdaValue, args, accessors, reducer)
} }

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

@ -10,32 +10,34 @@ type expression = ExpressionT.expression
type internalExpressionValue = InternalExpressionValue.t type internalExpressionValue = InternalExpressionValue.t
type expressionWithContext = ExpressionWithContext.expressionWithContext type expressionWithContext = ExpressionWithContext.expressionWithContext
let expandMacroCall = ( let expandMacroCallRs = (
macroExpression: expression, macroExpression: expression,
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t, reduceExpression: ProjectReducerFnT.t,
): result<expressionWithContext, 'e> => ): result<expressionWithContext, 'e> =>
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall( try {
macroExpression, Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
bindings, macroExpression,
accessors, bindings,
reduceExpression, accessors,
) reduceExpression,
)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
let doMacroCall = ( let doMacroCall = (
macroExpression: expression, macroExpression: expression,
bindings: ExpressionT.bindings, bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t, accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t, reduceExpression: ProjectReducerFnT.t,
): result<internalExpressionValue, 'e> => ): internalExpressionValue =>
expandMacroCall( Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression, macroExpression,
bindings, bindings,
(accessors: ProjectAccessorsT.t), (accessors: ProjectAccessorsT.t),
(reduceExpression: ProjectReducerFnT.t), (reduceExpression: ProjectReducerFnT.t),
)->Result.flatMap(expressionWithContext => )->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
ExpressionWithContext.callReducer(expressionWithContext, bindings, accessors, reduceExpression)
)
let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$") let isMacroName = (fName: string): bool => fName->Js.String2.startsWith("$$")

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

@ -82,3 +82,9 @@ type optionFfiFnReturningResult = (
type expressionOrFFI = type expressionOrFFI =
| NotFFI(expression) | NotFFI(expression)
| FFI(ffiFn) | FFI(ffiFn)
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
switch rExpression {
| Ok(expression) => expression
| Error(errorValue) => Reducer_ErrorValue.toException(errorValue)
}

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

@ -15,16 +15,12 @@ let ievFromTypeExpression = (
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}` let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => { Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
let accessors = ProjectAccessorsT.identityAccessors let accessors = ProjectAccessorsT.identityAccessors
let result = reducerFn(expr, Bindings.emptyBindings, accessors) let _result = reducerFn(expr, Bindings.emptyBindings, accessors)
let nameSpace = accessors.states.continuation let nameSpace = accessors.states.continuation
switch result { switch Bindings.getType(nameSpace, sIndex) {
| Ok(_) => | Some(value) => value->Ok
switch Bindings.getType(nameSpace, sIndex) { | None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
| Some(value) => value->Ok
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
}
| err => err
} }
}) })
} }

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

@ -244,3 +244,9 @@ let nameSpaceGet = (nameSpace: nameSpace, key: string): option<t> => {
let NameSpace(container) = nameSpace let NameSpace(container) = nameSpace
container->Belt.Map.String.get(key) container->Belt.Map.String.get(key)
} }
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
switch rExpression {
| Ok(expression) => expression
| Error(errorValue) => Reducer_ErrorValue.toException(errorValue)
}

20
packages/squiggle-lang/src/rescript/ReducerProject/ReducerProject_ProjectItem.res
View File

@ -183,17 +183,6 @@ let buildExpression = (this: t): t => {
} }
} }
let wrappedReducer = (
rExpression: T.expressionArgumentType,
aContinuation: T.continuation,
accessors: ProjectAccessorsT.t,
): T.resultArgumentType => {
Belt.Result.flatMap(
rExpression,
Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors),
)
}
let doBuildResult = ( let doBuildResult = (
this: t, this: t,
aContinuation: T.continuation, aContinuation: T.continuation,
@ -202,9 +191,12 @@ let doBuildResult = (
this this
->getExpression ->getExpression
->Belt.Option.map( ->Belt.Option.map(
Belt.Result.flatMap( Belt.Result.flatMap(_, expression =>
_, try {
Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors), Reducer_Expression.reduceExpressionInProject(expression, aContinuation, accessors)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
), ),
) )

6
packages/squiggle-lang/src/rescript/ReducerProject/ReducerProject_ReducerFn_T.res
View File

@ -2,8 +2,4 @@ module ExpressionT = Reducer_Expression_T
module InternalExpressionValue = ReducerInterface_InternalExpressionValue module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
type t = ( type t = (ExpressionT.t, ExpressionT.bindings, ProjectAccessorsT.t) => InternalExpressionValue.t
ExpressionT.t,
ExpressionT.bindings,
ProjectAccessorsT.t,
) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>

929
packages/squiggle-lang/src/rescript/Utility/E.res
View File

@ -5,912 +5,23 @@ running `rescript convert -all` on Rationale https://github.com/jonlaing/rationa
let equals = (a, b) => a === b let equals = (a, b) => a === b
module FloatFloatMap = { module A = E_A
module Id = Belt.Id.MakeComparable({ module A2 = E_A2
type t = float module B = E_B
let cmp: (float, float) => int = Pervasives.compare module Dict = E_Dict
}) module F = E_F
module Float = E_Float
type t = Belt.MutableMap.t<Id.t, float, Id.identity> module FloatFloatMap = E_FloatFloatMap
module I = E_I
let fromArray = (ar: array<(float, float)>) => Belt.MutableMap.fromArray(ar, ~id=module(Id)) module Int = E_Int
let toArray = (t: t): array<(float, float)> => Belt.MutableMap.toArray(t) module J = E_J
let empty = () => Belt.MutableMap.make(~id=module(Id)) module JsDate = E_JsDate
let increment = (el, t: t) => module L = E_L
Belt.MutableMap.update(t, el, x => module O = E_O
switch x { module O2 = E_O2
| Some(n) => Some(n +. 1.0) module R = E_R
| None => Some(1.0) module R2 = E_R2
} module S = E_S
) module Tuple2 = E_Tuple2
module Tuple3 = E_Tuple3
let get = (el, t: t) => Belt.MutableMap.get(t, el) module U = E_U
let fmap = (fn, t: t) => Belt.MutableMap.map(t, fn)
let partition = (fn, t: t) => {
let (match, noMatch) = Belt.Array.partition(toArray(t), fn)
(fromArray(match), fromArray(noMatch))
}
}
module Int = {
let max = (i1: int, i2: int) => i1 > i2 ? i1 : i2
let random = (~min, ~max) => Js.Math.random_int(min, max)
}
/* Utils */
module U = {
let isEqual = \"=="
let toA = a => [a]
let id = e => e
}
module Tuple2 = {
let first = (v: ('a, 'b)) => {
let (a, _) = v
a
}
let second = (v: ('a, 'b)) => {
let (_, b) = v
b
}
let toFnCall = (fn, (a1, a2)) => fn(a1, a2)
}
module Tuple3 = {
let toFnCall = (fn, (a1, a2, a3)) => fn(a1, a2, a3)
}
module O = {
let dimap = (sFn, rFn, e) =>
switch e {
| Some(r) => sFn(r)
| None => rFn()
}
()
let fmap = (f: 'a => 'b, x: option<'a>): option<'b> => {
switch x {
| None => None
| Some(x') => Some(f(x'))
}
}
let bind = (o, f) =>
switch o {
| None => None
| Some(a) => f(a)
}
let default = (d, o) =>
switch o {
| None => d
| Some(a) => a
}
let defaultFn = (d, o) =>
switch o {
| None => d()
| Some(a) => a
}
let isSome = o =>
switch o {
| Some(_) => true
| _ => false
}
let isNone = o =>
switch o {
| None => true
| _ => false
}
let toExn = (err, o) =>
switch o {
| None => raise(Failure(err))
| Some(a) => a
}
let some = a => Some(a)
let firstSome = (a, b) =>
switch a {
| None => b
| _ => a
}
let toExt = toExn
let flatten = o =>
switch o {
| None => None
| Some(x) => x
}
let apply = (o, a) =>
switch o {
| Some(f) => bind(a, b => some(f(b)))
| _ => None
}
let flatApply = (fn, b) => apply(fn, Some(b)) |> flatten
let toBool = opt =>
switch opt {
| Some(_) => true
| _ => false
}
let ffmap = (fn, r) =>
switch r {
| Some(sm) => fn(sm)
| _ => None
}
let toString = opt =>
switch opt {
| Some(s) => s
| _ => ""
}
let toResult = (error, e) =>
switch e {
| Some(r) => Belt.Result.Ok(r)
| None => Error(error)
}
let compare = (compare, f1: option<float>, f2: option<float>) =>
switch (f1, f2) {
| (Some(f1), Some(f2)) => Some(compare(f1, f2) ? f1 : f2)
| (Some(f1), None) => Some(f1)
| (None, Some(f2)) => Some(f2)
| (None, None) => None
}
let min = compare(\"<")
let max = compare(\">")
}
module O2 = {
let default = (a, b) => O.default(b, a)
let defaultFn = (a, b) => O.defaultFn(b, a)
let toExn = (a, b) => O.toExn(b, a)
let fmap = (a, b) => O.fmap(b, a)
let toResult = (a, b) => O.toResult(b, a)
let bind = (a, b) => O.bind(b, a)
}
/* Functions */
module F = {
let pipe = (f, g, x) => g(f(x))
let compose = (f, g, x) => f(g(x))
let flip = (f, a, b) => f(b, a)
let always = (x, _y) => x
let apply = (a, e) => a |> e
let flatten2Callbacks = (fn1, fn2, fnlast) =>
fn1(response1 => fn2(response2 => fnlast(response1, response2)))
let flatten3Callbacks = (fn1, fn2, fn3, fnlast) =>
fn1(response1 => fn2(response2 => fn3(response3 => fnlast(response1, response2, response3))))
let flatten4Callbacks = (fn1, fn2, fn3, fn4, fnlast) =>
fn1(response1 =>
fn2(response2 =>
fn3(response3 => fn4(response4 => fnlast(response1, response2, response3, response4)))
)
)
}
module Bool = {
type t = bool
let toString = (t: t) => t ? "TRUE" : "FALSE"
let fromString = str => str == "TRUE" ? true : false
module O = {
let toBool = opt =>
switch opt {
| Some(true) => true
| _ => false
}
}
}
module Float = {
let with2DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=2)
let with3DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=3)
let toFixed = Js.Float.toFixed
let toString = Js.Float.toString
let isFinite = Js.Float.isFinite
let toInt = Belt.Float.toInt
}
module I = {
let increment = n => n + 1
let decrement = n => n - 1
let toString = Js.Int.toString
let toFloat = Js.Int.toFloat
}
exception Assertion(string)
/* R for Result */
module R = {
open Belt.Result
let result = (okF, errF, r) =>
switch r {
| Ok(a) => okF(a)
| Error(err) => errF(err)
}
let id = e => e |> result(U.id, U.id)
let isOk = Belt.Result.isOk
let getError = (r: result<'a, 'b>) =>
switch r {
| Ok(_) => None
| Error(e) => Some(e)
}
let fmap = (f: 'a => 'b, r: result<'a, 'c>): result<'b, 'c> => {
switch r {
| Ok(r') => Ok(f(r'))
| Error(err) => Error(err)
}
}
let bind = (r, f) =>
switch r {
| Ok(a) => f(a)
| Error(err) => Error(err)
}
let toExn = (msg: string, x: result<'a, 'b>): 'a =>
switch x {
| Ok(r) => r
| Error(_) => raise(Assertion(msg))
}
let toExnFnString = (errorToStringFn, o) =>
switch o {
| Ok(r) => r
| Error(r) => raise(Assertion(errorToStringFn(r)))
}
let default = (default, res: Belt.Result.t<'a, 'b>) =>
switch res {
| Ok(r) => r
| Error(_) => default
}
let merge = (a, b) =>
switch (a, b) {
| (Error(e), _) => Error(e)
| (_, Error(e)) => Error(e)
| (Ok(a), Ok(b)) => Ok((a, b))
}
let toOption = (e: Belt.Result.t<'a, 'b>) =>
switch e {
| Ok(r) => Some(r)
| Error(_) => None
}
let errorIfCondition = (errorCondition, errorMessage, r) =>
errorCondition(r) ? Error(errorMessage) : Ok(r)
let ap = (r, a) =>
switch r {
| Ok(f) => Ok(f(a))
| Error(err) => Error(err)
}
let ap' = (r, a) =>
switch r {
| Ok(f) => fmap(f, a)
| Error(err) => Error(err)
}
let liftM2: (('a, 'b) => 'c, result<'a, 'd>, result<'b, 'd>) => result<'c, 'd> = (op, xR, yR) => {
ap'(fmap(op, xR), yR)
}
let liftJoin2: (('a, 'b) => result<'c, 'd>, result<'a, 'd>, result<'b, 'd>) => result<'c, 'd> = (
op,
xR,
yR,
) => {
bind(liftM2(op, xR, yR), x => x)
}
let fmap2 = (f, r) =>
switch r {
| Ok(r) => r->Ok
| Error(x) => x->f->Error
}
//I'm not sure what to call this.
let unify = (a: result<'a, 'b>, c: 'b => 'a): 'a =>
switch a {
| Ok(x) => x
| Error(x) => c(x)
}
}
module R2 = {
let fmap = (a, b) => R.fmap(b, a)
let bind = (a, b) => R.bind(b, a)
//Converts result type to change error type only
let errMap = (a: result<'a, 'b>, map: 'b => 'c): result<'a, 'c> =>
switch a {
| Ok(r) => Ok(r)
| Error(e) => Error(map(e))
}
let fmap2 = (xR, f) =>
switch xR {
| Ok(x) => x->Ok
| Error(x) => x->f->Error
}
let toExn = (a, b) => R.toExn(b, a)
}
let safe_fn_of_string = (fn, s: string): option<'a> =>
try Some(fn(s)) catch {
| _ => None
}
module S = {
let safe_float = float_of_string->safe_fn_of_string
let safe_int = int_of_string->safe_fn_of_string
let default = (defaultStr, str) => str == "" ? defaultStr : str
}
module J = {
let toString = F.pipe(Js.Json.decodeString, O.default(""))
let fromString = Js.Json.string
let fromNumber = Js.Json.number
module O = {
let fromString = (str: string) =>
switch str {
| "" => None
| _ => Some(Js.Json.string(str))
}
let toString = (str: option<'a>) =>
switch str {
| Some(str) => Some(str |> F.pipe(Js.Json.decodeString, O.default("")))
| _ => None
}
}
}
module JsDate = {
let fromString = Js.Date.fromString
let now = Js.Date.now
let make = Js.Date.make
let valueOf = Js.Date.valueOf
}
/* List */
module L = {
module Util = {
let eq = \"=="
}
let fmap = List.map
let get = Belt.List.get
let toArray = Array.of_list
let fmapi = List.mapi
let concat = List.concat
let concat' = (xs, ys) => List.append(ys, xs)
let rec drop = (i, xs) =>
switch (i, xs) {
| (_, list{}) => list{}
| (i, _) if i <= 0 => xs
| (i, list{_, ...b}) => drop(i - 1, b)
}
let append = (a, xs) => List.append(xs, list{a})
let take = {
let rec loop = (i, xs, acc) =>
switch (i, xs) {
| (i, _) if i <= 0 => acc
| (_, list{}) => acc
| (i, list{a, ...b}) => loop(i - 1, b, append(a, acc))
}
(i, xs) => loop(i, xs, list{})
}
let takeLast = (i, xs) => List.rev(xs) |> take(i) |> List.rev
let splitAt = (i, xs) => (take(i, xs), takeLast(List.length(xs) - i, xs))
let remove = (i, n, xs) => {
let (a, b) = splitAt(i, xs)
\"@"(a, drop(n, b))
}
let find = List.find
let filter = List.filter
let for_all = List.for_all
let exists = List.exists
let sort = List.sort
let length = List.length
let filter_opt = xs => {
let rec loop = (l, acc) =>
switch l {
| list{} => acc
| list{hd, ...tl} =>
switch hd {
| None => loop(tl, acc)
| Some(x) => loop(tl, list{x, ...acc})
}
}
List.rev(loop(xs, list{}))
}
let containsWith = f => List.exists(f)
let uniqWithBy = (eq, f, xs) =>
List.fold_left(
((acc, tacc), v) =>
containsWith(eq(f(v)), tacc) ? (acc, tacc) : (append(v, acc), append(f(v), tacc)),
(list{}, list{}),
xs,
) |> fst
let uniqBy = (f, xs) => uniqWithBy(Util.eq, f, xs)
let join = j => List.fold_left((acc, v) => String.length(acc) == 0 ? v : acc ++ (j ++ v), "")
let head = xs =>
switch List.hd(xs) {
| exception _ => None
| a => Some(a)
}
let uniq = xs => uniqBy(x => x, xs)
let flatten = List.flatten
let last = xs => xs |> List.rev |> head
let append = List.append
let getBy = Belt.List.getBy
let dropLast = (i, xs) => take(List.length(xs) - i, xs)
let containsWith = f => List.exists(f)
let contains = x => containsWith(Util.eq(x))
let reject = pred => List.filter(x => !pred(x))
let tail = xs =>
switch List.tl(xs) {
| exception _ => None
| a => Some(a)
}
let init = xs => {
O.fmap(List.rev, xs |> List.rev |> tail)
}
let singleton = (x: 'a): list<'a> => list{x}
let adjust = (f, i, xs) => {
let (a, b) = splitAt(i + 1, xs)
switch a {
| _ if i < 0 => xs
| _ if i >= List.length(xs) => xs
| list{} => b
| list{a} => list{f(a), ...b}
| a =>
O.fmap(
concat'(b),
O.bind(init(a), x =>
O.fmap(F.flip(append, x), O.fmap(fmap(f), O.fmap(singleton, last(a))))
),
) |> O.default(xs)
}
}
let without = (exclude, xs) => reject(x => contains(x, exclude), xs)
let update = (x, i, xs) => adjust(F.always(x), i, xs)
let iter = List.iter
let findIndex = {
let rec loop = (pred, xs, i) =>
switch xs {
| list{} => None
| list{a, ...b} => pred(a) ? Some(i) : loop(pred, b, i + 1)
}
(pred, xs) => loop(pred, xs, 0)
}
let headSafe = Belt.List.head
let tailSafe = Belt.List.tail
let headExn = Belt.List.headExn
let tailExn = Belt.List.tailExn
let zip = Belt.List.zip
let combinations2: list<'a> => list<('a, 'a)> = xs => {
let rec loop: ('a, list<'a>) => list<('a, 'a)> = (x', xs') => {
let n = length(xs')
if n == 0 {
list{}
} else {
let combs = fmap(y => (x', y), xs')
let hd = headExn(xs')
let tl = tailExn(xs')
concat(list{combs, loop(hd, tl)})
}
}
switch (headSafe(xs), tailSafe(xs)) {
| (Some(x'), Some(xs')) => loop(x', xs')
| (_, _) => list{}
}
}
}
/* A for Array */
module A = {
let fmap = Array.map
let fmapi = Array.mapi
let to_list = Array.to_list
let of_list = Array.of_list
let length = Array.length
let append = Array.append
// let empty = [||];
let unsafe_get = Array.unsafe_get
let get = Belt.Array.get
let getBy = Belt.Array.getBy
let getIndexBy = Belt.Array.getIndexBy
let last = a => get(a, length(a) - 1)
let first = get(_, 0)
let hasBy = (r, fn) => Belt.Array.getBy(r, fn) |> O.isSome
let fold_left = Array.fold_left
let fold_right = Array.fold_right
let concat = Belt.Array.concat
let concatMany = Belt.Array.concatMany
let keepMap = Belt.Array.keepMap
let slice = Belt.Array.slice
let init = Array.init
let reduce = Belt.Array.reduce
let reduceReverse = Belt.Array.reduceReverse
let reducei = Belt.Array.reduceWithIndex
let some = Belt.Array.some
let isEmpty = r => length(r) < 1
let stableSortBy = Belt.SortArray.stableSortBy
let toNoneIfEmpty = r => isEmpty(r) ? None : Some(r)
let toRanges = (a: array<'a>) =>
switch a |> Belt.Array.length {
| 0
| 1 =>
Belt.Result.Error("Must be at least 2 elements")
| n =>
Belt.Array.makeBy(n - 1, r => r)
|> Belt.Array.map(_, index => (
Belt.Array.getUnsafe(a, index),
Belt.Array.getUnsafe(a, index + 1),
))
|> (x => Ok(x))
}
let getByFmap = (a, fn, boolCondition) => {
let i = ref(0)
let finalFunctionValue = ref(None)
let length = Belt.Array.length(a)
while i.contents < length && finalFunctionValue.contents == None {
let itemWithFnApplied = Belt.Array.getUnsafe(a, i.contents) |> fn
if boolCondition(itemWithFnApplied) {
finalFunctionValue := Some(itemWithFnApplied)
}
i := i.contents + 1
}
finalFunctionValue.contents
}
let tail = Belt.Array.sliceToEnd(_, 1)
let zip = Belt.Array.zip
let unzip = Belt.Array.unzip
let zip3 = (a, b, c) =>
Belt.Array.zip(a, b)->Belt.Array.zip(c)->Belt.Array.map((((v1, v2), v3)) => (v1, v2, v3))
// This zips while taking the longest elements of each array.
let zipMaxLength = (array1, array2) => {
let maxLength = Int.max(length(array1), length(array2))
let result = maxLength |> Belt.Array.makeUninitializedUnsafe
for i in 0 to maxLength - 1 {
Belt.Array.set(result, i, (get(array1, i), get(array2, i))) |> ignore
}
result
}
let asList = (f: list<'a> => list<'a>, r: array<'a>) => r |> to_list |> f |> of_list
/* TODO: Is there a better way of doing this? */
let uniq = r => asList(L.uniq, r)
//intersperse([1,2,3], [10,11,12]) => [1,10,2,11,3,12]
let intersperse = (a: array<'a>, b: array<'a>) => {
let items: ref<array<'a>> = ref([])
Belt.Array.forEachWithIndex(a, (i, item) =>
switch Belt.Array.get(b, i) {
| Some(r) => items := append(items.contents, [item, r])
| None => items := append(items.contents, [item])
}
)
items.contents
}
// This is like map, but
//accumulate((a,b) => a + b, [1,2,3]) => [1, 3, 5]
let accumulate = (fn: ('a, 'a) => 'a, items: array<'a>) => {
let length = items |> length
let empty = Belt.Array.make(length, items |> unsafe_get(_, 0))
Belt.Array.forEachWithIndex(items, (index, element) => {
let item = switch index {
| 0 => element
| index => fn(element, unsafe_get(empty, index - 1))
}
let _ = Belt.Array.set(empty, index, item)
})
empty
}
// @todo: Is -1 still the indicator that this is false (as is true with
// @todo: js findIndex)? Wasn't sure.
let findIndex = (e, i) =>
Js.Array.findIndex(e, i) |> (
r =>
switch r {
| -1 => None
| r => Some(r)
}
)
let filter = Js.Array.filter
let joinWith = Js.Array.joinWith
let transpose = (xs: array<array<'a>>): array<array<'a>> => {
let arr: array<array<'a>> = []
for i in 0 to length(xs) - 1 {
for j in 0 to length(xs[i]) - 1 {
if Js.Array.length(arr) <= j {
ignore(Js.Array.push([xs[i][j]], arr))
} else {
ignore(Js.Array.push(xs[i][j], arr[j]))
}
}
}
arr
}
let all = (p: 'a => bool, xs: array<'a>): bool => length(filter(p, xs)) == length(xs)
let any = (p: 'a => bool, xs: array<'a>): bool => length(filter(p, xs)) > 0
module O = {
let concatSomes = (optionals: array<option<'a>>): array<'a> =>
optionals
|> Js.Array.filter(O.isSome)
|> Js.Array.map(O.toExn("Warning: This should not have happened"))
let defaultEmpty = (o: option<array<'a>>): array<'a> =>
switch o {
| Some(o) => o
| None => []
}
// REturns `None` there are no non-`None` elements
let rec arrSomeToSomeArr = (optionals: array<option<'a>>): option<array<'a>> => {
let optionals' = optionals->Belt.List.fromArray
switch optionals' {
| list{} => []->Some
| list{x, ...xs} =>
switch x {
| Some(_) => xs->Belt.List.toArray->arrSomeToSomeArr
| None => None
}
}
}
let firstSome = x => Belt.Array.getBy(x, O.isSome)
let firstSomeFn = (r: array<unit => option<'a>>): option<'a> =>
O.flatten(getByFmap(r, l => l(), O.isSome))
let firstSomeFnWithDefault = (r, default) => firstSomeFn(r)->O2.default(default)
let openIfAllSome = (optionals: array<option<'a>>): option<array<'a>> => {
if all(O.isSome, optionals) {
Some(optionals |> fmap(O.toExn("Warning: This should not have happened")))
} else {
None
}
}
}
module R = {
let firstErrorOrOpen = (results: array<Belt.Result.t<'a, 'b>>): Belt.Result.t<
array<'a>,
'b,
> => {
let bringErrorUp = switch results |> Belt.Array.getBy(_, Belt.Result.isError) {
| Some(Belt.Result.Error(err)) => Belt.Result.Error(err)
| Some(Belt.Result.Ok(_)) => Belt.Result.Ok(results)
| None => Belt.Result.Ok(results)
}
let forceOpen = (r: array<Belt.Result.t<'a, 'b>>): array<'a> =>
r |> Belt.Array.map(_, r => Belt.Result.getExn(r))
bringErrorUp |> Belt.Result.map(_, forceOpen)
}
let filterOk = (x: array<result<'a, 'b>>): array<'a> => fmap(R.toOption, x)->O.concatSomes
let forM = (x: array<'a>, fn: 'a => result<'b, 'c>): result<array<'b>, 'c> =>
firstErrorOrOpen(fmap(fn, x))
let foldM = (fn: ('c, 'a) => result<'b, 'e>, init: 'c, x: array<'a>): result<'c, 'e> => {
let acc = ref(init)
let final = ref(Ok())
let break = ref(false)
let i = ref(0)
while break.contents != true && i.contents < length(x) {
switch fn(acc.contents, x[i.contents]) {
| Ok(r) => acc := r
| Error(err) => {
final := Error(err)
break := true
}
}
i := i.contents + 1
}
switch final.contents {
| Ok(_) => Ok(acc.contents)
| Error(err) => Error(err)
}
}
}
module Floats = {
type t = array<float>
let mean = Jstat.mean
let geomean = Jstat.geomean
let mode = Jstat.mode
let variance = Jstat.variance
let stdev = Jstat.stdev
let sum = Jstat.sum
let product = Jstat.product
let random = Js.Math.random_int
let floatCompare: (float, float) => int = compare
let sort = t => {
let r = t
r |> Array.fast_sort(floatCompare)
r
}
let getNonFinite = (t: t) => Belt.Array.getBy(t, r => !Js.Float.isFinite(r))
let getBelowZero = (t: t) => Belt.Array.getBy(t, r => r < 0.0)
let isSorted = (t: t): bool =>
if Array.length(t) < 1 {
true
} else {
reduce(zip(t, tail(t)), true, (acc, (first, second)) => acc && first < second)
}
//Passing true for the exclusive parameter excludes both endpoints of the range.
//https://jstat.github.io/all.html
let percentile = (a, b) => Jstat.percentile(a, b, false)
// Gives an array with all the differences between values
// diff([1,5,3,7]) = [4,-2,4]
let diff = (t: t): array<float> =>
Belt.Array.zipBy(t, Belt.Array.sliceToEnd(t, 1), (left, right) => right -. left)
let cumSum = (t: t): array<float> => accumulate((a, b) => a +. b, t)
let cumProd = (t: t): array<float> => accumulate((a, b) => a *. b, t)
exception RangeError(string)
let range = (min: float, max: float, n: int): array<float> =>
switch n {
| 0 => []
| 1 => [min]
| 2 => [min, max]
| _ if min == max => Belt.Array.make(n, min)
| _ if n < 0 => raise(RangeError("n must be greater than 0"))
| _ if min > max => raise(RangeError("Min value is less then max value"))
| _ =>
let diff = (max -. min) /. Belt.Float.fromInt(n - 1)
Belt.Array.makeBy(n, i => min +. Belt.Float.fromInt(i) *. diff)
}
let min = Js.Math.minMany_float
let max = Js.Math.maxMany_float
module Sorted = {
let min = first
let max = last
let range = (~min=min, ~max=max, a) =>
switch (min(a), max(a)) {
| (Some(min), Some(max)) => Some(max -. min)
| _ => None
}
let binarySearchFirstElementGreaterIndex = (ar: array<'a>, el: 'a) => {
let el = Belt.SortArray.binarySearchBy(ar, el, floatCompare)
let el = el < 0 ? el * -1 - 1 : el
switch el {
| e if e >= length(ar) => #overMax
| e if e == 0 => #underMin
| e => #firstHigher(e)
}
}
let concat = (t1: array<'a>, t2: array<'a>) => Belt.Array.concat(t1, t2)->sort
let concatMany = (t1: array<array<'a>>) => Belt.Array.concatMany(t1)->sort
let makeIncrementalUp = (a, b) =>
Array.make(b - a + 1, a) |> Array.mapi((i, c) => c + i) |> Belt.Array.map(_, float_of_int)
let makeIncrementalDown = (a, b) =>
Array.make(a - b + 1, a) |> Array.mapi((i, c) => c - i) |> Belt.Array.map(_, float_of_int)
/*
This function goes through a sorted array and divides it into two different clusters:
continuous samples and discrete samples. The discrete samples are stored in a mutable map.
Samples are thought to be discrete if they have any duplicates.
*/
let _splitContinuousAndDiscreteForDuplicates = (sortedArray: array<float>) => {
let continuous: array<float> = []
let discrete = FloatFloatMap.empty()
Belt.Array.forEachWithIndex(sortedArray, (index, element) => {
let maxIndex = (sortedArray |> Array.length) - 1
let possiblySimilarElements = switch index {
| 0 => [index + 1]
| n if n == maxIndex => [index - 1]
| _ => [index - 1, index + 1]
} |> Belt.Array.map(_, r => sortedArray[r])
let hasSimilarElement = Belt.Array.some(possiblySimilarElements, r => r == element)
hasSimilarElement
? FloatFloatMap.increment(element, discrete)
: {
let _ = Js.Array.push(element, continuous)
}
()
})
(continuous, discrete)
}
/*
This function works very similarly to splitContinuousAndDiscreteForDuplicates. The one major difference
is that you can specify a minDiscreteWeight. If the min discreet weight is 4, that would mean that
at least four elements needed from a specific value for that to be kept as discrete. This is important
because in some cases, we can expect that some common elements will be generated by regular operations.
The final continous array will be sorted.
*/
let splitContinuousAndDiscreteForMinWeight = (
sortedArray: array<float>,
~minDiscreteWeight: int,
) => {
let (continuous, discrete) = _splitContinuousAndDiscreteForDuplicates(sortedArray)
let keepFn = v => Belt.Float.toInt(v) >= minDiscreteWeight
let (discreteToKeep, discreteToIntegrate) = FloatFloatMap.partition(
((_, v)) => keepFn(v),
discrete,
)
let newContinousSamples =
discreteToIntegrate->FloatFloatMap.toArray
|> fmap(((k, v)) => Belt.Array.makeBy(Belt.Float.toInt(v), _ => k))
|> Belt.Array.concatMany
let newContinuous = concat(continuous, newContinousSamples)
newContinuous |> Array.fast_sort(floatCompare)
(newContinuous, discreteToKeep)
}
}
}
module Sorted = Floats.Sorted
}
module A2 = {
let fmap = (a, b) => A.fmap(b, a)
let fmapi = (a, b) => A.fmapi(b, a)
let joinWith = (a, b) => A.joinWith(b, a)
let filter = (a, b) => A.filter(b, a)
}
module JsArray = {
let concatSomes = (optionals: Js.Array.t<option<'a>>): Js.Array.t<'a> =>
optionals
|> Js.Array.filter(O.isSome)
|> Js.Array.map(O.toExn("Warning: This should not have happened"))
let filter = Js.Array.filter
}
module Dict = {
type t<'a> = Js.Dict.t<'a>
let get = Js.Dict.get
let keys = Js.Dict.keys
let fromArray = Js.Dict.fromArray
let toArray = Js.Dict.entries
let concat = (a, b) => A.concat(toArray(a), toArray(b))->fromArray
let concatMany = ts => ts->A2.fmap(toArray)->A.concatMany->fromArray
}

360
packages/squiggle-lang/src/rescript/Utility/E/E_A.res Normal file
View File

@ -0,0 +1,360 @@
/* A for Array */
// module O = E_O
module Int = E_Int
module L = E_L
module FloatFloatMap = E_FloatFloatMap
let fmap = Array.map
let fmapi = Array.mapi
let to_list = Array.to_list
let of_list = Array.of_list
let length = Array.length
let append = Array.append
// let empty = [||];
let unsafe_get = Array.unsafe_get
let get = Belt.Array.get
let getBy = Belt.Array.getBy
let getIndexBy = Belt.Array.getIndexBy
let last = a => get(a, length(a) - 1)
let first = get(_, 0)
let hasBy = (r, fn) => Belt.Array.getBy(r, fn) |> E_O.isSome
let fold_left = Array.fold_left
let fold_right = Array.fold_right
let concat = Belt.Array.concat
let concatMany = Belt.Array.concatMany
let keepMap = Belt.Array.keepMap
let slice = Belt.Array.slice
let init = Array.init
let reduce = Belt.Array.reduce
let reduceReverse = Belt.Array.reduceReverse
let reducei = Belt.Array.reduceWithIndex
let some = Belt.Array.some
let isEmpty = r => length(r) < 1
let stableSortBy = Belt.SortArray.stableSortBy
let toNoneIfEmpty = r => isEmpty(r) ? None : Some(r)
let toRanges = (a: array<'a>) =>
switch a |> Belt.Array.length {
| 0
| 1 =>
Belt.Result.Error("Must be at least 2 elements")
| n =>
Belt.Array.makeBy(n - 1, r => r)
|> Belt.Array.map(_, index => (
Belt.Array.getUnsafe(a, index),
Belt.Array.getUnsafe(a, index + 1),
))
|> (x => Ok(x))
}
let getByFmap = (a, fn, boolCondition) => {
let i = ref(0)
let finalFunctionValue = ref(None)
let length = Belt.Array.length(a)
while i.contents < length && finalFunctionValue.contents == None {
let itemWithFnApplied = Belt.Array.getUnsafe(a, i.contents) |> fn
if boolCondition(itemWithFnApplied) {
finalFunctionValue := Some(itemWithFnApplied)
}
i := i.contents + 1
}
finalFunctionValue.contents
}
let tail = Belt.Array.sliceToEnd(_, 1)
let zip = Belt.Array.zip
let unzip = Belt.Array.unzip
let zip3 = (a, b, c) =>
Belt.Array.zip(a, b)->Belt.Array.zip(c)->Belt.Array.map((((v1, v2), v3)) => (v1, v2, v3))
// This zips while taking the longest elements of each array.
let zipMaxLength = (array1, array2) => {
let maxLength = Int.max(length(array1), length(array2))
let result = maxLength |> Belt.Array.makeUninitializedUnsafe
for i in 0 to maxLength - 1 {
Belt.Array.set(result, i, (get(array1, i), get(array2, i))) |> ignore
}
result
}
let asList = (f: list<'a> => list<'a>, r: array<'a>) => r |> to_list |> f |> of_list
/* TODO: Is there a better way of doing this? */
let uniq = r => asList(L.uniq, r)
//intersperse([1,2,3], [10,11,12]) => [1,10,2,11,3,12]
let intersperse = (a: array<'a>, b: array<'a>) => {
let items: ref<array<'a>> = ref([])
Belt.Array.forEachWithIndex(a, (i, item) =>
switch Belt.Array.get(b, i) {
| Some(r) => items := append(items.contents, [item, r])
| None => items := append(items.contents, [item])
}
)
items.contents
}
// This is like map, but
//accumulate((a,b) => a + b, [1,2,3]) => [1, 3, 5]
let accumulate = (fn: ('a, 'a) => 'a, items: array<'a>) => {
let length = items |> length
let empty = Belt.Array.make(length, items |> unsafe_get(_, 0))
Belt.Array.forEachWithIndex(items, (index, element) => {
let item = switch index {
| 0 => element
| index => fn(element, unsafe_get(empty, index - 1))
}
let _ = Belt.Array.set(empty, index, item)
})
empty
}
// @todo: Is -1 still the indicator that this is false (as is true with
// @todo: js findIndex)? Wasn't sure.
let findIndex = (e, i) =>
Js.Array.findIndex(e, i) |> (
r =>
switch r {
| -1 => None
| r => Some(r)
}
)
let filter = Js.Array.filter
let joinWith = Js.Array.joinWith
let transpose = (xs: array<array<'a>>): array<array<'a>> => {
let arr: array<array<'a>> = []
for i in 0 to length(xs) - 1 {
for j in 0 to length(xs[i]) - 1 {
if Js.Array.length(arr) <= j {
ignore(Js.Array.push([xs[i][j]], arr))
} else {
ignore(Js.Array.push(xs[i][j], arr[j]))
}
}
}
arr
}
let all = (p: 'a => bool, xs: array<'a>): bool => length(filter(p, xs)) == length(xs)
let any = (p: 'a => bool, xs: array<'a>): bool => length(filter(p, xs)) > 0
module O = {
let concatSomes = (optionals: array<option<'a>>): array<'a> =>
optionals
|> Js.Array.filter(E_O.isSome)
|> Js.Array.map(E_O.toExn("Warning: This should not have happened"))
let defaultEmpty = (o: option<array<'a>>): array<'a> =>
switch o {
| Some(o) => o
| None => []
}
// REturns `None` there are no non-`None` elements
let rec arrSomeToSomeArr = (optionals: array<option<'a>>): option<array<'a>> => {
let optionals' = optionals->Belt.List.fromArray
switch optionals' {
| list{} => []->Some
| list{x, ...xs} =>
switch x {
| Some(_) => xs->Belt.List.toArray->arrSomeToSomeArr
| None => None
}
}
}
let firstSome = x => Belt.Array.getBy(x, E_O.isSome)
let firstSomeFn = (r: array<unit => option<'a>>): option<'a> =>
E_O.flatten(getByFmap(r, l => l(), E_O.isSome))
let firstSomeFnWithDefault = (r, default) => firstSomeFn(r)->E_O2.default(default)
let openIfAllSome = (optionals: array<option<'a>>): option<array<'a>> => {
if all(E_O.isSome, optionals) {
Some(optionals |> fmap(E_O.toExn("Warning: This should not have happened")))
} else {
None
}
}
}
module R = {
let firstErrorOrOpen = (results: array<Belt.Result.t<'a, 'b>>): Belt.Result.t<array<'a>, 'b> => {
let bringErrorUp = switch results |> Belt.Array.getBy(_, Belt.Result.isError) {
| Some(Belt.Result.Error(err)) => Belt.Result.Error(err)
| Some(Belt.Result.Ok(_)) => Belt.Result.Ok(results)
| None => Belt.Result.Ok(results)
}
let forceOpen = (r: array<Belt.Result.t<'a, 'b>>): array<'a> =>
r |> Belt.Array.map(_, r => Belt.Result.getExn(r))
bringErrorUp |> Belt.Result.map(_, forceOpen)
}
let filterOk = (x: array<result<'a, 'b>>): array<'a> => fmap(E_R.toOption, x)->O.concatSomes
let forM = (x: array<'a>, fn: 'a => result<'b, 'c>): result<array<'b>, 'c> =>
firstErrorOrOpen(fmap(fn, x))
let foldM = (fn: ('c, 'a) => result<'b, 'e>, init: 'c, x: array<'a>): result<'c, 'e> => {
let acc = ref(init)
let final = ref(Ok())
let break = ref(false)
let i = ref(0)
while break.contents != true && i.contents < length(x) {
switch fn(acc.contents, x[i.contents]) {
| Ok(r) => acc := r
| Error(err) => {
final := Error(err)
break := true
}
}
i := i.contents + 1
}
switch final.contents {
| Ok(_) => Ok(acc.contents)
| Error(err) => Error(err)
}
}
}
module Floats = {
type t = array<float>
let mean = Jstat.mean
let geomean = Jstat.geomean
let mode = Jstat.mode
let variance = Jstat.variance
let stdev = Jstat.stdev
let sum = Jstat.sum
let product = Jstat.product
let random = Js.Math.random_int
let floatCompare: (float, float) => int = compare
let sort = t => {
let r = t
r |> Array.fast_sort(floatCompare)
r
}
let getNonFinite = (t: t) => Belt.Array.getBy(t, r => !Js.Float.isFinite(r))
let getBelowZero = (t: t) => Belt.Array.getBy(t, r => r < 0.0)
let isSorted = (t: t): bool =>
if Array.length(t) < 1 {
true
} else {
reduce(zip(t, tail(t)), true, (acc, (first, second)) => acc && first < second)
}
//Passing true for the exclusive parameter excludes both endpoints of the range.
//https://jstat.github.io/all.html
let percentile = (a, b) => Jstat.percentile(a, b, false)
// Gives an array with all the differences between values
// diff([1,5,3,7]) = [4,-2,4]
let diff = (t: t): array<float> =>
Belt.Array.zipBy(t, Belt.Array.sliceToEnd(t, 1), (left, right) => right -. left)
let cumSum = (t: t): array<float> => accumulate((a, b) => a +. b, t)
let cumProd = (t: t): array<float> => accumulate((a, b) => a *. b, t)
exception RangeError(string)
let range = (min: float, max: float, n: int): array<float> =>
switch n {
| 0 => []
| 1 => [min]
| 2 => [min, max]
| _ if min == max => Belt.Array.make(n, min)
| _ if n < 0 => raise(RangeError("n must be greater than 0"))
| _ if min > max => raise(RangeError("Min value is less then max value"))
| _ =>
let diff = (max -. min) /. Belt.Float.fromInt(n - 1)
Belt.Array.makeBy(n, i => min +. Belt.Float.fromInt(i) *. diff)
}
let min = Js.Math.minMany_float
let max = Js.Math.maxMany_float
module Sorted = {
let min = first
let max = last
let range = (~min=min, ~max=max, a) =>
switch (min(a), max(a)) {
| (Some(min), Some(max)) => Some(max -. min)
| _ => None
}
let binarySearchFirstElementGreaterIndex = (ar: array<'a>, el: 'a) => {
let el = Belt.SortArray.binarySearchBy(ar, el, floatCompare)
let el = el < 0 ? el * -1 - 1 : el
switch el {
| e if e >= length(ar) => #overMax
| e if e == 0 => #underMin
| e => #firstHigher(e)
}
}
let concat = (t1: array<'a>, t2: array<'a>) => Belt.Array.concat(t1, t2)->sort
let concatMany = (t1: array<array<'a>>) => Belt.Array.concatMany(t1)->sort
let makeIncrementalUp = (a, b) =>
Array.make(b - a + 1, a) |> Array.mapi((i, c) => c + i) |> Belt.Array.map(_, float_of_int)
let makeIncrementalDown = (a, b) =>
Array.make(a - b + 1, a) |> Array.mapi((i, c) => c - i) |> Belt.Array.map(_, float_of_int)
/*
This function goes through a sorted array and divides it into two different clusters:
continuous samples and discrete samples. The discrete samples are stored in a mutable map.
Samples are thought to be discrete if they have any duplicates.
*/
let _splitContinuousAndDiscreteForDuplicates = (sortedArray: array<float>) => {
let continuous: array<float> = []
let discrete = FloatFloatMap.empty()
Belt.Array.forEachWithIndex(sortedArray, (index, element) => {
let maxIndex = (sortedArray |> Array.length) - 1
let possiblySimilarElements = switch index {
| 0 => [index + 1]
| n if n == maxIndex => [index - 1]
| _ => [index - 1, index + 1]
} |> Belt.Array.map(_, r => sortedArray[r])
let hasSimilarElement = Belt.Array.some(possiblySimilarElements, r => r == element)
hasSimilarElement
? FloatFloatMap.increment(element, discrete)
: {
let _ = Js.Array.push(element, continuous)
}
()
})
(continuous, discrete)
}
/*
This function works very similarly to splitContinuousAndDiscreteForDuplicates. The one major difference
is that you can specify a minDiscreteWeight. If the min discreet weight is 4, that would mean that
at least four elements needed from a specific value for that to be kept as discrete. This is important
because in some cases, we can expect that some common elements will be generated by regular operations.
The final continous array will be sorted.
*/
let splitContinuousAndDiscreteForMinWeight = (
sortedArray: array<float>,
~minDiscreteWeight: int,
) => {
let (continuous, discrete) = _splitContinuousAndDiscreteForDuplicates(sortedArray)
let keepFn = v => Belt.Float.toInt(v) >= minDiscreteWeight
let (discreteToKeep, discreteToIntegrate) = FloatFloatMap.partition(
((_, v)) => keepFn(v),
discrete,
)
let newContinousSamples =
discreteToIntegrate->FloatFloatMap.toArray
|> fmap(((k, v)) => Belt.Array.makeBy(Belt.Float.toInt(v), _ => k))
|> Belt.Array.concatMany
let newContinuous = concat(continuous, newContinousSamples)
newContinuous |> Array.fast_sort(floatCompare)
(newContinuous, discreteToKeep)
}
}
}
module Sorted = Floats.Sorted

5
packages/squiggle-lang/src/rescript/Utility/E/E_A2.res Normal file
View File

@ -0,0 +1,5 @@
module A = E_A
let fmap = (a, b) => A.fmap(b, a)
let fmapi = (a, b) => A.fmapi(b, a)
let joinWith = (a, b) => A.joinWith(b, a)
let filter = (a, b) => A.filter(b, a)

11
packages/squiggle-lang/src/rescript/Utility/E/E_B.res Normal file
View File

@ -0,0 +1,11 @@
type t = bool
let toString = (t: t) => t ? "TRUE" : "FALSE"
let fromString = str => str == "TRUE" ? true : false
module O = {
let toBool = opt =>
switch opt {
| Some(true) => true
| _ => false
}
}

10
packages/squiggle-lang/src/rescript/Utility/E/E_Dict.res Normal file
View File

@ -0,0 +1,10 @@
module A = E_A
module A2 = E_A2
type t<'a> = Js.Dict.t<'a>
let get = Js.Dict.get
let keys = Js.Dict.keys
let fromArray = Js.Dict.fromArray
let toArray = Js.Dict.entries
let concat = (a, b) => A.concat(toArray(a), toArray(b))->fromArray
let concatMany = ts => ts->A2.fmap(toArray)->A.concatMany->fromArray

20
packages/squiggle-lang/src/rescript/Utility/E/E_F.res Normal file
View File

@ -0,0 +1,20 @@
/* Functions */
let pipe = (f, g, x) => g(f(x))
let compose = (f, g, x) => f(g(x))
let flip = (f, a, b) => f(b, a)
let always = (x, _y) => x
let apply = (a, e) => a |> e
let flatten2Callbacks = (fn1, fn2, fnlast) =>
fn1(response1 => fn2(response2 => fnlast(response1, response2)))
let flatten3Callbacks = (fn1, fn2, fn3, fnlast) =>
fn1(response1 => fn2(response2 => fn3(response3 => fnlast(response1, response2, response3))))
let flatten4Callbacks = (fn1, fn2, fn3, fn4, fnlast) =>
fn1(response1 =>
fn2(response2 =>
fn3(response3 => fn4(response4 => fnlast(response1, response2, response3, response4)))
)
)

6
packages/squiggle-lang/src/rescript/Utility/E/E_Float.res Normal file
View File

@ -0,0 +1,6 @@
let with2DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=2)
let with3DigitsPrecision = Js.Float.toPrecisionWithPrecision(_, ~digits=3)
let toFixed = Js.Float.toFixed
let toString = Js.Float.toString
let isFinite = Js.Float.isFinite
let toInt = Belt.Float.toInt

24
packages/squiggle-lang/src/rescript/Utility/E/E_FloatFloatMap.res Normal file
View File

@ -0,0 +1,24 @@
module Id = Belt.Id.MakeComparable({
type t = float
let cmp: (float, float) => int = Pervasives.compare
})
type t = Belt.MutableMap.t<Id.t, float, Id.identity>
let fromArray = (ar: array<(float, float)>) => Belt.MutableMap.fromArray(ar, ~id=module(Id))
let toArray = (t: t): array<(float, float)> => Belt.MutableMap.toArray(t)
let empty = () => Belt.MutableMap.make(~id=module(Id))
let increment = (el, t: t) =>
Belt.MutableMap.update(t, el, x =>
switch x {
| Some(n) => Some(n +. 1.0)
| None => Some(1.0)
}
)
let get = (el, t: t) => Belt.MutableMap.get(t, el)
let fmap = (fn, t: t) => Belt.MutableMap.map(t, fn)
let partition = (fn, t: t) => {
let (match, noMatch) = Belt.Array.partition(toArray(t), fn)
(fromArray(match), fromArray(noMatch))
}

4
packages/squiggle-lang/src/rescript/Utility/E/E_I.res Normal file
View File

@ -0,0 +1,4 @@
let increment = n => n + 1
let decrement = n => n - 1
let toString = Js.Int.toString
let toFloat = Js.Int.toFloat

2
packages/squiggle-lang/src/rescript/Utility/E/E_Int.res Normal file
View File

@ -0,0 +1,2 @@
let max = (i1: int, i2: int) => i1 > i2 ? i1 : i2
let random = (~min, ~max) => Js.Math.random_int(min, max)

19
packages/squiggle-lang/src/rescript/Utility/E/E_J.res Normal file
View File

@ -0,0 +1,19 @@
module F = E_F
let toString = F.pipe(Js.Json.decodeString, E_O.default(""))
let fromString = Js.Json.string
let fromNumber = Js.Json.number
module O = {
let fromString = (str: string) =>
switch str {
| "" => None
| _ => Some(Js.Json.string(str))
}
let toString = (str: option<'a>) =>
switch str {
| Some(str) => Some(str |> F.pipe(Js.Json.decodeString, E_O.default("")))
| _ => None
}
}

6
packages/squiggle-lang/src/rescript/Utility/E/E_JsArray.res Normal file
View File

@ -0,0 +1,6 @@
module O = E_O
let concatSomes = (optionals: Js.Array.t<option<'a>>): Js.Array.t<'a> =>
optionals
|> Js.Array.filter(O.isSome)
|> Js.Array.map(O.toExn("Warning: This should not have happened"))
let filter = Js.Array.filter

4
packages/squiggle-lang/src/rescript/Utility/E/E_JsDate.res Normal file
View File

@ -0,0 +1,4 @@
let fromString = Js.Date.fromString
let now = Js.Date.now
let make = Js.Date.make
let valueOf = Js.Date.valueOf

151
packages/squiggle-lang/src/rescript/Utility/E/E_L.res Normal file
View File

@ -0,0 +1,151 @@
/* List */
module F = E_F
module O = E_O
module Util = {
let eq = \"=="
}
let fmap = List.map
let get = Belt.List.get
let toArray = Array.of_list
let fmapi = List.mapi
let concat = List.concat
let concat' = (xs, ys) => List.append(ys, xs)
let rec drop = (i, xs) =>
switch (i, xs) {
| (_, list{}) => list{}
| (i, _) if i <= 0 => xs
| (i, list{_, ...b}) => drop(i - 1, b)
}
let append = (a, xs) => List.append(xs, list{a})
let take = {
let rec loop = (i, xs, acc) =>
switch (i, xs) {
| (i, _) if i <= 0 => acc
| (_, list{}) => acc
| (i, list{a, ...b}) => loop(i - 1, b, append(a, acc))
}
(i, xs) => loop(i, xs, list{})
}
let takeLast = (i, xs) => List.rev(xs) |> take(i) |> List.rev
let splitAt = (i, xs) => (take(i, xs), takeLast(List.length(xs) - i, xs))
let remove = (i, n, xs) => {
let (a, b) = splitAt(i, xs)
\"@"(a, drop(n, b))
}
let find = List.find
let filter = List.filter
let for_all = List.for_all
let exists = List.exists
let sort = List.sort
let length = List.length
let filter_opt = xs => {
let rec loop = (l, acc) =>
switch l {
| list{} => acc
| list{hd, ...tl} =>
switch hd {
| None => loop(tl, acc)
| Some(x) => loop(tl, list{x, ...acc})
}
}
List.rev(loop(xs, list{}))
}
let containsWith = f => List.exists(f)
let uniqWithBy = (eq, f, xs) =>
List.fold_left(
((acc, tacc), v) =>
containsWith(eq(f(v)), tacc) ? (acc, tacc) : (append(v, acc), append(f(v), tacc)),
(list{}, list{}),
xs,
) |> fst
let uniqBy = (f, xs) => uniqWithBy(Util.eq, f, xs)
let join = j => List.fold_left((acc, v) => String.length(acc) == 0 ? v : acc ++ (j ++ v), "")
let head = xs =>
switch List.hd(xs) {
| exception _ => None
| a => Some(a)
}
let uniq = xs => uniqBy(x => x, xs)
let flatten = List.flatten
let last = xs => xs |> List.rev |> head
let append = List.append
let getBy = Belt.List.getBy
let dropLast = (i, xs) => take(List.length(xs) - i, xs)
let containsWith = f => List.exists(f)
let contains = x => containsWith(Util.eq(x))
let reject = pred => List.filter(x => !pred(x))
let tail = xs =>
switch List.tl(xs) {
| exception _ => None
| a => Some(a)
}
let init = xs => {
O.fmap(List.rev, xs |> List.rev |> tail)
}
let singleton = (x: 'a): list<'a> => list{x}
let adjust = (f, i, xs) => {
let (a, b) = splitAt(i + 1, xs)
switch a {
| _ if i < 0 => xs
| _ if i >= List.length(xs) => xs
| list{} => b
| list{a} => list{f(a), ...b}
| a =>
O.fmap(
concat'(b),
O.bind(init(a), x => O.fmap(F.flip(append, x), O.fmap(fmap(f), O.fmap(singleton, last(a))))),
) |> O.default(xs)
}
}
let without = (exclude, xs) => reject(x => contains(x, exclude), xs)
let update = (x, i, xs) => adjust(F.always(x), i, xs)
let iter = List.iter
let findIndex = {
let rec loop = (pred, xs, i) =>
switch xs {
| list{} => None
| list{a, ...b} => pred(a) ? Some(i) : loop(pred, b, i + 1)
}
(pred, xs) => loop(pred, xs, 0)
}
let headSafe = Belt.List.head
let tailSafe = Belt.List.tail
let headExn = Belt.List.headExn
let tailExn = Belt.List.tailExn
let zip = Belt.List.zip
let combinations2: list<'a> => list<('a, 'a)> = xs => {
let rec loop: ('a, list<'a>) => list<('a, 'a)> = (x', xs') => {
let n = length(xs')
if n == 0 {
list{}
} else {
let combs = fmap(y => (x', y), xs')
let hd = headExn(xs')
let tl = tailExn(xs')
concat(list{combs, loop(hd, tl)})
}
}
switch (headSafe(xs), tailSafe(xs)) {
| (Some(x'), Some(xs')) => loop(x', xs')
| (_, _) => list{}
}
}

99
packages/squiggle-lang/src/rescript/Utility/E/E_O.res Normal file
View File

@ -0,0 +1,99 @@
let dimap = (sFn, rFn, e) =>
switch e {
| Some(r) => sFn(r)
| None => rFn()
}
()
let fmap = (f: 'a => 'b, x: option<'a>): option<'b> => {
switch x {
| None => None
| Some(x') => Some(f(x'))
}
}
let bind = (o, f) =>
switch o {
| None => None
| Some(a) => f(a)
}
let default = (d, o) =>
switch o {
| None => d
| Some(a) => a
}
let defaultFn = (d, o) =>
switch o {
| None => d()
| Some(a) => a
}
let isSome = o =>
switch o {
| Some(_) => true
| _ => false
}
let isNone = o =>
switch o {
| None => true
| _ => false
}
let toExn = (err, o) =>
switch o {
| None => raise(Failure(err))
| Some(a) => a
}
let some = a => Some(a)
let firstSome = (a, b) =>
switch a {
| None => b
| _ => a
}
let toExt = toExn
let flatten = o =>
switch o {
| None => None
| Some(x) => x
}
let apply = (o, a) =>
switch o {
| Some(f) => bind(a, b => some(f(b)))
| _ => None
}
let flatApply = (fn, b) => apply(fn, Some(b)) |> flatten
let toBool = opt =>
switch opt {
| Some(_) => true
| _ => false
}
let ffmap = (fn, r) =>
switch r {
| Some(sm) => fn(sm)
| _ => None
}
let toString = opt =>
switch opt {
| Some(s) => s
| _ => ""
}
let toResult = (error, e) =>
switch e {
| Some(r) => Belt.Result.Ok(r)
| None => Error(error)
}
let compare = (compare, f1: option<float>, f2: option<float>) =>
switch (f1, f2) {
| (Some(f1), Some(f2)) => Some(compare(f1, f2) ? f1 : f2)
| (Some(f1), None) => Some(f1)
| (None, Some(f2)) => Some(f2)
| (None, None) => None
}
let min = compare(\"<")
let max = compare(\">")

7
packages/squiggle-lang/src/rescript/Utility/E/E_O2.res Normal file
View File

@ -0,0 +1,7 @@
module O = E_O
let default = (a, b) => O.default(b, a)
let defaultFn = (a, b) => O.defaultFn(b, a)
let toExn = (a, b) => O.toExn(b, a)
let fmap = (a, b) => O.fmap(b, a)
let toResult = (a, b) => O.toResult(b, a)
let bind = (a, b) => O.bind(b, a)

94
packages/squiggle-lang/src/rescript/Utility/E/E_R.res Normal file
View File

@ -0,0 +1,94 @@
/* R for Result */
exception Assertion(string)
module U = E_U
open Belt.Result
let result = (okF, errF, r) =>
switch r {
| Ok(a) => okF(a)
| Error(err) => errF(err)
}
let id = e => e |> result(U.id, U.id)
let isOk = Belt.Result.isOk
let getError = (r: result<'a, 'b>) =>
switch r {
| Ok(_) => None
| Error(e) => Some(e)
}
let fmap = (f: 'a => 'b, r: result<'a, 'c>): result<'b, 'c> => {
switch r {
| Ok(r') => Ok(f(r'))
| Error(err) => Error(err)
}
}
let bind = (r, f) =>
switch r {
| Ok(a) => f(a)
| Error(err) => Error(err)
}
let toExn = (msg: string, x: result<'a, 'b>): 'a =>
switch x {
| Ok(r) => r
| Error(_) => raise(Assertion(msg))
}
let toExnFnString = (errorToStringFn, o) =>
switch o {
| Ok(r) => r
| Error(r) => raise(Assertion(errorToStringFn(r)))
}
let default = (default, res: Belt.Result.t<'a, 'b>) =>
switch res {
| Ok(r) => r
| Error(_) => default
}
let merge = (a, b) =>
switch (a, b) {
| (Error(e), _) => Error(e)
| (_, Error(e)) => Error(e)
| (Ok(a), Ok(b)) => Ok((a, b))
}
let toOption = (e: Belt.Result.t<'a, 'b>) =>
switch e {
| Ok(r) => Some(r)
| Error(_) => None
}
let errorIfCondition = (errorCondition, errorMessage, r) =>
errorCondition(r) ? Error(errorMessage) : Ok(r)
let ap = (r, a) =>
switch r {
| Ok(f) => Ok(f(a))
| Error(err) => Error(err)
}
let ap' = (r, a) =>
switch r {
| Ok(f) => fmap(f, a)
| Error(err) => Error(err)
}
let liftM2: (('a, 'b) => 'c, result<'a, 'd>, result<'b, 'd>) => result<'c, 'd> = (op, xR, yR) => {
ap'(fmap(op, xR), yR)
}
let liftJoin2: (('a, 'b) => result<'c, 'd>, result<'a, 'd>, result<'b, 'd>) => result<'c, 'd> = (
op,
xR,
yR,
) => {
bind(liftM2(op, xR, yR), x => x)
}
let fmap2 = (f, r) =>
switch r {
| Ok(r) => r->Ok
| Error(x) => x->f->Error
}
//I'm not sure what to call this.
let unify = (a: result<'a, 'b>, c: 'b => 'a): 'a =>
switch a {
| Ok(x) => x
| Error(x) => c(x)
}

19
packages/squiggle-lang/src/rescript/Utility/E/E_R2.res Normal file
View File

@ -0,0 +1,19 @@
module R = E_R
let fmap = (a, b) => R.fmap(b, a)
let bind = (a, b) => R.bind(b, a)
//Converts result type to change error type only
let errMap = (a: result<'a, 'b>, map: 'b => 'c): result<'a, 'c> =>
switch a {
| Ok(r) => Ok(r)
| Error(e) => Error(map(e))
}
let fmap2 = (xR, f) =>
switch xR {
| Ok(x) => x->Ok
| Error(x) => x->f->Error
}
let toExn = (a, b) => R.toExn(b, a)

8
packages/squiggle-lang/src/rescript/Utility/E/E_S.res Normal file
View File

@ -0,0 +1,8 @@
let safe_fn_of_string = (fn, s: string): option<'a> =>
try Some(fn(s)) catch {
| _ => None
}
let safe_float = float_of_string->safe_fn_of_string
let safe_int = int_of_string->safe_fn_of_string
let default = (defaultStr, str) => str == "" ? defaultStr : str

9
packages/squiggle-lang/src/rescript/Utility/E/E_Tuple2.res Normal file
View File

@ -0,0 +1,9 @@
let first = (v: ('a, 'b)) => {
let (a, _) = v
a
}
let second = (v: ('a, 'b)) => {
let (_, b) = v
b
}
let toFnCall = (fn, (a1, a2)) => fn(a1, a2)

1
packages/squiggle-lang/src/rescript/Utility/E/E_Tuple3.res Normal file
View File

@ -0,0 +1 @@
let toFnCall = (fn, (a1, a2, a3)) => fn(a1, a2, a3)

4
packages/squiggle-lang/src/rescript/Utility/E/E_U.res Normal file
View File

@ -0,0 +1,4 @@
/* Utils */
let isEqual = \"=="
let toA = a => [a]
let id = e => e