typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

peggy construct functions

typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

peggy construct functions

apply

typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

peggy construct functions

apply

all types are expressions

typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

peggy construct functions

apply

all types are expressions

modifiers

typeExpression

type statements

type paranthesis

type paranthesis

comments

TODO

peggy construct functions

apply

all types are expressions

modifiers

0 arg constructors and $ (low priority type modifier)

remove GeneratedParser.js

peggy test helpers

test type parsing

type of test defined

act of binding refactored

recognize all binding functions | "$_setBindings_$" | "$_setTypeOfBindings_$" | "$_setTypeAliasBindings_$"

doBindStatement

bindings default statemetn

doBindExpression

clone type references and type aliases

doSetBindingsInNamespace

member_of, min, max

typeOr

type function

type with expression
This commit is contained in:
Umur Ozkul 2022-05-26 11:09:08 +02:00
parent 00d7304b4b
commit 6b25e82f58
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

@ -189,5 +189,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,82 +24,76 @@ 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 useExpressionToSetBindings = (bindingExpr: expression, environment, statement, newCode) => {
let rExternalBindingsValue = reduceExpression(bindingExpr, bindings, environment)
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(newStatement =>
rNewStatement->Result.map(boundStatement =>
ExpressionWithContext.withContext(
eFunction(
"$_setBindings_$",
list{newBindings->Bindings.toExternalBindings->eRecord, symbolExpr, newStatement},
),
newCode(newBindings->Bindings.toExternalBindings->eRecord, boundStatement),
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(
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(
"$_setBindings_$",
list{
newBindings->Bindings.toExternalBindings->eRecord,
symbolExpr,
newStatement,
},
),
},
),
newBindings,
list{eFunction(setBindingsFn, list{newBindingsExpr, symbolExpr, boundStatement})},
)
)
})
} else {
defaultStatement()
}
| _ => {
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)
)
})
}
| _ => defaultStatement()
}
}

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 => {