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.
# Rescript
*.res @OAGr
*.resi @OAGr
*.res @berekuk @OAGr
*.resi @berekuk @OAGr
# Typescript
*.tsx @Hazelfire @OAGr
*.ts @Hazelfire @OAGr
*.tsx @Hazelfire @berekuk @OAGr
*.ts @Hazelfire @berekuk @OAGr
# Javascript
*.js @Hazelfire @OAGr
*.js @Hazelfire @berekuk @OAGr
# Any opsy files
.github/** @quinn-dougherty @OAGr
*.json @quinn-dougherty @Hazelfire @OAGr
*.y*ml @quinn-dougherty @OAGr
*.config.js @Hazelfire @OAGr
netlify.toml @quinn-dougherty @OAGr @Hazelfire
.github/** @quinn-doughert @berekuky @OAGr
*.json @quinn-dougherty @Hazelfire @berekuk @OAGr
*.y*ml @quinn-dougherty @berekuk @OAGr
*.config.js @Hazelfire @berekuk @OAGr
netlify.toml @quinn-dougherty @OAGr @berekuk @Hazelfire
# Documentation
*.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)
tester(expr->T.toString, () =>
expr
->Macro.expandMacroCall(
->Macro.expandMacroCallRs(
bindings,
ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject,
@ -44,6 +44,7 @@ let testMacroEval_ = (
ProjectAccessorsT.identityAccessors,
Expression.reduceExpressionInProject,
)
->Ok
->InternalExpressionValue.toStringResult
->expect
->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 rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr =>
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
)
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 rResult =
Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr =>
Expression.BackCompatible.parse(sourceCode)->Belt.Result.map(expr =>
reducerFn(expr, Bindings.emptyBindings, ProjectAccessorsT.identityAccessors)
)
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(
"javascript exception",
"javascriptraise('div by 0')",
"Error(JS Exception: Error: 'div by 0')",
"Error(Error: 'div by 0')",
)
// testDescriptionEvalToBe(
// "rescript exception",

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

@ -74,12 +74,11 @@ module Integration = {
reducer,
)
let result = switch resultAsInternalExpression {
| Ok(IEvNumber(x)) => Ok(x)
| Error(_) =>
| IEvNumber(x) => Ok(x)
| _ =>
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("Error 2 in Danger.integrate")
}
result
}
@ -143,7 +142,7 @@ module Integration = {
}
| Error(b) =>
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: " ++
b,
)
@ -309,14 +308,10 @@ module DiminishingReturns = {
reducer,
)
switch resultAsInternalExpression {
| Ok(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",
)
| IEvNumber(x) => Ok(x)
| _ =>
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",
)
}
}

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

@ -32,19 +32,15 @@ module Internals = {
accessors: ProjectAccessorsT.t,
eLambdaValue,
reducer: ProjectReducerFnT.t,
): result<ReducerInterface_InternalExpressionValue.t, Reducer_ErrorValue.errorValue> => {
let rMappedList = array->E.A.reduceReverse(Ok(list{}), (rAcc, elem) =>
rAcc->E.R.bind(_, acc => {
let rNewElem = Reducer_Expression_Lambda.doLambdaCall(
): ReducerInterface_InternalExpressionValue.t => {
Belt.Array.map(array, elem =>
Reducer_Expression_Lambda.doLambdaCall(
eLambdaValue,
list{elem},
(accessors: ProjectAccessorsT.t),
(reducer: ProjectReducerFnT.t),
)
rNewElem->E.R2.fmap(newElem => list{newElem, ...acc})
})
)
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
)->Wrappers.evArray
}
let reduce = (
@ -54,11 +50,9 @@ module Internals = {
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => {
aValueArray->E.A.reduce(Ok(initialValue), (rAcc, elem) =>
rAcc->E.R.bind(_, acc =>
aValueArray->E.A.reduce(initialValue, (acc, elem) =>
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
)
)
}
let reduceReverse = (
@ -68,11 +62,9 @@ module Internals = {
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => {
aValueArray->Belt.Array.reduceReverse(Ok(initialValue), (rAcc, elem) =>
rAcc->Belt.Result.flatMap(acc =>
aValueArray->Belt.Array.reduceReverse(initialValue, (acc, elem) =>
Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list{acc, elem}, accessors, reducer)
)
)
}
let filter = (
@ -81,25 +73,18 @@ module Internals = {
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
) => {
let rMappedList = aValueArray->Belt.Array.reduceReverse(Ok(list{}), (rAcc, elem) =>
rAcc->E.R.bind(_, acc => {
let rNewElem = Reducer_Expression_Lambda.doLambdaCall(
Js.Array2.filter(aValueArray, elem => {
let result = Reducer_Expression_Lambda.doLambdaCall(
aLambdaValue,
list{elem},
accessors,
reducer,
)
rNewElem->E.R2.fmap(newElem => {
switch newElem {
| IEvBool(true) => list{elem, ...acc}
| _ => acc
switch result {
| IEvBool(true) => true
| _ => false
}
})
})
)
let result =
rMappedList->E.R2.fmap(mappedList => mappedList->Belt.List.toArray->Wrappers.evArray)
result
})->Wrappers.evArray
}
}
@ -216,7 +201,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
switch inputs {
| [IEvArray(array), IEvLambda(lambda)] =>
Internals.map(array, accessors, lambda, reducer)->E.R2.errMap(_ => "Error!")
Ok(Internals.map(array, accessors, lambda, reducer))
| _ => Error(impossibleError)
},
(),
@ -236,9 +221,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer) =>
switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Internals.reduce(array, initialValue, lambda, accessors, reducer)->E.R2.errMap(_ =>
"Error!"
)
Ok(Internals.reduce(array, initialValue, lambda, accessors, reducer))
| _ => Error(impossibleError)
},
(),
@ -258,13 +241,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
switch inputs {
| [IEvArray(array), initialValue, IEvLambda(lambda)] =>
Internals.reduceReverse(
array,
initialValue,
lambda,
accessors,
reducer,
)->E.R2.errMap(_ => "Error!")
Ok(Internals.reduceReverse(array, initialValue, lambda, accessors, reducer))
| _ => Error(impossibleError)
},
(),
@ -284,7 +261,7 @@ let library = [
~run=(inputs, _, accessors: ProjectAccessorsT.t, reducer: ProjectReducerFnT.t) =>
switch inputs {
| [IEvArray(array), IEvLambda(lambda)] =>
Internals.filter(array, lambda, accessors, reducer)->E.R2.errMap(_ => "Error!")
Ok(Internals.filter(array, lambda, accessors, reducer))
| _ => 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) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, environment, reducer) {
| Ok(IEvNumber(f)) => Ok(f)
| IEvNumber(f) => Ok(f)
| _ => 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,
) =>
switch Reducer_Expression_Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
| Ok(IEvNumber(f)) => Ok(f)
| IEvNumber(f) => Ok(f)
| _ => 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 ExpressionT = Reducer_Expression_T
module ExternalLibrary = ReducerInterface.ExternalLibrary
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
module Lambda = Reducer_Expression_Lambda
module MathJs = Reducer_MathJs
module ProjectAccessorsT = ReducerProject_ProjectAccessors_T
@ -111,7 +112,7 @@ let callInternal = (
module SampleMap = {
let doLambdaCall = (aLambdaValue, list) =>
switch Lambda.doLambdaCall(aLambdaValue, list, accessors, reducer) {
| Ok(IEvNumber(f)) => Ok(f)
| IEvNumber(f) => Ok(f)
| _ => Error(Operation.SampleMapNeedsNtoNFunction)
}
@ -201,13 +202,17 @@ let dispatch = (
call: functionCall,
accessors: ProjectAccessorsT.t,
reducer: ProjectReducerFnT.t,
): result<internalExpressionValue, errorValue> =>
): internalExpressionValue =>
try {
let (fn, args) = call
// There is a bug that prevents string match in patterns
// So we have to recreate a copy of the string
ExternalLibrary.dispatch((Js.String.make(fn), args), accessors, reducer, callInternal)
ExternalLibrary.dispatch(
(Js.String.make(fn), args),
accessors,
reducer,
callInternal,
)->InternalExpressionValue.resultToValue
} catch {
| Js.Exn.Error(obj) => REJavaScriptExn(Js.Exn.message(obj), Js.Exn.name(obj))->Error
| _ => RETodo("unhandled rescript exception")->Error
| exn => Reducer_ErrorValue.fromException(exn)->Reducer_ErrorValue.toException
}

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

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

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

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

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

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

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

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

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

16
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 expressionWithContext = ExpressionWithContext.expressionWithContext
let expandMacroCall = (
let expandMacroCallRs = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): result<expressionWithContext, 'e> =>
try {
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression,
bindings,
accessors,
reduceExpression,
)
)->Ok
} catch {
| exn => Reducer_ErrorValue.fromException(exn)->Error
}
let doMacroCall = (
macroExpression: expression,
bindings: ExpressionT.bindings,
accessors: ProjectAccessorsT.t,
reduceExpression: ProjectReducerFnT.t,
): result<internalExpressionValue, 'e> =>
expandMacroCall(
): internalExpressionValue =>
Reducer_Dispatch_BuiltInMacros.dispatchMacroCall(
macroExpression,
bindings,
(accessors: ProjectAccessorsT.t),
(reduceExpression: ProjectReducerFnT.t),
)->Result.flatMap(expressionWithContext =>
ExpressionWithContext.callReducer(expressionWithContext, bindings, accessors, reduceExpression)
)
)->ExpressionWithContext.callReducer(bindings, accessors, reduceExpression)
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 =
| NotFFI(expression)
| FFI(ffiFn)
let resultToValue = (rExpression: result<t, Reducer_ErrorValue.t>): t =>
switch rExpression {
| Ok(expression) => expression
| Error(errorValue) => Reducer_ErrorValue.toException(errorValue)
}

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

@ -15,17 +15,13 @@ let ievFromTypeExpression = (
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
Reducer_Expression.BackCompatible.parse(sourceCode)->Belt.Result.flatMap(expr => {
let accessors = ProjectAccessorsT.identityAccessors
let result = reducerFn(expr, Bindings.emptyBindings, accessors)
let _result = reducerFn(expr, Bindings.emptyBindings, accessors)
let nameSpace = accessors.states.continuation
switch result {
| Ok(_) =>
switch Bindings.getType(nameSpace, sIndex) {
| 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
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 = (
this: t,
aContinuation: T.continuation,
@ -202,9 +191,12 @@ let doBuildResult = (
this
->getExpression
->Belt.Option.map(
Belt.Result.flatMap(
_,
Reducer_Expression.reduceExpressionInProject(_, aContinuation, accessors),
Belt.Result.flatMap(_, expression =>
try {
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 ProjectAccessorsT = ReducerProject_ProjectAccessors_T
type t = (
ExpressionT.t,
ExpressionT.bindings,
ProjectAccessorsT.t,
) => result<InternalExpressionValue.t, Reducer_ErrorValue.errorValue>
type t = (ExpressionT.t, ExpressionT.bindings, ProjectAccessorsT.t) => InternalExpressionValue.t

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
module FloatFloatMap = {
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))
}
}
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
}
module A = E_A
module A2 = E_A2
module B = E_B
module Dict = E_Dict
module F = E_F
module Float = E_Float
module FloatFloatMap = E_FloatFloatMap
module I = E_I
module Int = E_Int
module J = E_J
module JsDate = E_JsDate
module L = E_L
module O = E_O
module O2 = E_O2
module R = E_R
module R2 = E_R2
module S = E_S
module Tuple2 = E_Tuple2
module Tuple3 = E_Tuple3
module U = E_U

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