basic type compiler
This commit is contained in:
parent
532a878911
commit
4522b46900
|
@ -0,0 +1,62 @@
|
|||
module Expression = Reducer_Expression
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Module = Reducer_Module
|
||||
module T = Reducer_Type_T
|
||||
module TypeCompile = Reducer_Type_Compile
|
||||
|
||||
open Jest
|
||||
open Expect
|
||||
|
||||
let myIevEval = (aTypeSourceCode: string) =>
|
||||
TypeCompile.ievFromTypeExpression(aTypeSourceCode, Expression.reduceExpression)
|
||||
let myIevEvalToString = (aTypeSourceCode: string) =>
|
||||
myIevEval(aTypeSourceCode)->InternalExpressionValue.toStringResult
|
||||
|
||||
let myIevExpectEqual = (aTypeSourceCode, answer) =>
|
||||
expect(myIevEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
|
||||
let _myIevTest = (test, aTypeSourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myIevExpectEqual(aTypeSourceCode, answer))
|
||||
|
||||
let myTypeEval = (aTypeSourceCode: string) =>
|
||||
TypeCompile.fromTypeExpression(aTypeSourceCode, Expression.reduceExpression)
|
||||
let myTypeEvalToString = (aTypeSourceCode: string) => myTypeEval(aTypeSourceCode)->T.toStringResult
|
||||
|
||||
let myTypeExpectEqual = (aTypeSourceCode, answer) =>
|
||||
expect(myTypeEvalToString(aTypeSourceCode))->toEqual(answer)
|
||||
|
||||
let _myTypeTest = (test, aTypeSourceCode, answer) =>
|
||||
test(aTypeSourceCode, () => myTypeExpectEqual(aTypeSourceCode, answer))
|
||||
|
||||
let myIevTest = (aTypeSourceCode, answer) => _myIevTest(test, aTypeSourceCode, answer)
|
||||
let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(test, aTypeSourceCode, answer)
|
||||
module MySkip = {
|
||||
let myIevTest = (aTypeSourceCode, answer) => _myIevTest(Skip.test, aTypeSourceCode, answer)
|
||||
let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(Skip.test, aTypeSourceCode, answer)
|
||||
}
|
||||
module MyOnly = {
|
||||
let myIevTest = (aTypeSourceCode, answer) => _myIevTest(Only.test, aTypeSourceCode, answer)
|
||||
let myTypeTest = (aTypeSourceCode, answer) => _myTypeTest(Only.test, aTypeSourceCode, answer)
|
||||
}
|
||||
|
||||
// | ItTypeIdentifier(string)
|
||||
myTypeTest("number", "number")
|
||||
myTypeTest("(number)", "number")
|
||||
// | ItModifiedType({modifiedType: iType})
|
||||
myIevTest("number<-min(0)", "Ok({min: 0,typeIdentifier: #number,typeTag: 'typeIdentifier'})")
|
||||
myTypeTest("number<-min(0)", "number<-min(0)")
|
||||
// | ItTypeOr({typeOr: array<iType>})
|
||||
myTypeTest("number | string", "(number | string)")
|
||||
// | ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
myTypeTest("number => number => number", "(number => number => number)")
|
||||
// | ItTypeArray({element: iType})
|
||||
myIevTest("[number]", "Ok({element: #number,typeTag: 'typeArray'})")
|
||||
myTypeTest("[number]", "[number]")
|
||||
// | ItTypeTuple({elements: array<iType>})
|
||||
myTypeTest("[number, string]", "[number, string]")
|
||||
// | ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
myIevTest(
|
||||
"{age: number, name: string}",
|
||||
"Ok({properties: {age: #number,name: #string},typeTag: 'typeRecord'})",
|
||||
)
|
||||
myTypeTest("{age: number, name: string}", "{age: number, name: string}")
|
|
@ -198,7 +198,7 @@ let callInternal = (call: functionCall, environment, reducer: ExpressionT.reduce
|
|||
| ("$_typeFunction_$", [IEvArray(arr)]) => TypeBuilder.typeFunction(arr)
|
||||
| ("$_typeTuple_$", [IEvArray(elems)]) => TypeBuilder.typeTuple(elems)
|
||||
| ("$_typeArray_$", [elem]) => TypeBuilder.typeArray(elem)
|
||||
| ("$_typeRecord_$", [IEvArray(arrayOfPairs)]) => TypeBuilder.typeRecord(arrayOfPairs)
|
||||
| ("$_typeRecord_$", [IEvRecord(propertyMap)]) => TypeBuilder.typeRecord(propertyMap)
|
||||
| ("concat", [IEvArray(aValueArray), IEvArray(bValueArray)]) =>
|
||||
doAddArray(aValueArray, bValueArray)
|
||||
| ("concat", [IEvString(aValueString), IEvString(bValueString)]) =>
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
// There are switch stament cases in the code which are impossible to reach by design.
|
||||
// There are switch statement cases in the code which are impossible to reach by design.
|
||||
// ImpossibleException is a sign of programming error.
|
||||
exception ImpossibleException
|
||||
exception ImpossibleException(string)
|
||||
|
|
|
@ -0,0 +1,36 @@
|
|||
module ErrorValue = Reducer_ErrorValue
|
||||
module ExpressionT = Reducer_Expression_T
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module Module = Reducer_Module
|
||||
module T = Reducer_Type_T
|
||||
|
||||
let ievFromTypeExpression = (
|
||||
typeExpressionSourceCode: string,
|
||||
reducerFn: ExpressionT.reducerFn,
|
||||
): result<InternalExpressionValue.t, ErrorValue.t> => {
|
||||
let sIndex = "compiled"
|
||||
let sourceCode = `type ${sIndex}=${typeExpressionSourceCode}`
|
||||
Reducer_Expression.parse(sourceCode)->Belt.Result.flatMap(expr => {
|
||||
let rContext = reducerFn(expr, Module.emptyBindings, InternalExpressionValue.defaultEnvironment)
|
||||
Belt.Result.map(rContext, context =>
|
||||
switch context {
|
||||
| IEvModule(nameSpace) =>
|
||||
switch Module.getType(nameSpace, sIndex) {
|
||||
| Some(value) => value
|
||||
| None => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-none"))
|
||||
}
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_Compile-raise"))
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
let fromTypeExpression = (
|
||||
typeExpressionSourceCode: string,
|
||||
reducerFn: ExpressionT.reducerFn,
|
||||
): result<T.t, ErrorValue.t> => {
|
||||
ievFromTypeExpression(
|
||||
(typeExpressionSourceCode: string),
|
||||
(reducerFn: ExpressionT.reducerFn),
|
||||
)->Belt.Result.map(T.fromIEvValue)
|
||||
}
|
|
@ -3,13 +3,41 @@ open InternalExpressionValue
|
|||
|
||||
type rec iType =
|
||||
| ItTypeIdentifier(string)
|
||||
| ItModifiedType({modifiedType: iType})
|
||||
| ItModifiedType({modifiedType: iType, modifiers: Belt.Map.String.t<InternalExpressionValue.t>})
|
||||
| ItTypeOr({typeOr: array<iType>})
|
||||
| ItTypeFunction({inputs: array<iType>, output: iType})
|
||||
| ItTypeArray({element: iType})
|
||||
| ItTypeTuple({elements: array<iType>})
|
||||
| ItTypeRecord({properties: Belt.Map.String.t<iType>})
|
||||
|
||||
type t = iType
|
||||
|
||||
let rec toString = (t: t): string => {
|
||||
switch t {
|
||||
| ItTypeIdentifier(s) => s
|
||||
| ItModifiedType({modifiedType, modifiers}) =>
|
||||
`${toString(modifiedType)}${modifiers->Belt.Map.String.reduce("", (acc, k, v) =>
|
||||
Js.String2.concatMany(acc, ["<-", k, "(", InternalExpressionValue.toString(v), ")"])
|
||||
)}`
|
||||
| ItTypeOr({typeOr}) => `(${Js.Array2.map(typeOr, toString)->Js.Array2.joinWith(" | ")})`
|
||||
| ItTypeFunction({inputs, output}) =>
|
||||
`(${inputs->Js.Array2.map(toString)->Js.Array2.joinWith(" => ")} => ${toString(output)})`
|
||||
| ItTypeArray({element}) => `[${toString(element)}]`
|
||||
| ItTypeTuple({elements}) => `[${Js.Array2.map(elements, toString)->Js.Array2.joinWith(", ")}]`
|
||||
| ItTypeRecord({properties}) =>
|
||||
`{${properties
|
||||
->Belt.Map.String.toArray
|
||||
->Js.Array2.map(((k, v)) => Js.String2.concatMany(k, [": ", toString(v)]))
|
||||
->Js.Array2.joinWith(", ")}}`
|
||||
}
|
||||
}
|
||||
|
||||
let toStringResult = (rt: result<t, ErrorValue.t>) =>
|
||||
switch rt {
|
||||
| Ok(t) => toString(t)
|
||||
| Error(e) => ErrorValue.errorToString(e)
|
||||
}
|
||||
|
||||
let rec fromTypeMap = typeMap => {
|
||||
let default = IEvString("")
|
||||
let evTypeTag: InternalExpressionValue.t = Belt.Map.String.getWithDefault(
|
||||
|
@ -52,31 +80,39 @@ let rec fromTypeMap = typeMap => {
|
|||
"properties",
|
||||
default,
|
||||
)
|
||||
//TODO: map type modifiers
|
||||
switch evTypeTag {
|
||||
| IEvString("typeIdentifier") => ItModifiedType({modifiedType: fromIEvValue(evTypeIdentifier)})
|
||||
|
||||
let modifiers =
|
||||
typeMap->Belt.Map.String.keep((k, _v) => ["min", "max", "memberOf"]->Js.Array2.includes(k))
|
||||
|
||||
let makeIt = switch evTypeTag {
|
||||
| IEvString("typeIdentifier") => fromIEvValue(evTypeIdentifier)
|
||||
| IEvString("typeOr") => ItTypeOr({typeOr: fromIEvArray(evTypeOr)})
|
||||
| IEvString("typeFunction") =>
|
||||
ItTypeFunction({inputs: fromIEvArray(evInputs), output: fromIEvValue(evOutput)})
|
||||
| IEvString("typeArray") => ItTypeArray({element: fromIEvValue(evElement)})
|
||||
| IEvString("typeTuple") => ItTypeTuple({elements: fromIEvArray(evElements)})
|
||||
| IEvString("typeRecord") => ItTypeRecord({properties: fromIEvRecord(evProperties)})
|
||||
| _ => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-evTypeTag"))
|
||||
}
|
||||
|
||||
Belt.Map.String.isEmpty(modifiers)
|
||||
? makeIt
|
||||
: ItModifiedType({modifiedType: makeIt, modifiers: modifiers})
|
||||
}
|
||||
and fromIEvValue = (ievValue: InternalExpressionValue.t) =>
|
||||
|
||||
and fromIEvValue = (ievValue: InternalExpressionValue.t): iType =>
|
||||
switch ievValue {
|
||||
| IEvTypeIdentifier(typeIdentifier) => ItTypeIdentifier({typeIdentifier})
|
||||
| IEvType(typeMap) => fromTypeMap(typeMap)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievValue"))
|
||||
}
|
||||
and fromIEvArray = (ievArray: InternalExpressionValue.t) =>
|
||||
switch ievArray {
|
||||
| IEvArray(array) => array->Belt.Array.map(fromIEvValue)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievArray"))
|
||||
}
|
||||
and fromIEvRecord = (ievRecord: InternalExpressionValue.t) =>
|
||||
switch ievRecord {
|
||||
| IEvRecord(record) => record->Belt.Map.String.map(fromIEvValue)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_Type_T-ievRecord"))
|
||||
}
|
||||
|
|
|
@ -56,7 +56,7 @@ let typeFunction = anArray => {
|
|||
|
||||
let typeArray = element => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeTuple")),
|
||||
("typeTag", IEvString("typeArray")),
|
||||
("element", element),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
|
@ -64,22 +64,14 @@ let typeArray = element => {
|
|||
|
||||
let typeTuple = anArray => {
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeArray")),
|
||||
("typeTag", IEvString("typeTuple")),
|
||||
("elements", IEvArray(anArray)),
|
||||
])
|
||||
newRecord->IEvType->Ok
|
||||
}
|
||||
|
||||
let typeRecord = arrayOfPairs => {
|
||||
let newProperties =
|
||||
Belt.Array.map(arrayOfPairs, pairValue =>
|
||||
switch pairValue {
|
||||
| IEvArray([IEvString(key), valueValue]) => (key, valueValue)
|
||||
| _ => ("wrong key type", pairValue->toStringWithType->IEvString)
|
||||
}
|
||||
)
|
||||
->Belt.Map.String.fromArray
|
||||
->IEvRecord
|
||||
let typeRecord = propertyMap => {
|
||||
let newProperties = propertyMap->IEvRecord
|
||||
let newRecord = Belt.Map.String.fromArray([
|
||||
("typeTag", IEvString("typeRecord")),
|
||||
("properties", newProperties),
|
||||
|
|
|
@ -1,13 +1,10 @@
|
|||
module ExpressionT = Reducer_Expression_T
|
||||
// module ErrorValue = Reducer_ErrorValue
|
||||
module InternalExpressionValue = ReducerInterface_InternalExpressionValue
|
||||
module T = Reducer_Type_T
|
||||
module TypeBuilder = Reducer_Type_TypeBuilder
|
||||
// module TypeBuilder = Reducer_Type_TypeBuilder
|
||||
open InternalExpressionValue
|
||||
|
||||
type typeErrorValue =
|
||||
| TypeError(T.iType, InternalExpressionValue.t)
|
||||
| TypeErrorWithPosition(T.iType, InternalExpressionValue.t, int)
|
||||
| TypeErrorWithProperty(T.iType, InternalExpressionValue.t, string)
|
||||
type typeErrorValue = TypeError(T.t, InternalExpressionValue.t)
|
||||
|
||||
let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorValue> => {
|
||||
let caseTypeIdentifier = (anUpperTypeName, aValue) => {
|
||||
|
@ -24,16 +21,16 @@ let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorVa
|
|||
Belt.Result.flatMap(acc, _ =>
|
||||
switch Belt.Map.String.get(map, property) {
|
||||
| Some(propertyValue) => isOfResolvedIType(propertyType, propertyValue)
|
||||
| None => TypeErrorWithProperty(anIType, evValue, property)->Error
|
||||
| None => TypeError(anIType, evValue)->Error
|
||||
}
|
||||
)
|
||||
})
|
||||
}
|
||||
let _caseArray = (anIType, evValue, elementType, anArray) => {
|
||||
Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, index) => {
|
||||
Belt.Array.reduceWithIndex(anArray, Ok(true), (acc, element, _index) => {
|
||||
switch isOfResolvedIType(elementType, element) {
|
||||
| Ok(_) => acc
|
||||
| Error(_) => TypeErrorWithPosition(anIType, evValue, index)->Error
|
||||
| Error(_) => TypeError(anIType, evValue)->Error
|
||||
}
|
||||
})
|
||||
}
|
||||
|
@ -48,12 +45,12 @@ let rec isOfResolvedIType = (anIType: T.iType, aValue): result<bool, typeErrorVa
|
|||
// | ItTypeArray({element: anIType}) => raise(Reducer_Exception.ImpossibleException)
|
||||
// | ItTypeTuple({elements: anITypeArray}) => raise(Reducer_Exception.ImpossibleException)
|
||||
// | ItTypeRecord({properties: anITypeMap}) => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException)
|
||||
| _ => raise(Reducer_Exception.ImpossibleException("Reducer_TypeChecker-isOfResolvedIType"))
|
||||
}
|
||||
}
|
||||
|
||||
let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
|
||||
aType->T.fromIEvValue->isOfResolvedIType(aValue)
|
||||
// let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool, typeErrorValue> =>
|
||||
// aType->T.fromIEvValue->isOfResolvedIType(aValue)
|
||||
|
||||
// TODO: Work in progress. Code is commented to make an a release of other features
|
||||
// let checkArguments = (
|
||||
|
@ -70,12 +67,5 @@ let isOfResolvedType = (aType: InternalExpressionValue.t, aValue): result<bool,
|
|||
// | _ => raise(Reducer_Exception.ImpossibleException)
|
||||
// }
|
||||
// let rTupleType = TypeBuilder.typeTuple(inputs)
|
||||
// Belt.Result.flatMap(rTupleType, tuppleType => isOfResolvedType(tuppleType, args->IEvArray))
|
||||
// Belt.Result.flatMap(rTupleType, tupleType => isOfResolvedType(tupleType, args->IEvArray))
|
||||
// }
|
||||
|
||||
// let compileTypeExpression = (typeExpression: string, bindings: ExpressionT.bindings, reducerFn: ExpressionT.reducerFn) => {
|
||||
// statement = `type compiled=${typeExpression}`
|
||||
|
||||
// }
|
||||
|
||||
//TODO: asGuard
|
||||
|
|
Loading…
Reference in New Issue
Block a user