Merge pull request #628 from quantified-uncertainty/reducer-type-grammar

Reducer type grammar - preview release
This commit is contained in:
Ozzie Gooen 2022-06-02 08:57:37 -07:00 committed by GitHub
commit 9b0def16ef
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 589 additions and 148 deletions

View File

@ -1,26 +1,5 @@
module Parse = Reducer_Peggy_Parse
module Result = Belt.Result
open Jest
open Expect
let expectParseToBe = (expr, answer) =>
Parse.parse(expr)->Parse.toStringResult->expect->toBe(answer)
let testParse = (expr, answer) => test(expr, () => expectParseToBe(expr, answer))
module MySkip = {
let testParse = (expr, answer) => Skip.test(expr, () => expectParseToBe(expr, answer))
let testDescriptionParse = (desc, expr, answer) =>
Skip.test(desc, () => expectParseToBe(expr, answer))
}
module MyOnly = {
let testParse = (expr, answer) => Only.test(expr, () => expectParseToBe(expr, answer))
let testDescriptionParse = (desc, expr, answer) =>
Only.test(desc, () => expectParseToBe(expr, answer))
}
open Reducer_Peggy_TestHelpers
describe("Peggy parse", () => {
describe("float", () => {

View File

@ -0,0 +1,79 @@
open Jest
open Reducer_Peggy_TestHelpers
describe("Peggy parse type", () => {
describe("type of", () => {
testParse("p: number", "{(::$_typeOf_$ :p #number)}")
})
describe("type alias", () => {
testParse("type index=number", "{(::$_typeAlias_$ #index #number)}")
})
describe("type or", () => {
testParse(
"answer: number|string",
"{(::$_typeOf_$ :answer (::$_typeOr_$ (::$_constructArray_$ (#number #string))))}",
)
})
describe("type function", () => {
testParse(
"f: number=>number=>number",
"{(::$_typeOf_$ :f (::$_typeFunction_$ (::$_constructArray_$ (#number #number #number))))}",
)
})
describe("high priority modifier", () => {
testParse(
"answer: number<-min<-max(100)|string",
"{(::$_typeOf_$ :answer (::$_typeOr_$ (::$_constructArray_$ ((::$_typeModifier_max_$ (::$_typeModifier_min_$ #number) 100) #string))))}",
)
testParse(
"answer: number<-memberOf([1,3,5])",
"{(::$_typeOf_$ :answer (::$_typeModifier_memberOf_$ #number (::$_constructArray_$ (1 3 5))))}",
)
})
describe("low priority modifier", () => {
testParse(
"answer: number | string $ opaque",
"{(::$_typeOf_$ :answer (::$_typeModifier_opaque_$ (::$_typeOr_$ (::$_constructArray_$ (#number #string)))))}",
)
})
describe("type array", () => {
testParse("answer: [number]", "{(::$_typeOf_$ :answer (::$_typeArray_$ #number))}")
})
describe("type record", () => {
testParse(
"answer: {a: number, b: string}",
"{(::$_typeOf_$ :answer (::$_typeRecord_$ (::$_constructRecord_$ ('a': #number 'b': #string))))}",
)
})
describe("type constructor", () => {
testParse(
"answer: Age(number)",
"{(::$_typeOf_$ :answer (::$_typeConstructor_$ #Age (::$_constructArray_$ (#number))))}",
)
testParse(
"answer: Complex(number, number)",
"{(::$_typeOf_$ :answer (::$_typeConstructor_$ #Complex (::$_constructArray_$ (#number #number))))}",
)
testParse(
"answer: Person({age: number, name: string})",
"{(::$_typeOf_$ :answer (::$_typeConstructor_$ #Person (::$_constructArray_$ ((::$_typeRecord_$ (::$_constructRecord_$ ('age': #number 'name': #string)))))))}",
)
testParse(
"weekend: Saturday | Sunday",
"{(::$_typeOf_$ :weekend (::$_typeOr_$ (::$_constructArray_$ ((::$_typeConstructor_$ #Saturday (::$_constructArray_$ ())) (::$_typeConstructor_$ #Sunday (::$_constructArray_$ ()))))))}",
)
})
describe("type paranthesis", () => {
//$ is introduced to avoid paranthesis
testParse(
"answer: (number|string)<-opaque",
"{(::$_typeOf_$ :answer (::$_typeModifier_opaque_$ (::$_typeOr_$ (::$_constructArray_$ (#number #string)))))}",
)
})
describe("squiggle expressions in type modifiers", () => {
testParse(
"odds1 = [1,3,5]; odds2 = [7, 9]; type odds = number<-memberOf(concat(odds1, odds2))",
"{:odds1 = {(::$_constructArray_$ (1 3 5))}; :odds2 = {(::$_constructArray_$ (7 9))}; (::$_typeAlias_$ #odds (::$_typeModifier_memberOf_$ #number (::concat :odds1 :odds2)))}",
)
})
})

View File

@ -0,0 +1,46 @@
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface_ExpressionValue
module Parse = Reducer_Peggy_Parse
module Result = Belt.Result
module ToExpression = Reducer_Peggy_ToExpression
open Jest
open Expect
let expectParseToBe = (expr, answer) =>
Parse.parse(expr)->Parse.toStringResult->expect->toBe(answer)
let testParse = (expr, answer) => test(expr, () => expectParseToBe(expr, answer))
let expectToExpressionToBe = (expr, answer, ~v="_", ()) => {
let rExpr = Parse.parse(expr)->Result.map(ToExpression.fromNode)
let a1 = rExpr->ExpressionT.toStringResultOkless
if v == "_" {
a1->expect->toBe(answer)
} else {
let a2 =
rExpr
->Result.flatMap(expr =>
Expression.reduceExpression(expr, Belt.Map.String.empty, ExpressionValue.defaultEnvironment)
)
->ExpressionValue.toStringResultOkless
(a1, a2)->expect->toEqual((answer, v))
}
}
let testToExpression = (expr, answer, ~v="_", ()) =>
test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
module MyOnly = {
let testParse = (expr, answer) => Only.test(expr, () => expectParseToBe(expr, answer))
let testToExpression = (expr, answer, ~v="_", ()) =>
Only.test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
}
module MySkip = {
let testParse = (expr, answer) => Skip.test(expr, () => expectParseToBe(expr, answer))
let testToExpression = (expr, answer, ~v="_", ()) =>
Skip.test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
}

View File

@ -1,41 +1,5 @@
module Expression = Reducer_Expression
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface_ExpressionValue
module Parse = Reducer_Peggy_Parse
module ToExpression = Reducer_Peggy_ToExpression
module Result = Belt.Result
open Jest
open Expect
let expectToExpressionToBe = (expr, answer, ~v="_", ()) => {
let rExpr = Parse.parse(expr)->Result.map(ToExpression.fromNode)
let a1 = rExpr->ExpressionT.toStringResultOkless
if v == "_" {
a1->expect->toBe(answer)
} else {
let a2 =
rExpr
->Result.flatMap(expr =>
Expression.reduceExpression(expr, Belt.Map.String.empty, ExpressionValue.defaultEnvironment)
)
->ExpressionValue.toStringResultOkless
(a1, a2)->expect->toEqual((answer, v))
}
}
let testToExpression = (expr, answer, ~v="_", ()) =>
test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
module MySkip = {
let testToExpression = (expr, answer, ~v="_", ()) =>
Skip.test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
}
module MyOnly = {
let testToExpression = (expr, answer, ~v="_", ()) =>
Only.test(expr, () => expectToExpressionToBe(expr, answer, ~v, ()))
}
open Reducer_Peggy_TestHelpers
describe("Peggy to Expression", () => {
describe("literals operators parenthesis", () => {

View File

@ -0,0 +1,99 @@
open Jest
open Reducer_Peggy_TestHelpers
describe("Peggy Types to Expression", () => {
describe("type of", () => {
testToExpression(
"p: number",
"{(:$_typeOf_$ :p #number)}",
~v="{_typeReferences_: {p: #number}}",
(),
)
})
describe("type alias", () => {
testToExpression(
"type index=number",
"{(:$_typeAlias_$ #index #number)}",
~v="{_typeAliases_: {index: #number}}",
(),
)
})
describe("type or", () => {
testToExpression(
"answer: number|string|distribution",
"{(:$_typeOf_$ :answer (:$_typeOr_$ (:$_constructArray_$ (#number #string #distribution))))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeOr',typeOr: [#number,#string,#distribution]}}}",
(),
)
})
describe("type function", () => {
testToExpression(
"f: number=>number=>number",
"{(:$_typeOf_$ :f (:$_typeFunction_$ (:$_constructArray_$ (#number #number #number))))}",
~v="{_typeReferences_: {f: {typeTag: 'typeFunction',inputs: [#number,#number],output: #number}}}",
(),
)
testToExpression(
"f: number=>number",
"{(:$_typeOf_$ :f (:$_typeFunction_$ (:$_constructArray_$ (#number #number))))}",
~v="{_typeReferences_: {f: {typeTag: 'typeFunction',inputs: [#number],output: #number}}}",
(),
)
})
describe("high priority modifier", () => {
testToExpression(
"answer: number<-min(1)<-max(100)|string",
"{(:$_typeOf_$ :answer (:$_typeOr_$ (:$_constructArray_$ ((:$_typeModifier_max_$ (:$_typeModifier_min_$ #number 1) 100) #string))))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeOr',typeOr: [{typeTag: 'typeIdentifier',typeIdentifier: #number,min: 1,max: 100},#string]}}}",
(),
)
testToExpression(
"answer: number<-memberOf([1,3,5])",
"{(:$_typeOf_$ :answer (:$_typeModifier_memberOf_$ #number (:$_constructArray_$ (1 3 5))))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeIdentifier',typeIdentifier: #number,memberOf: [1,3,5]}}}",
(),
)
testToExpression(
"answer: number<-min(1)",
"{(:$_typeOf_$ :answer (:$_typeModifier_min_$ #number 1))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeIdentifier',typeIdentifier: #number,min: 1}}}",
(),
)
testToExpression(
"answer: number<-max(10)",
"{(:$_typeOf_$ :answer (:$_typeModifier_max_$ #number 10))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeIdentifier',typeIdentifier: #number,max: 10}}}",
(),
)
testToExpression(
"answer: number<-min(1)<-max(10)",
"{(:$_typeOf_$ :answer (:$_typeModifier_max_$ (:$_typeModifier_min_$ #number 1) 10))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeIdentifier',typeIdentifier: #number,min: 1,max: 10}}}",
(),
)
testToExpression(
"answer: number<-max(10)<-min(1)",
"{(:$_typeOf_$ :answer (:$_typeModifier_min_$ (:$_typeModifier_max_$ #number 10) 1))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeIdentifier',typeIdentifier: #number,max: 10,min: 1}}}",
(),
)
})
describe("low priority modifier", () => {
testToExpression(
"answer: number | string $ opaque",
"{(:$_typeOf_$ :answer (:$_typeModifier_opaque_$ (:$_typeOr_$ (:$_constructArray_$ (#number #string)))))}",
~v="{_typeReferences_: {answer: {typeTag: 'typeOr',typeOr: [#number,#string],opaque: true}}}",
(),
)
})
describe("squiggle expressions in type modifiers", () => {
testToExpression(
"odds1 = [1,3,5]; odds2 = [7, 9]; type odds = number<-memberOf(odds1 + odds2)",
"{(:$_let_$ :odds1 {(:$_constructArray_$ (1 3 5))}); (:$_let_$ :odds2 {(:$_constructArray_$ (7 9))}); (:$_typeAlias_$ #odds (:$_typeModifier_memberOf_$ #number (:add :odds1 :odds2)))}",
~v="{_typeAliases_: {odds: {typeTag: 'typeIdentifier',typeIdentifier: #number,memberOf: [1,3,5,7,9]}},odds1: [1,3,5],odds2: [7,9]}",
(),
)
})
// TODO: type bindings. Type bindings are not yet supported.
// TODO: type constructor
})

View File

@ -185,5 +185,7 @@ function createTsExport(
return tag("timeDuration", x.value);
case "EvDeclaration":
return tag("lambdaDeclaration", x.value);
case "EvTypeIdentifier":
return tag("typeIdentifier", x.value);
}
}

View File

@ -69,6 +69,10 @@ export type rescriptExport =
| {
TAG: 12; // EvDeclaration
_0: rescriptLambdaDeclaration;
}
| {
TAG: 13; // EvTypeIdentifier
_0: string;
};
type rescriptDist =
@ -120,7 +124,8 @@ export type squiggleExpression =
| tagged<"date", Date>
| tagged<"timeDuration", number>
| tagged<"lambdaDeclaration", lambdaDeclaration>
| tagged<"record", { [key: string]: squiggleExpression }>;
| tagged<"record", { [key: string]: squiggleExpression }>
| tagged<"typeIdentifier", string>;
export { lambdaValue };
@ -170,6 +175,8 @@ export function convertRawToTypescript(
fn: result._0.fn,
args: result._0.args.map(convertDeclaration),
});
case 13: // EvSymbol
return tag("typeIdentifier", result._0);
}
}

View File

@ -52,6 +52,16 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
| None => RERecordPropertyNotFound("Record property not found", sIndex)->Error
}
let doAddArray = (originalA, b) => {
let a = originalA->Js.Array2.copy
let _ = Js.Array2.pushMany(a, b)
a->EvArray->Ok
}
let doAddString = (a, b) => {
let answer = Js.String2.concat(a, b)
answer->EvString->Ok
}
let inspect = (value: expressionValue) => {
Js.log(value->toString)
value->Ok
@ -74,6 +84,40 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
->Ok
}
let doSetBindingsInNamespace = (
externalBindings: externalBindings,
symbol: string,
value: expressionValue,
namespace: string,
) => {
let bindings = Bindings.fromExternalBindings(externalBindings)
let evAliases = bindings->Belt.Map.String.getWithDefault(namespace, EvRecord(Js.Dict.empty()))
let newEvAliases = switch evAliases {
| EvRecord(dict) => {
Js.Dict.set(dict, symbol, value)
dict->EvRecord
}
| _ => Js.Dict.empty()->EvRecord
}
bindings
->Belt.Map.String.set(namespace, newEvAliases)
->Bindings.toExternalBindings
->EvRecord
->Ok
}
let doSetTypeAliasBindings = (
externalBindings: externalBindings,
symbol: string,
value: expressionValue,
) => doSetBindingsInNamespace(externalBindings, symbol, value, Bindings.typeAliasesKey)
let doSetTypeOfBindings = (
externalBindings: externalBindings,
symbol: string,
value: expressionValue,
) => doSetBindingsInNamespace(externalBindings, symbol, value, Bindings.typeReferencesKey)
let doExportBindings = (externalBindings: externalBindings) => EvRecord(externalBindings)->Ok
let doKeepArray = (aValueArray, aLambdaValue) => {
@ -147,6 +191,69 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
)
}
let typeModifier_memberOf = (aType, anArray) => {
let newRecord = Js.Dict.fromArray([
("typeTag", EvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Js.Dict.set("memberOf", anArray)
newRecord->EvRecord->Ok
}
let typeModifier_memberOf_update = (aRecord, anArray) => {
let newRecord = aRecord->Js.Dict.entries->Js.Dict.fromArray
newRecord->Js.Dict.set("memberOf", anArray)
newRecord->EvRecord->Ok
}
let typeModifier_min = (aType, value) => {
let newRecord = Js.Dict.fromArray([
("typeTag", EvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Js.Dict.set("min", value)
newRecord->EvRecord->Ok
}
let typeModifier_min_update = (aRecord, value) => {
let newRecord = aRecord->Js.Dict.entries->Js.Dict.fromArray
newRecord->Js.Dict.set("min", value)
newRecord->EvRecord->Ok
}
let typeModifier_max = (aType, value) => {
let newRecord = Js.Dict.fromArray([
("typeTag", EvString("typeIdentifier")),
("typeIdentifier", aType),
])
newRecord->Js.Dict.set("max", value)
newRecord->EvRecord->Ok
}
let typeModifier_max_update = (aRecord, value) => {
let newRecord = aRecord->Js.Dict.entries->Js.Dict.fromArray
newRecord->Js.Dict.set("max", value)
newRecord->EvRecord->Ok
}
let typeModifier_opaque_update = aRecord => {
let newRecord = aRecord->Js.Dict.entries->Js.Dict.fromArray
newRecord->Js.Dict.set("opaque", EvBool(true))
newRecord->EvRecord->Ok
}
let typeOr = evArray => {
let newRecord = Js.Dict.fromArray([("typeTag", EvString("typeOr")), ("typeOr", evArray)])
newRecord->EvRecord->Ok
}
let typeFunction = anArray => {
let output = Belt.Array.getUnsafe(anArray, Js.Array2.length(anArray) - 1)
let inputs = Js.Array2.slice(anArray, ~start=0, ~end_=-1)
let newRecord = Js.Dict.fromArray([
("typeTag", EvString("typeFunction")),
("inputs", EvArray(inputs)),
("output", output),
])
newRecord->EvRecord->Ok
}
switch call {
| ("$_atIndex_$", [EvArray(aValueArray), EvNumber(fIndex)]) => arrayAtIndex(aValueArray, fIndex)
| ("$_atIndex_$", [EvRecord(dict), EvString(sIndex)]) => recordAtIndex(dict, sIndex)
@ -155,6 +262,28 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
| ("$_exportBindings_$", [EvRecord(externalBindings)]) => doExportBindings(externalBindings)
| ("$_setBindings_$", [EvRecord(externalBindings), EvSymbol(symbol), value]) =>
doSetBindings(externalBindings, symbol, value)
| ("$_setTypeAliasBindings_$", [EvRecord(externalBindings), EvTypeIdentifier(symbol), value]) =>
doSetTypeAliasBindings(externalBindings, symbol, value)
| ("$_setTypeOfBindings_$", [EvRecord(externalBindings), EvSymbol(symbol), value]) =>
doSetTypeOfBindings(externalBindings, symbol, value)
| ("$_typeModifier_memberOf_$", [EvTypeIdentifier(typeIdentifier), EvArray(arr)]) =>
typeModifier_memberOf(EvTypeIdentifier(typeIdentifier), EvArray(arr))
| ("$_typeModifier_memberOf_$", [EvRecord(typeRecord), EvArray(arr)]) =>
typeModifier_memberOf_update(typeRecord, EvArray(arr))
| ("$_typeModifier_min_$", [EvTypeIdentifier(typeIdentifier), value]) =>
typeModifier_min(EvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_min_$", [EvRecord(typeRecord), value]) =>
typeModifier_min_update(typeRecord, value)
| ("$_typeModifier_max_$", [EvTypeIdentifier(typeIdentifier), value]) =>
typeModifier_max(EvTypeIdentifier(typeIdentifier), value)
| ("$_typeModifier_max_$", [EvRecord(typeRecord), value]) =>
typeModifier_max_update(typeRecord, value)
| ("$_typeModifier_opaque_$", [EvRecord(typeRecord)]) => typeModifier_opaque_update(typeRecord)
| ("$_typeOr_$", [EvArray(arr)]) => typeOr(EvArray(arr))
| ("$_typeFunction_$", [EvArray(arr)]) => typeFunction(arr)
| ("add", [EvArray(aValueArray), EvArray(bValueArray)]) => doAddArray(aValueArray, bValueArray)
| ("add", [EvString(aValueString), EvString(bValueString)]) =>
doAddString(aValueString, bValueString)
| ("inspect", [value, EvString(label)]) => inspectLabel(value, label)
| ("inspect", [value]) => inspect(value)
| ("keep", [EvArray(aValueArray), EvLambda(aLambdaValue)]) =>

View File

@ -4,6 +4,7 @@
Macros are used to define language building blocks. They are like Lisp macros.
*/
module Bindings = Reducer_Expression_Bindings
module ErrorValue = Reducer_ErrorValue
module ExpressionBuilder = Reducer_Expression_ExpressionBuilder
module ExpressionT = Reducer_Expression_T
module ExpressionValue = ReducerInterface.ExpressionValue
@ -12,7 +13,7 @@ module Result = Belt.Result
open Reducer_Expression_ExpressionBuilder
type environment = ExpressionValue.environment
type errorValue = Reducer_ErrorValue.errorValue
type errorValue = ErrorValue.errorValue
type expression = ExpressionT.expression
type expressionValue = ExpressionValue.expressionValue
type expressionWithContext = ExpressionWithContext.expressionWithContext
@ -23,84 +24,78 @@ let dispatchMacroCall = (
environment,
reduceExpression: ExpressionT.reducerFn,
): result<expressionWithContext, errorValue> => {
let doBindStatement = (bindingExpr: expression, statement: expression, environment) =>
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(EvCall("$_let_$")), symbolExpr, statement}) => {
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, environment)
let useExpressionToSetBindings = (bindingExpr: expression, environment, statement, newCode) => {
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, environment)
rExternalBindingsValue->Result.flatMap(externalBindingsValue => {
let newBindings = Bindings.fromValue(externalBindingsValue)
rExternalBindingsValue->Result.flatMap(externalBindingsValue => {
let newBindings = Bindings.fromValue(externalBindingsValue)
// Js.log(
// `bindStatement ${Bindings.toString(newBindings)}<==${ExpressionT.toString(
// bindingExpr,
// )} statement: $_let_$ ${ExpressionT.toString(symbolExpr)}=${ExpressionT.toString(
// statement,
// )}`,
// )
let rNewStatement = Bindings.replaceSymbols(newBindings, statement)
rNewStatement->Result.map(boundStatement =>
ExpressionWithContext.withContext(
newCode(newBindings->Bindings.toExternalBindings->eRecord, boundStatement),
newBindings,
)
)
})
}
let rNewStatement = Bindings.replaceSymbols(newBindings, statement)
rNewStatement->Result.map(newStatement =>
ExpressionWithContext.withContext(
eFunction(
"$_setBindings_$",
list{newBindings->Bindings.toExternalBindings->eRecord, symbolExpr, newStatement},
),
newBindings,
)
)
})
}
| _ => REAssignmentExpected->Error
let correspondingSetBindingsFn = (fnName: string): string =>
switch fnName {
| "$_let_$" => "$_setBindings_$"
| "$_typeOf_$" => "$_setTypeOfBindings_$"
| "$_typeAlias_$" => "$_setTypeAliasBindings_$"
| _ => ""
}
let doBindStatement = (bindingExpr: expression, statement: expression, environment) => {
let defaultStatement = ErrorValue.REAssignmentExpected->Error
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(EvCall(callName)), symbolExpr, statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName)
if setBindingsFn !== "" {
useExpressionToSetBindings(bindingExpr, environment, statement, (
newBindingsExpr,
boundStatement,
) => eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement}))
} else {
defaultStatement
}
}
| _ => defaultStatement
}
}
let doBindExpression = (bindingExpr: expression, statement: expression, environment): result<
expressionWithContext,
errorValue,
> =>
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(EvCall("$_let_$")), symbolExpr, statement}) => {
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, environment)
> => {
let defaultStatement = () =>
useExpressionToSetBindings(bindingExpr, environment, statement, (
_newBindingsExpr,
boundStatement,
) => boundStatement)
rExternalBindingsValue->Result.flatMap(externalBindingsValue => {
let newBindings = Bindings.fromValue(externalBindingsValue)
let rNewStatement = Bindings.replaceSymbols(newBindings, statement)
rNewStatement->Result.map(newStatement =>
ExpressionWithContext.withContext(
eFunction(
"$_exportBindings_$",
list{
eFunction(
"$_setBindings_$",
list{
newBindings->Bindings.toExternalBindings->eRecord,
symbolExpr,
newStatement,
},
),
},
),
newBindings,
switch statement {
| ExpressionT.EList(list{ExpressionT.EValue(EvCall(callName)), symbolExpr, statement}) => {
let setBindingsFn = correspondingSetBindingsFn(callName)
if setBindingsFn !== "" {
useExpressionToSetBindings(bindingExpr, environment, statement, (
newBindingsExpr,
boundStatement,
) =>
eFunction(
"$_exportBindings_$",
list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})},
)
)
})
}
| _ => {
let rExternalBindingsValue: result<expressionValue, errorValue> = reduceExpression(
bindingExpr,
bindings,
environment,
)
rExternalBindingsValue->Result.flatMap(externalBindingsValue => {
let newBindings = Bindings.fromValue(externalBindingsValue)
let rNewStatement = Bindings.replaceSymbols(newBindings, statement)
rNewStatement->Result.map(newStatement =>
ExpressionWithContext.withContext(newStatement, newBindings)
)
})
} else {
defaultStatement()
}
}
| _ => defaultStatement()
}
}
let doBlock = (exprs: list<expression>, _bindings: ExpressionT.bindings, _environment): result<
expressionWithContext,

View File

@ -75,9 +75,9 @@ and reduceValueList = (valueList: list<expressionValue>, environment): result<
> =>
switch valueList {
| list{EvCall(fName), ...args} => {
let rCheckedArgs = switch fName == "$_setBindings_$" {
| false => args->Lambda.checkIfReduced
| true => args->Ok
let rCheckedArgs = switch fName {
| "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$" => args->Ok
| _ => args->Lambda.checkIfReduced
}
rCheckedArgs->Result.flatMap(checkedArgs =>

View File

@ -10,13 +10,8 @@ type externalBindings = ReducerInterface_ExpressionValue.externalBindings
let defaultBindings: ExpressionT.bindings = Belt.Map.String.empty
let fromExternalBindings = (externalBindings: externalBindings): ExpressionT.bindings => {
let keys = Js.Dict.keys(externalBindings)
keys->Belt.Array.reduce(defaultBindings, (acc, key) => {
let value = Js.Dict.unsafeGet(externalBindings, key)
acc->Belt.Map.String.set(key, value)
})
}
let typeAliasesKey = "_typeAliases_"
let typeReferencesKey = "_typeReferences_"
let toExternalBindings = (bindings: ExpressionT.bindings): externalBindings => {
let keys = Belt.Map.String.keysToArray(bindings)
@ -27,6 +22,50 @@ let toExternalBindings = (bindings: ExpressionT.bindings): externalBindings => {
})
}
let fromExternalBindings_ = (externalBindings: externalBindings): ExpressionT.bindings => {
let keys = Js.Dict.keys(externalBindings)
keys->Belt.Array.reduce(defaultBindings, (acc, key) => {
let value = Js.Dict.unsafeGet(externalBindings, key)
acc->Belt.Map.String.set(key, value)
})
}
let fromExternalBindings = (externalBindings: externalBindings): ExpressionT.bindings => {
// TODO: This code will be removed in the future when maps are used instead of records. Please don't mind this function for now.
let internalBindings0 = fromExternalBindings_(externalBindings)
let oExistingTypeAliases = Belt.Map.String.get(internalBindings0, typeAliasesKey)
let internalBindings1 = Belt.Option.mapWithDefault(
oExistingTypeAliases,
internalBindings0,
existingTypeAliases => {
let newTypeAliases = switch existingTypeAliases {
| EvRecord(actualTypeAliases) =>
actualTypeAliases->fromExternalBindings_->toExternalBindings->ExpressionValue.EvRecord
| _ => existingTypeAliases
}
Belt.Map.String.set(internalBindings0, typeAliasesKey, newTypeAliases)
},
)
let oExistingTypeReferences = Belt.Map.String.get(internalBindings1, typeReferencesKey)
let internalBindings2 = Belt.Option.mapWithDefault(
oExistingTypeReferences,
internalBindings1,
existingTypeReferences => {
let newTypeReferences = switch existingTypeReferences {
| EvRecord(actualTypeReferences) =>
actualTypeReferences->fromExternalBindings_->toExternalBindings->ExpressionValue.EvRecord
| _ => existingTypeReferences
}
Belt.Map.String.set(internalBindings0, typeReferencesKey, newTypeReferences)
},
)
internalBindings2
}
let fromValue = (aValue: expressionValue) =>
switch aValue {
| EvRecord(externalBindings) => fromExternalBindings(externalBindings)

View File

@ -64,3 +64,6 @@ let eBindExpression = (bindingExpr: expression, expression: expression): express
let eBindExpressionDefault = (expression: expression): expression =>
eFunction("$$_bindExpression_$$", list{expression})
let eTypeIdentifier = (name: string): expression =>
name->BExpressionValue.EvTypeIdentifier->BExpressionT.EValue

View File

@ -36,11 +36,6 @@
'[]': '$_atIndex_$',
}
function nodeBlock(statements) {return{type: 'Block', statements: statements}}
function nodeBoolean(value) {return {type: 'Boolean', value: value}}
function nodeCallIndentifier(value) {return {type: 'CallIdentifier', value: value}}
function nodeExpression(args) {return {type: 'Expression', nodes: args}}
function nodeFloat(value) {return {type: 'Float', value: value}}
function makeFunctionCall(fn, args) {
if (fn === '$$_applyAll_$$') {
// Any list of values is applied from left to right anyway.
@ -52,6 +47,16 @@
return nodeExpression([nodeCallIndentifier(fn), ...args])
}
}
function apply(fn, arg) { return makeFunctionCall(fn, [arg]); }
function constructArray(elems) { return apply('$_constructArray_$', nodeExpression(elems)); }
function constructRecord(elems) { return apply('$_constructRecord_$', nodeExpression(elems)); }
function nodeBlock(statements) {return{type: 'Block', statements: statements}}
function nodeBoolean(value) {return {type: 'Boolean', value: value}}
function nodeCallIndentifier(value) {return {type: 'CallIdentifier', value: value}}
function nodeExpression(args) {return {type: 'Expression', nodes: args}}
function nodeFloat(value) {return {type: 'Float', value: value}}
function nodeIdentifier(value) {return {type: 'Identifier', value: value}}
function nodeInteger(value) {return {type: 'Integer', value: value}}
function nodeKeyValue(key, value) {
@ -61,9 +66,12 @@
function nodeLetStatment(variable, value) {return {type: 'LetStatement', variable: variable, value: value}}
function nodeString(value) {return {type: 'String', value: value}}
function nodeTernary(condition, trueExpression, falseExpression) {return {type: 'Ternary', condition: condition, trueExpression: trueExpression, falseExpression: falseExpression}}
function nodeTypeIdentifier(typeValue) {return {type: 'TypeIdentifier', value: typeValue}}
}}
start
// = _nl start:typeExpression _nl finalComment? {return start}
= _nl start:outerBlock _nl finalComment? {return start}
zeroOMoreArgumentsBlockOrExpression = innerBlockOrExpression / lambda
@ -96,6 +104,7 @@ array_statements
statement
= letStatement
/ defunStatement
/ typeStatement
letStatement
= variable:identifier _ assignmentOp _nl value:zeroOMoreArgumentsBlockOrExpression
@ -205,7 +214,7 @@ chainFunctionCall
unary
= unaryOperator:unaryOperator _nl right:(unary/postOperator)
{ return makeFunctionCall(unaryToFunction[unaryOperator], [right])}
{ return apply(unaryToFunction[unaryOperator], right)}
/ postOperator
unaryOperator "unary operator"
@ -267,7 +276,7 @@ number = number:(float / integer) unit:identifier?
if (unit === null)
{ return number }
else
{ return makeFunctionCall('fromUnit_'+unit.value, [number])
{ return apply('fromUnit_'+unit.value, number)
}
}
@ -301,9 +310,9 @@ lambda
arrayConstructor 'array'
= '[' _nl ']'
{ return makeFunctionCall('$_constructArray_$', [nodeExpression([])])}
{ return constructArray([]); }
/ '[' _nl args:array_elements _nl ']'
{ return makeFunctionCall('$_constructArray_$', [nodeExpression(args)])}
{ return constructArray(args); }
array_elements
= head:expression tail:(_ ',' _nl @expression)*
@ -311,7 +320,7 @@ arrayConstructor 'array'
recordConstructor 'record'
= '{' _nl args:array_recordArguments _nl '}'
{ return makeFunctionCall('$_constructRecord_$', [nodeExpression(args)])}
{ return constructRecord(args); }
array_recordArguments
= head:keyValuePair tail:(_ ',' _nl @keyValuePair)*
@ -321,6 +330,8 @@ recordConstructor 'record'
= key:expression _ ':' _nl value:expression
{ return nodeKeyValue(key, value)}
// Separators
_ 'whitespace'
= whiteSpaceCharactersOrComment*
@ -351,4 +362,79 @@ statementSeparator 'statement separator'
newLine "newline"
= [\n\r]
// Types
noArguments = ('(' _nl ')' )?
typeIdentifier 'type identifier'
= ([a-z]+[_a-z0-9]i*) {return nodeTypeIdentifier(text())}
typeConstructorIdentifier 'type constructor identifier'
= ([A-Z]+[_a-z0-9]i*) {return nodeTypeIdentifier(text())}
typeExpression = typePostModifierExpression
typePostModifierExpression = head:typeOr tail:(_ '$' _nl @typeModifier)*
{
return tail.reduce((result, element) => {
return makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head)
}
typeOr = head:typeFunction tail:(_ '|' _nl @typeFunction)*
{ return tail.length === 0 ? head : apply('$_typeOr_$', constructArray([head, ...tail])); }
typeFunction = head:typeModifierExpression tail:(_ '=>' _nl @typeModifierExpression)*
{ return tail.length === 0 ? head : apply( '$_typeFunction_$', constructArray([head, ...tail])); }
typeModifierExpression = head:basicType tail:(_ '<-' _nl @typeModifier)*
{
return tail.reduce((result, element) => {
return makeFunctionCall('$_typeModifier_'+element.modifier.value+'_$', [result, ...element.args])
}, head)
}
typeModifier
= modifier:identifier _ '(' _nl args:array_elements _nl ')'
{ return {modifier: modifier, args: args}; }
/ modifier:identifier _ noArguments
{ return {modifier: modifier, args: []}; }
basicType = typeConstructor / typeArray / typeRecord / typeInParanthesis / typeIdentifier
typeArray = '[' _nl elem:typeExpression _nl ']'
{return apply('$_typeArray_$', elem)}
typeRecord = '{' _nl elems:array_typeRecordArguments _nl '}'
{ return apply('$_typeRecord_$', constructRecord(elems)); }
array_typeRecordArguments
= head:typeKeyValuePair tail:(_ ',' _nl @typeKeyValuePair)*
{ return [head, ...tail]; }
typeKeyValuePair
= key:identifier _ ':' _nl value:typeExpression
{ return nodeKeyValue(key, value)}
typeConstructor
= constructor:typeConstructorIdentifier _ '(' _nl args:array_types _nl ')'
{ return makeFunctionCall('$_typeConstructor_$', [constructor, constructArray(args)]); }
/ constructor:typeConstructorIdentifier _ noArguments
{ return makeFunctionCall('$_typeConstructor_$', [constructor, constructArray([])]); }
array_types = head:typeExpression tail:(_ ',' _nl @typeExpression)*
{ return [head, ...tail]; }
typeStatement = typeAliasStatement / typeOfStatement
typeAliasStatement = 'type' __nl typeIdentifier:typeIdentifier _nl '=' _nl typeExpression:typeExpression
{ return makeFunctionCall('$_typeAlias_$', [typeIdentifier, typeExpression])}
typeOfStatement = identifier:identifier _ ':' _nl typeExpression:typeExpression
{ return makeFunctionCall('$_typeOf_$', [identifier, typeExpression])}
typeInParanthesis = '(' _nl typeExpression:typeExpression _nl ')' {return typeExpression}
// TODO: min max example
// TODO: Example of foo = {a: 2, b: 5}; type fooKeys = string $ memberOf(foo->keys)
// TODO: Example of memberOf( [1,2,3] )
// TODO: Example of $
// TODO: Cons(a, list) | EmptyList

View File

@ -24,6 +24,7 @@ type nodeLambda = {...node, "args": array<nodeIdentifier>, "body": nodeBlock}
type nodeLetStatement = {...node, "variable": nodeIdentifier, "value": node}
type nodeString = {...node, "value": string}
type nodeTernary = {...node, "condition": node, "trueExpression": node, "falseExpression": node}
type nodeTypeIdentifier = {...node, "value": string}
type peggyNode =
| PgNodeBlock(nodeBlock)
@ -38,6 +39,7 @@ type peggyNode =
| PgNodeLetStatement(nodeLetStatement)
| PgNodeString(nodeString)
| PgNodeTernary(nodeTernary)
| PgNodeTypeIdentifier(nodeTypeIdentifier)
external castNodeBlock: node => nodeBlock = "%identity"
external castNodeBoolean: node => nodeBoolean = "%identity"
@ -51,6 +53,7 @@ external castNodeLambda: node => nodeLambda = "%identity"
external castNodeLetStatement: node => nodeLetStatement = "%identity"
external castNodeString: node => nodeString = "%identity"
external castNodeTernary: node => nodeTernary = "%identity"
external castNodeTypeIdentifier: node => nodeTypeIdentifier = "%identity"
exception UnsupportedPeggyNodeType(string) // This should never happen; programming error
let castNodeType = (node: node) =>
@ -67,6 +70,7 @@ let castNodeType = (node: node) =>
| "LetStatement" => node->castNodeLetStatement->PgNodeLetStatement
| "String" => node->castNodeString->PgNodeString
| "Ternary" => node->castNodeTernary->PgNodeTernary
| "TypeIdentifier" => node->castNodeTypeIdentifier->PgNodeTypeIdentifier
| _ => raise(UnsupportedPeggyNodeType(node["type"]))
}
@ -98,6 +102,7 @@ let rec pgToString = (peggyNode: peggyNode): string => {
toString(node["trueExpression"]) ++
" " ++
toString(node["falseExpression"]) ++ ")"
| PgNodeTypeIdentifier(node) => `#${node["value"]}`
}
}
and toString = (node: node): string => node->castNodeType->pgToString

View File

@ -44,5 +44,7 @@ let rec fromNode = (node: Parse.node): expression => {
fromNode(nodeTernary["falseExpression"]),
},
)
| PgNodeTypeIdentifier(nodeTypeIdentifier) =>
ExpressionBuilder.eTypeIdentifier(nodeTypeIdentifier["value"])
}
}

View File

@ -23,6 +23,7 @@ type rec expressionValue =
| EvDate(Js.Date.t)
| EvTimeDuration(float)
| EvDeclaration(lambdaDeclaration)
| EvTypeIdentifier(string)
and record = Js.Dict.t<expressionValue>
and externalBindings = record
and lambdaValue = {
@ -58,6 +59,7 @@ let rec toString = aValue =>
| EvDate(date) => DateTime.Date.toString(date)
| EvTimeDuration(t) => DateTime.Duration.toString(t)
| EvDeclaration(d) => Declaration.toString(d, r => toString(EvLambda(r)))
| EvTypeIdentifier(id) => `#${id}`
}
and toStringRecord = aRecord => {
let pairs =
@ -83,6 +85,7 @@ let toStringWithType = aValue =>
| EvDate(_) => `Date::${toString(aValue)}`
| EvTimeDuration(_) => `Date::${toString(aValue)}`
| EvDeclaration(_) => `Declaration::${toString(aValue)}`
| EvTypeIdentifier(_) => `TypeIdentifier::${toString(aValue)}`
}
let argsToString = (args: array<expressionValue>): string => {
@ -129,6 +132,7 @@ type expressionValueType =
| EvtDate
| EvtTimeDuration
| EvtDeclaration
| EvtTypeIdentifier
type functionCallSignature = CallSignature(string, array<expressionValueType>)
type functionDefinitionSignature =
@ -149,6 +153,7 @@ let valueToValueType = value =>
| EvDate(_) => EvtDate
| EvTimeDuration(_) => EvtTimeDuration
| EvDeclaration(_) => EvtDeclaration
| EvTypeIdentifier(_) => EvtTypeIdentifier
}
let functionCallToCallSignature = (functionCall: functionCall): functionCallSignature => {
@ -171,6 +176,7 @@ let valueTypeToString = (valueType: expressionValueType): string =>
| EvtDate => `Date`
| EvtTimeDuration => `Duration`
| EvtDeclaration => `Declaration`
| EvtTypeIdentifier => `TypeIdentifier`
}
let functionCallSignatureToString = (functionCallSignature: functionCallSignature): string => {