From 6ae71964c51df67c03d318b2d2cac4bdb5f28a5b Mon Sep 17 00:00:00 2001 From: Stachu Korick Date: Thu, 15 Aug 2024 12:13:33 -0400 Subject: [PATCH] Handle match in new interpreter --- backend/src/BuiltinExecution/Builtin.fs | 3 +- .../BuiltinExecution/BuiltinExecution.fsproj | 2 +- backend/src/BuiltinExecution/Libs/Int64.fs | 69 +- backend/src/BuiltinExecution/Libs/NoModule.fs | 760 +++++++------- backend/src/LibExecution/DvalReprDeveloper.fs | 28 +- backend/src/LibExecution/Interpreter.fs | 100 ++ backend/src/LibExecution/ProgramTypes.fs | 67 +- .../ProgramTypesToRuntimeTypes.fs | 204 +++- backend/src/LibExecution/RuntimeTypes.fs | 72 +- backend/src/LibExecution/TypeChecker.fs | 24 +- backend/src/Prelude/NEList.fs | 4 +- backend/tests/TestUtils/PTShortcuts.fs | 31 +- backend/tests/Tests/Interpreter.Tests.fs | 220 ++-- backend/tests/Tests/PT2RT.Tests.fs | 942 ++++++++++-------- tree-sitter-darklang/package-lock.json | 1 - 15 files changed, 1475 insertions(+), 1052 deletions(-) diff --git a/backend/src/BuiltinExecution/Builtin.fs b/backend/src/BuiltinExecution/Builtin.fs index 60393bd116..2bd9ffb11e 100644 --- a/backend/src/BuiltinExecution/Builtin.fs +++ b/backend/src/BuiltinExecution/Builtin.fs @@ -12,8 +12,7 @@ let fnRenames = let builtins : Builtins = Builtin.combine - [ - // Libs.NoModule.builtins + [ Libs.NoModule.builtins // Libs.Bool.builtins diff --git a/backend/src/BuiltinExecution/BuiltinExecution.fsproj b/backend/src/BuiltinExecution/BuiltinExecution.fsproj index 030889865d..c079e05a3c 100644 --- a/backend/src/BuiltinExecution/BuiltinExecution.fsproj +++ b/backend/src/BuiltinExecution/BuiltinExecution.fsproj @@ -10,7 +10,7 @@ - + diff --git a/backend/src/BuiltinExecution/Libs/Int64.fs b/backend/src/BuiltinExecution/Libs/Int64.fs index 8bea7b896e..5909d9a8f1 100644 --- a/backend/src/BuiltinExecution/Libs/Int64.fs +++ b/backend/src/BuiltinExecution/Libs/Int64.fs @@ -38,43 +38,42 @@ module PackageIDs = LibExecution.PackageIDs let fns : List = - [ - // { name = fn "int64Mod" 0 - // typeParams = [] - // parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] - // returnType = TInt64 - // description = - // "Returns the result of wrapping around so that {{0 <= res < b}}. + [ { name = fn "int64Mod" 0 + typeParams = [] + parameters = [ Param.make "a" TInt64 ""; Param.make "b" TInt64 "" ] + returnType = TInt64 + description = + "Returns the result of wrapping around so that {{0 <= res < b}}. - // The modulus must be greater than 0. + The modulus must be greater than 0. - // Use if you want the remainder after division, which has - // a different behavior for negative numbers." - // fn = - // (function - // | state, _, [ DInt64 v; DInt64 m ] -> - // if m = 0L then - // IntRuntimeError.Error.ZeroModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else if m < 0L then - // IntRuntimeError.Error.NegativeModulus - // |> IntRuntimeError.RTE.toRuntimeError - // |> raiseRTE state.tracing.callStack - // |> Ply - // else - // let result = v % m - // let result = if result < 0L then m + result else result - // Ply(DInt64(result)) - // | _ -> incorrectArgs ()) - // sqlSpec = SqlBinOp "%" - // previewable = Pure - // // TODO: Deprecate this when we can version infix operators - // // and when infix operators support Result return types - // // (https://github.com/darklang/dark/issues/4267) - // // The current function returns an RTE (it used to rollbar) on negative `b`. - // deprecated = NotDeprecated } + Use if you want the remainder after division, which has + a different behavior for negative numbers." + fn = + (function + | _state, _, _, [ DInt64 v; DInt64 m ] -> + // if m = 0L then + // IntRuntimeError.Error.ZeroModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else if m < 0L then + // IntRuntimeError.Error.NegativeModulus + // |> IntRuntimeError.RTE.toRuntimeError + // |> raiseRTE state.tracing.callStack + // |> Ply + // else + let result = v % m + let result = if result < 0L then m + result else result + Ply(DInt64(result)) + | _ -> incorrectArgs ()) + //sqlSpec = SqlBinOp "%" + previewable = Pure + // TODO: Deprecate this when we can version infix operators + // and when infix operators support Result return types + // (https://github.com/darklang/dark/issues/4267) + // The current function returns an RTE (it used to rollbar) on negative `b`. + deprecated = NotDeprecated } // See above for when to uncomment this diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 3a4aee18eb..08c8104167 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -12,314 +12,325 @@ module Dval = LibExecution.Dval let rec equals (a : Dval) (b : Dval) : bool = match a, b with - | DInt64 a, DInt64 b -> a = b - | DUInt64 a, DUInt64 b -> a = b + | DUnit, DUnit -> true + + | DBool a, DBool b -> a = b + | DInt8 a, DInt8 b -> a = b | DUInt8 a, DUInt8 b -> a = b | DInt16 a, DInt16 b -> a = b | DUInt16 a, DUInt16 b -> a = b | DInt32 a, DInt32 b -> a = b | DUInt32 a, DUInt32 b -> a = b + | DInt64 a, DInt64 b -> a = b + | DUInt64 a, DUInt64 b -> a = b | DInt128 a, DInt128 b -> a = b | DUInt128 a, DUInt128 b -> a = b + | DFloat a, DFloat b -> a = b - | DBool a, DBool b -> a = b - | DUnit, DUnit -> true - | DString a, DString b -> a = b + | DChar a, DChar b -> a = b + | DString a, DString b -> a = b + + | DDateTime a, DDateTime b -> a = b + + | DUuid a, DUuid b -> a = b + | DList(typA, a), DList(typB, b) -> Result.isOk (ValueType.merge typA typB) && a.Length = b.Length && List.forall2 equals a b + | DTuple(a1, a2, a3), DTuple(b1, b2, b3) -> if a3.Length <> b3.Length then // special case - this is a type error raiseUntargetedString "tuples must be the same length" else equals a1 b1 && equals a2 b2 && List.forall2 equals a3 b3 + | DDict(_vtTODO1, a), DDict(_vtTODO2, b) -> Map.count a = Map.count b && Map.forall (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) a - | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> - tn1 = tn2 // these should be the fully resolved type - && Map.count a = Map.count b - && Map.forall - (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) - a + + // | DRecord(tn1, _, _typeArgsTODO1, a), DRecord(tn2, _, _typeArgsTODO2, b) -> + // tn1 = tn2 // these should be the fully resolved type + // && Map.count a = Map.count b + // && Map.forall + // (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) + // a | DFnVal a, DFnVal b -> match a, b with - | Lambda a, Lambda b -> equalsLambdaImpl a b + // | Lambda a, Lambda b -> equalsLambdaImpl a b | NamedFn a, NamedFn b -> a = b - | Lambda _, _ - | NamedFn _, _ -> false - | DDateTime a, DDateTime b -> a = b - | DUuid a, DUuid b -> a = b - | DDB a, DDB b -> a = b - | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type - a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 equals a3 b3 + // | Lambda _, _ + //| NamedFn _, _ -> false + // | DDB a, DDB b -> a = b + // | DEnum(a1, _, _typeArgsTODO1, a2, a3), DEnum(b1, _, _typeArgsTODO2, b2, b3) -> // these should be the fully resolved type + // a1 = b1 && a2 = b2 && a3.Length = b3.Length && List.forall2 equals a3 b3 // exhaustiveness check - | DInt64 _, _ - | DUInt64 _, _ + | DUnit, _ + | DBool _, _ | DInt8 _, _ | DUInt8 _, _ | DInt16 _, _ | DUInt16 _, _ | DInt32 _, _ | DUInt32 _, _ + | DInt64 _, _ + | DUInt64 _, _ | DInt128 _, _ | DUInt128 _, _ | DFloat _, _ - | DBool _, _ - | DUnit, _ | DString _, _ | DChar _, _ | DList _, _ | DTuple _, _ | DDict _, _ - | DRecord _, _ + //| DRecord _, _ | DFnVal _, _ | DDateTime _, _ | DUuid _, _ - | DDB _, _ - | DEnum _, _ -> raiseUntargetedString "Both values must be the same type" - -and equalsLambdaImpl (impl1 : LambdaImpl) (impl2 : LambdaImpl) : bool = - // TODO what to do for TypeSymbolTable - NEList.length impl1.parameters = NEList.length impl2.parameters - && NEList.forall2 - (fun p1 p2 -> equalsLetPattern p1 p2) - impl1.parameters - impl2.parameters - && equalsSymtable impl1.symtable impl2.symtable - && equalsExpr impl1.body impl2.body - -and equalsSymtable (a : Symtable) (b : Symtable) : bool = - Map.count a = Map.count b - && Map.forall - (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) - a - -and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = - match expr1, expr2 with - | EInt64(_, int1), EInt64(_, int2) -> int1 = int2 - | EUInt64(_, int1), EUInt64(_, int2) -> int1 = int2 - | EInt8(_, int1), EInt8(_, int2) -> int1 = int2 - | EUInt8(_, int1), EUInt8(_, int2) -> int1 = int2 - | EInt16(_, int1), EInt16(_, int2) -> int1 = int2 - | EUInt16(_, int1), EUInt16(_, int2) -> int1 = int2 - | EInt32(_, int1), EInt32(_, int2) -> int1 = int2 - | EUInt32(_, int1), EUInt32(_, int2) -> int1 = int2 - | EInt128(_, int1), EInt128(_, int2) -> int1 = int2 - | EUInt128(_, int1), EUInt128(_, int2) -> int1 = int2 - | EBool(_, bool1), EBool(_, bool2) -> bool1 = bool2 - | EString(_, segments1), EString(_, segments2) -> - equalsStringSegments segments1 segments2 - | EChar(_, char1), EChar(_, char2) -> char1 = char2 - | EFloat(_, float1), EFloat(_, float2) -> float1 = float2 - | EUnit _, EUnit _ -> true - | EConstant(_, name1), EConstant(_, name2) -> name1 = name2 - | ELet(_, pattern1, expr1, body1), ELet(_, pattern2, expr2, body2) -> - equalsLetPattern pattern1 pattern2 - && equalsExpr expr1 expr2 - && equalsExpr body1 body2 - | EIf(_, cond1, then1, else1), EIf(_, cond2, then2, else2) -> - let equalsElseExpr else1 else2 = - match else1, else2 with - | Some else1, Some else2 -> equalsExpr else1 else2 - | None, None -> true - | _, _ -> false - equalsExpr cond1 cond2 && equalsExpr then1 then2 && equalsElseExpr else1 else2 - - | ELambda(_, pats1, body1), ELambda(_, pats2, body2) -> - NEList.length pats1 = NEList.length pats2 - && NEList.forall2 (fun p1 p2 -> equalsLetPattern p1 p2) pats1 pats2 - && equalsExpr body1 body2 - | ERecordFieldAccess(_, target1, fieldName1), - ERecordFieldAccess(_, target2, fieldName2) -> - equalsExpr target1 target2 && fieldName1 = fieldName2 - | EVariable(_, name1), EVariable(_, name2) -> name1 = name2 - | EApply(_, name1, typeArgs1, args1), EApply(_, name2, typeArgs2, args2) -> - equalsExpr name1 name2 - && List.forall2 (=) typeArgs1 typeArgs2 - && NEList.forall2 equalsExpr args1 args2 - | EFnName(_, name1), EFnName(_, name2) -> name1 = name2 - | EList(_, elems1), EList(_, elems2) -> - elems1.Length = elems2.Length && List.forall2 equalsExpr elems1 elems2 - | ETuple(_, elem1_1, elem2_1, elems1), ETuple(_, elem1_2, elem2_2, elems2) -> - equalsExpr elem1_1 elem1_2 - && equalsExpr elem2_1 elem2_2 - && elems1.Length = elems2.Length - && List.forall2 equalsExpr elems1 elems2 - | ERecord(_, typeName, fields1), ERecord(_, typeName', fields2) -> - typeName = typeName' - && NEList.length fields1 = NEList.length fields2 - && NEList.forall2 - (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) - fields1 - fields2 - | ERecordUpdate(_, record1, updates1), ERecordUpdate(_, record2, updates2) -> - record1 = record2 - && NEList.length updates1 = NEList.length updates2 - && NEList.forall2 - (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) - updates1 - updates2 - | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> - typeName = typeName' - && caseName = caseName' - && fields.Length = fields'.Length - && List.forall2 equalsExpr fields fields' - | EMatch(_, target1, cases1), EMatch(_, target2, cases2) -> - equalsExpr target1 target2 - && NEList.length cases1 = NEList.length cases2 - && NEList.forall2 - (fun case1 case2 -> - let equalsWhenCondition when1 when2 = - match when1, when2 with - | Some when1, Some when2 -> equalsExpr when1 when2 - | None, None -> true - | _, _ -> false - equalsMatchPattern case1.pat case2.pat - && equalsWhenCondition case1.whenCondition case2.whenCondition - && equalsExpr case1.rhs case2.rhs) - cases1 - cases2 - | EAnd(_, lhs1, rhs1), EAnd(_, lhs2, rhs2) -> - equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 - | EOr(_, lhs1, rhs1), EOr(_, lhs2, rhs2) -> - equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 - | EDict(_, fields1), EDict(_, fields2) -> - fields1.Length = fields2.Length - && List.forall2 - (fun (k1, v1) (k2, v2) -> k1 = k2 && equalsExpr v1 v2) - fields1 - fields2 - | EError(_, msg, exprs), EError(_, msg2, exprs2) -> - msg = msg2 && List.forall2 equalsExpr exprs exprs2 - - // exhaustiveness check - | EInt64 _, _ - | EUInt64 _, _ - | EInt8 _, _ - | EUInt8 _, _ - | EInt16 _, _ - | EUInt16 _, _ - | EInt32 _, _ - | EUInt32 _, _ - | EInt128 _, _ - | EUInt128 _, _ - | EBool _, _ - | EString _, _ - | EChar _, _ - | EFloat _, _ - | EUnit _, _ - | EConstant _, _ - | ELet _, _ - | EIf _, _ - | ELambda _, _ - | ERecordFieldAccess _, _ - | EVariable _, _ - | EApply _, _ - | EFnName _, _ - | EList _, _ - | ETuple _, _ - | ERecord _, _ - | ERecordUpdate _, _ - | EEnum _, _ - | EMatch _, _ - | EAnd _, _ - | EOr _, _ - | EDict _, _ - | EEnum _, _ - | EError _, _ -> false - - -and equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : bool = - match pattern1, pattern2 with - | LPVariable(_, name1), LPVariable(_, name2) -> name1 = name2 - | LPUnit _, LPUnit _ -> true - - | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> - let all = first :: second :: theRest - let all' = first' :: second' :: theRest' - all.Length = all'.Length && List.forall2 equalsLetPattern all all' - - | LPTuple _, _ - | LPUnit _, _ - | LPVariable _, _ -> false - -and equalsStringSegments - (segments1 : List) - (segments2 : List) - : bool = - segments1.Length = segments2.Length - && List.forall2 equalsStringSegment segments1 segments2 - -and equalsStringSegment - (segment1 : StringSegment) - (segment2 : StringSegment) - : bool = - match segment1, segment2 with - | StringText text1, StringText text2 -> text1 = text2 - | StringInterpolation expr1, StringInterpolation expr2 -> equalsExpr expr1 expr2 - // exhaustiveness check - | StringText _, _ - | StringInterpolation _, _ -> false - -and equalsMatchPattern (pattern1 : MatchPattern) (pattern2 : MatchPattern) : bool = - match pattern1, pattern2 with - | MPVariable(_, name1), MPVariable(_, name2) -> name1 = name2 - | MPEnum(_, tag1, args1), MPEnum(_, tag2, args2) -> - tag1 = tag2 - && args1.Length = args2.Length - && List.forall2 equalsMatchPattern args1 args2 - | MPInt64(_, int1), MPInt64(_, int2) -> int1 = int2 - | MPUInt64(_, int1), MPUInt64(_, int2) -> int1 = int2 - | MPInt8(_, int1), MPInt8(_, int2) -> int1 = int2 - | MPUInt8(_, int1), MPUInt8(_, int2) -> int1 = int2 - | MPInt16(_, int1), MPInt16(_, int2) -> int1 = int2 - | MPUInt16(_, int1), MPUInt16(_, int2) -> int1 = int2 - | MPInt32(_, int1), MPInt32(_, int2) -> int1 = int2 - | MPUInt32(_, int1), MPUInt32(_, int2) -> int1 = int2 - | MPInt128(_, int1), MPInt128(_, int2) -> int1 = int2 - | MPUInt128(_, int1), MPUInt128(_, int2) -> int1 = int2 - | MPBool(_, bool1), MPBool(_, bool2) -> bool1 = bool2 - | MPChar(_, char1), MPChar(_, char2) -> char1 = char2 - | MPString(_, str1), MPString(_, str2) -> str1 = str2 - | MPFloat(_, float1), MPFloat(_, float2) -> float1 = float2 - | MPUnit _, MPUnit _ -> true - | MPTuple(_, elem1_1, elem2_1, elems1), MPTuple(_, elem1_2, elem2_2, elems2) -> - equalsMatchPattern elem1_1 elem1_2 - && equalsMatchPattern elem2_1 elem2_2 - && elems1.Length = elems2.Length - && List.forall2 equalsMatchPattern elems1 elems2 - | MPList(_, elems1), MPList(_, elems2) -> - elems1.Length = elems2.Length && List.forall2 equalsMatchPattern elems1 elems2 - | MPListCons(_, head, tail), MPListCons(_, head', tail') -> - equalsMatchPattern head head' && equalsMatchPattern tail tail' - // exhaustiveness check - | MPVariable _, _ - | MPEnum _, _ - | MPInt64 _, _ - | MPUInt64 _, _ - | MPInt8 _, _ - | MPUInt8 _, _ - | MPInt16 _, _ - | MPUInt16 _, _ - | MPInt32 _, _ - | MPUInt32 _, _ - | MPInt128 _, _ - | MPUInt128 _, _ - | MPBool _, _ - | MPChar _, _ - | MPString _, _ - | MPFloat _, _ - | MPUnit _, _ - | MPTuple _, _ - | MPListCons _, _ - | MPList _, _ -> false + // | DDB _, _ + // | DEnum _, _ + -> raiseUntargetedString "Both values must be the same type" + +// and equalsLambdaImpl (impl1 : LambdaImpl) (impl2 : LambdaImpl) : bool = +// // TODO what to do for TypeSymbolTable +// NEList.length impl1.parameters = NEList.length impl2.parameters +// && NEList.forall2 +// (fun p1 p2 -> equalsLetPattern p1 p2) +// impl1.parameters +// impl2.parameters +// && equalsSymtable impl1.symtable impl2.symtable +// && equalsExpr impl1.body impl2.body + +// and equalsSymtable (a : Symtable) (b : Symtable) : bool = +// Map.count a = Map.count b +// && Map.forall +// (fun k v -> Map.find k b |> Option.map (equals v) |> Option.defaultValue false) +// a + +// and equalsExpr (expr1 : Expr) (expr2 : Expr) : bool = +// match expr1, expr2 with +// | EInt64(_, int1), EInt64(_, int2) -> int1 = int2 +// | EUInt64(_, int1), EUInt64(_, int2) -> int1 = int2 +// | EInt8(_, int1), EInt8(_, int2) -> int1 = int2 +// | EUInt8(_, int1), EUInt8(_, int2) -> int1 = int2 +// | EInt16(_, int1), EInt16(_, int2) -> int1 = int2 +// | EUInt16(_, int1), EUInt16(_, int2) -> int1 = int2 +// | EInt32(_, int1), EInt32(_, int2) -> int1 = int2 +// | EUInt32(_, int1), EUInt32(_, int2) -> int1 = int2 +// | EInt128(_, int1), EInt128(_, int2) -> int1 = int2 +// | EUInt128(_, int1), EUInt128(_, int2) -> int1 = int2 +// | EBool(_, bool1), EBool(_, bool2) -> bool1 = bool2 +// | EString(_, segments1), EString(_, segments2) -> +// equalsStringSegments segments1 segments2 +// | EChar(_, char1), EChar(_, char2) -> char1 = char2 +// | EFloat(_, float1), EFloat(_, float2) -> float1 = float2 +// | EUnit _, EUnit _ -> true +// | EConstant(_, name1), EConstant(_, name2) -> name1 = name2 +// | ELet(_, pattern1, expr1, body1), ELet(_, pattern2, expr2, body2) -> +// equalsLetPattern pattern1 pattern2 +// && equalsExpr expr1 expr2 +// && equalsExpr body1 body2 +// | EIf(_, cond1, then1, else1), EIf(_, cond2, then2, else2) -> +// let equalsElseExpr else1 else2 = +// match else1, else2 with +// | Some else1, Some else2 -> equalsExpr else1 else2 +// | None, None -> true +// | _, _ -> false +// equalsExpr cond1 cond2 && equalsExpr then1 then2 && equalsElseExpr else1 else2 + +// // | ELambda(_, pats1, body1), ELambda(_, pats2, body2) -> +// // NEList.length pats1 = NEList.length pats2 +// // && NEList.forall2 (fun p1 p2 -> equalsLetPattern p1 p2) pats1 pats2 +// // && equalsExpr body1 body2 +// // | ERecordFieldAccess(_, target1, fieldName1), +// // ERecordFieldAccess(_, target2, fieldName2) -> +// // equalsExpr target1 target2 && fieldName1 = fieldName2 +// | EVariable(_, name1), EVariable(_, name2) -> name1 = name2 +// | EApply(_, name1, typeArgs1, args1), EApply(_, name2, typeArgs2, args2) -> +// equalsExpr name1 name2 +// && List.forall2 (=) typeArgs1 typeArgs2 +// && NEList.forall2 equalsExpr args1 args2 +// | EFnName(_, name1), EFnName(_, name2) -> name1 = name2 +// | EList(_, elems1), EList(_, elems2) -> +// elems1.Length = elems2.Length && List.forall2 equalsExpr elems1 elems2 +// | ETuple(_, elem1_1, elem2_1, elems1), ETuple(_, elem1_2, elem2_2, elems2) -> +// equalsExpr elem1_1 elem1_2 +// && equalsExpr elem2_1 elem2_2 +// && elems1.Length = elems2.Length +// && List.forall2 equalsExpr elems1 elems2 +// // | ERecord(_, typeName, fields1), ERecord(_, typeName', fields2) -> +// // typeName = typeName' +// // && NEList.length fields1 = NEList.length fields2 +// // && NEList.forall2 +// // (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) +// // fields1 +// // fields2 +// // | ERecordUpdate(_, record1, updates1), ERecordUpdate(_, record2, updates2) -> +// // record1 = record2 +// // && NEList.length updates1 = NEList.length updates2 +// // && NEList.forall2 +// // (fun (name1, expr1) (name2, expr2) -> name1 = name2 && equalsExpr expr1 expr2) +// // updates1 +// // updates2 +// // | EEnum(_, typeName, caseName, fields), EEnum(_, typeName', caseName', fields') -> +// // typeName = typeName' +// // && caseName = caseName' +// // && fields.Length = fields'.Length +// // && List.forall2 equalsExpr fields fields' +// | EMatch(_, target1, cases1), EMatch(_, target2, cases2) -> +// equalsExpr target1 target2 +// && NEList.length cases1 = NEList.length cases2 +// && NEList.forall2 +// (fun case1 case2 -> +// let equalsWhenCondition when1 when2 = +// match when1, when2 with +// | Some when1, Some when2 -> equalsExpr when1 when2 +// | None, None -> true +// | _, _ -> false +// equalsMatchPattern case1.pat case2.pat +// && equalsWhenCondition case1.whenCondition case2.whenCondition +// && equalsExpr case1.rhs case2.rhs) +// cases1 +// cases2 +// | EAnd(_, lhs1, rhs1), EAnd(_, lhs2, rhs2) -> +// equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 +// | EOr(_, lhs1, rhs1), EOr(_, lhs2, rhs2) -> +// equalsExpr lhs1 lhs2 && equalsExpr rhs1 rhs2 +// | EDict(_, fields1), EDict(_, fields2) -> +// fields1.Length = fields2.Length +// && List.forall2 +// (fun (k1, v1) (k2, v2) -> k1 = k2 && equalsExpr v1 v2) +// fields1 +// fields2 +// | EError(_, msg, exprs), EError(_, msg2, exprs2) -> +// msg = msg2 && List.forall2 equalsExpr exprs exprs2 + +// // exhaustiveness check +// | EInt64 _, _ +// | EUInt64 _, _ +// | EInt8 _, _ +// | EUInt8 _, _ +// | EInt16 _, _ +// | EUInt16 _, _ +// | EInt32 _, _ +// | EUInt32 _, _ +// | EInt128 _, _ +// | EUInt128 _, _ +// | EBool _, _ +// | EString _, _ +// | EChar _, _ +// | EFloat _, _ +// | EUnit _, _ +// // | EConstant _, _ +// | ELet _, _ +// | EIf _, _ +// // | ELambda _, _ +// // | ERecordFieldAccess _, _ +// | EVariable _, _ +// | EApply _, _ +// | EFnName _, _ +// | EList _, _ +// | ETuple _, _ +// // | ERecord _, _ +// // | ERecordUpdate _, _ +// // | EEnum _, _ +// | EMatch _, _ +// | EAnd _, _ +// | EOr _, _ +// | EDict _, _ +// // | EEnum _, _ +// | EError _, _ -> false + + +// and equalsLetPattern (pattern1 : LetPattern) (pattern2 : LetPattern) : bool = +// match pattern1, pattern2 with +// | LPVariable(_, name1), LPVariable(_, name2) -> name1 = name2 +// | LPUnit _, LPUnit _ -> true + +// | LPTuple(_, first, second, theRest), LPTuple(_, first', second', theRest') -> +// let all = first :: second :: theRest +// let all' = first' :: second' :: theRest' +// all.Length = all'.Length && List.forall2 equalsLetPattern all all' + +// | LPTuple _, _ +// | LPUnit _, _ +// | LPVariable _, _ -> false + +// and equalsStringSegments +// (segments1 : List) +// (segments2 : List) +// : bool = +// segments1.Length = segments2.Length +// && List.forall2 equalsStringSegment segments1 segments2 + +// and equalsStringSegment +// (segment1 : StringSegment) +// (segment2 : StringSegment) +// : bool = +// match segment1, segment2 with +// | StringText text1, StringText text2 -> text1 = text2 +// | StringInterpolation expr1, StringInterpolation expr2 -> equalsExpr expr1 expr2 +// // exhaustiveness check +// | StringText _, _ +// | StringInterpolation _, _ -> false + +// and equalsMatchPattern (pattern1 : MatchPattern) (pattern2 : MatchPattern) : bool = +// match pattern1, pattern2 with +// | MPVariable(_, name1), MPVariable(_, name2) -> name1 = name2 +// // | MPEnum(_, tag1, args1), MPEnum(_, tag2, args2) -> +// // tag1 = tag2 +// // && args1.Length = args2.Length +// // && List.forall2 equalsMatchPattern args1 args2 +// | MPInt64(_, int1), MPInt64(_, int2) -> int1 = int2 +// | MPUInt64(_, int1), MPUInt64(_, int2) -> int1 = int2 +// | MPInt8(_, int1), MPInt8(_, int2) -> int1 = int2 +// | MPUInt8(_, int1), MPUInt8(_, int2) -> int1 = int2 +// | MPInt16(_, int1), MPInt16(_, int2) -> int1 = int2 +// | MPUInt16(_, int1), MPUInt16(_, int2) -> int1 = int2 +// | MPInt32(_, int1), MPInt32(_, int2) -> int1 = int2 +// | MPUInt32(_, int1), MPUInt32(_, int2) -> int1 = int2 +// | MPInt128(_, int1), MPInt128(_, int2) -> int1 = int2 +// | MPUInt128(_, int1), MPUInt128(_, int2) -> int1 = int2 +// | MPBool(_, bool1), MPBool(_, bool2) -> bool1 = bool2 +// | MPChar(_, char1), MPChar(_, char2) -> char1 = char2 +// | MPString(_, str1), MPString(_, str2) -> str1 = str2 +// | MPFloat(_, float1), MPFloat(_, float2) -> float1 = float2 +// | MPUnit _, MPUnit _ -> true +// | MPTuple(_, elem1_1, elem2_1, elems1), MPTuple(_, elem1_2, elem2_2, elems2) -> +// equalsMatchPattern elem1_1 elem1_2 +// && equalsMatchPattern elem2_1 elem2_2 +// && elems1.Length = elems2.Length +// && List.forall2 equalsMatchPattern elems1 elems2 +// | MPList(_, elems1), MPList(_, elems2) -> +// elems1.Length = elems2.Length && List.forall2 equalsMatchPattern elems1 elems2 +// | MPListCons(_, head, tail), MPListCons(_, head', tail') -> +// equalsMatchPattern head head' && equalsMatchPattern tail tail' +// // exhaustiveness check +// | MPVariable _, _ +// // | MPEnum _, _ +// | MPInt64 _, _ +// | MPUInt64 _, _ +// | MPInt8 _, _ +// | MPUInt8 _, _ +// | MPInt16 _, _ +// | MPUInt16 _, _ +// | MPInt32 _, _ +// | MPUInt32 _, _ +// | MPInt128 _, _ +// | MPUInt128 _, _ +// | MPBool _, _ +// | MPChar _, _ +// | MPString _, _ +// | MPFloat _, _ +// | MPUnit _, _ +// | MPTuple _, _ +// | MPListCons _, _ +// | MPList _, _ -> false let varA = TVariable "a" @@ -332,120 +343,121 @@ let fns : List = description = "Returns true if the two value are equal" fn = (function - | _, _, [ a; b ] -> equals a b |> DBool |> Ply + | _, _, _, [ a; b ] -> equals a b |> DBool |> Ply | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "=" - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "notEquals" 0 - typeParams = [] - parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] - returnType = TBool - description = "Returns true if the two value are not equal" - fn = - (function - | _, _, [ a; b ] -> equals a b |> not |> DBool |> Ply - | _ -> incorrectArgs ()) - sqlSpec = SqlBinOp "<>" - previewable = Pure - deprecated = NotDeprecated } - - - { name = fn "unwrap" 0 - typeParams = [] - parameters = [ Param.make "value" (TVariable "optOrRes") "" ] - returnType = TVariable "a" - description = - "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" - fn = - (function - | _, _, [] -> incorrectArgs () - | _, _, [ dval ] -> - match dval with - - // success: extract `Some` out of an Option - | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when - id = PackageIDs.Type.Stdlib.option - -> - Ply value - - // success: extract `Ok` out of a Result - | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when - id = PackageIDs.Type.Stdlib.result - -> - Ply value - - // Error: expected Some, got None - | DEnum(FQTypeName.Package id, _, _, "None", []) when - id = PackageIDs.Type.Stdlib.option - -> - "expected Some, got None" |> RuntimeError.oldError |> raiseUntargetedRTE - - // Error: expected Ok, got Error - | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when - id = PackageIDs.Type.Stdlib.result - -> - $"expected Ok, got Error:\n{value |> DvalReprDeveloper.toRepr}" - |> RuntimeError.oldError - |> raiseUntargetedRTE - - - // Error: single dval, but not an Option or Result - | otherDval -> - $"Unwrap called with non-Option/non-Result {otherDval}" - |> RuntimeError.oldError - |> raiseUntargetedRTE - - | _, _, multipleArgs -> - $"unwrap called with multiple arguments: {multipleArgs}" - |> RuntimeError.oldError - |> raiseUntargetedRTE) - - sqlSpec = NotQueryable + //sqlSpec = SqlBinOp "=" previewable = Pure deprecated = NotDeprecated } - { name = fn "debug" 0 - typeParams = [] - parameters = - [ Param.make "label" TString "The label to be printed." - Param.make "value" (TVariable "a") "The value to be printed." ] - returnType = TUnit - description = "Prints the given to the standard output" - fn = - (function - | _, _, [ DString label; value ] -> - // TODO: call upon the Dark equivalent fn instead of rlying on DvalReprDeveloper - print $"DEBUG: {label} - {DvalReprDeveloper.toRepr value}" - Ply DUnit - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } - - - { name = fn "debugSymbolTable" 0 - typeParams = [] - parameters = [ Param.make "unit" TUnit "" ] - returnType = TUnit - description = "Prints the current symbol table to the standard output" - fn = - (function - | state, _, [ DUnit ] -> - state.symbolTable - |> Map.toList - |> List.map (fun (key, dv) -> $"- {key}: {DvalReprDeveloper.toRepr dv}") - |> String.concat "\n" - |> fun lines -> print $"DEBUG: symTable\n{lines}" - - Ply DUnit - | _ -> incorrectArgs ()) - sqlSpec = NotQueryable - previewable = Impure - deprecated = NotDeprecated } ] - - -let builtins = LibExecution.Builtin.make [] fns + // { name = fn "notEquals" 0 + // typeParams = [] + // parameters = [ Param.make "a" varA ""; Param.make "b" varA "" ] + // returnType = TBool + // description = "Returns true if the two value are not equal" + // fn = + // (function + // | _, _, [ a; b ] -> equals a b |> not |> DBool |> Ply + // | _ -> incorrectArgs ()) + // sqlSpec = SqlBinOp "<>" + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "unwrap" 0 + // typeParams = [] + // parameters = [ Param.make "value" (TVariable "optOrRes") "" ] + // returnType = TVariable "a" + // description = + // "Unwrap an Option or Result, returning the value or raising a RuntimeError if None" + // fn = + // (function + // | _, _, [] -> incorrectArgs () + // | _, _, [ dval ] -> + // match dval with + + // // success: extract `Some` out of an Option + // | DEnum(FQTypeName.Package id, _, _, "Some", [ value ]) when + // id = PackageIDs.Type.Stdlib.option + // -> + // Ply value + + // // success: extract `Ok` out of a Result + // | DEnum(FQTypeName.Package id, _, _, "Ok", [ value ]) when + // id = PackageIDs.Type.Stdlib.result + // -> + // Ply value + + // // Error: expected Some, got None + // | DEnum(FQTypeName.Package id, _, _, "None", []) when + // id = PackageIDs.Type.Stdlib.option + // -> + // "expected Some, got None" |> RuntimeError.oldError |> raiseUntargetedRTE + + // // Error: expected Ok, got Error + // | DEnum(FQTypeName.Package id, _, _, "Error", [ value ]) when + // id = PackageIDs.Type.Stdlib.result + // -> + // $"expected Ok, got Error:\n{value |> DvalReprDeveloper.toRepr}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE + + + // // Error: single dval, but not an Option or Result + // | otherDval -> + // $"Unwrap called with non-Option/non-Result {otherDval}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE + + // | _, _, multipleArgs -> + // $"unwrap called with multiple arguments: {multipleArgs}" + // |> RuntimeError.oldError + // |> raiseUntargetedRTE) + + // sqlSpec = NotQueryable + // previewable = Pure + // deprecated = NotDeprecated } + + + // { name = fn "debug" 0 + // typeParams = [] + // parameters = + // [ Param.make "label" TString "The label to be printed." + // Param.make "value" (TVariable "a") "The value to be printed." ] + // returnType = TUnit + // description = "Prints the given to the standard output" + // fn = + // (function + // | _, _, [ DString label; value ] -> + // // TODO: call upon the Dark equivalent fn instead of rlying on DvalReprDeveloper + // print $"DEBUG: {label} - {DvalReprDeveloper.toRepr value}" + // Ply DUnit + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + + + // { name = fn "debugSymbolTable" 0 + // typeParams = [] + // parameters = [ Param.make "unit" TUnit "" ] + // returnType = TUnit + // description = "Prints the current symbol table to the standard output" + // fn = + // (function + // | state, _, [ DUnit ] -> + // state.symbolTable + // |> Map.toList + // |> List.map (fun (key, dv) -> $"- {key}: {DvalReprDeveloper.toRepr dv}") + // |> String.concat "\n" + // |> fun lines -> print $"DEBUG: symTable\n{lines}" + + // Ply DUnit + // | _ -> incorrectArgs ()) + // sqlSpec = NotQueryable + // previewable = Impure + // deprecated = NotDeprecated } + ] + + +let builtins = LibExecution.Builtin.make fns diff --git a/backend/src/LibExecution/DvalReprDeveloper.fs b/backend/src/LibExecution/DvalReprDeveloper.fs index bf45127442..9107e735fa 100644 --- a/backend/src/LibExecution/DvalReprDeveloper.fs +++ b/backend/src/LibExecution/DvalReprDeveloper.fs @@ -36,20 +36,20 @@ let rec typeName (t : TypeReference) : string = | TFn _ -> "Function" -// | TCustomType(Error _nre, _) -> "(Error during function resolution)" -// | TCustomType(Ok t, typeArgs) -> -// let typeArgsPortion = -// match typeArgs with -// | [] -> "" -// | args -> -// args -// |> List.map (fun t -> typeName t) -// |> String.concat ", " -// |> fun betweenBrackets -> "<" + betweenBrackets + ">" -// FQTypeName.toString t + typeArgsPortion - -// | TDB _ -> "Datastore" -// | TVariable varname -> $"'{varname}" + // | TCustomType(Error _nre, _) -> "(Error during function resolution)" + // | TCustomType(Ok t, typeArgs) -> + // let typeArgsPortion = + // match typeArgs with + // | [] -> "" + // | args -> + // args + // |> List.map (fun t -> typeName t) + // |> String.concat ", " + // |> fun betweenBrackets -> "<" + betweenBrackets + ">" + // FQTypeName.toString t + typeArgsPortion + + // | TDB _ -> "Datastore" + | TVariable varname -> $"'{varname}" let rec private knownTypeName (vt : KnownType) : string = diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index c42081d34a..f91b038372 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -23,6 +23,7 @@ let rec execute : Ply = uply { let instructions = vmState.instructions + if counter >= instructions.Length then // is this OK? return vmState.registers[vmState.resultReg] @@ -62,6 +63,7 @@ let rec execute | Apply(putResultIn, thingToCallReg, typeArgs, argRegs) -> // should we instead pass in register indices? probably... let args = argRegs |> NEList.map (fun r -> vmState.registers[r]) + //debuG "args" (NEList.length args) let thingToCall = vmState.registers[thingToCallReg] let! result = call exeState vmState thingToCall typeArgs args @@ -120,6 +122,103 @@ let rec execute vmState.registers[copyTo] <- vmState.registers[copyFrom] return! execute exeState vmState (counter + 1) + | MatchValue(valueReg, pat, failJump) -> + let rec matchPattern pat dv = + match pat, dv with + | MPVariable name, dv -> true, [ (name, dv) ] + + | MPUnit, DUnit -> true, [] + + | MPBool l, DBool r -> l = r, [] + + | MPInt8 l, DInt8 r -> l = r, [] + | MPUInt8 l, DUInt8 r -> l = r, [] + | MPInt16 l, DInt16 r -> l = r, [] + | MPUInt16 l, DUInt16 r -> l = r, [] + | MPInt32 l, DInt32 r -> l = r, [] + | MPUInt32 l, DUInt32 r -> l = r, [] + | MPInt64 l, DInt64 r -> l = r, [] + | MPUInt64 l, DUInt64 r -> l = r, [] + | MPInt128 l, DInt128 r -> l = r, [] + | MPUInt128 l, DUInt128 r -> l = r, [] + + | MPFloat l, DFloat r -> l = r, [] + + | MPChar l, DChar r -> l = r, [] + | MPString l, DString r -> l = r, [] + + | MPList pats, DList(_, items) -> + let rec matchList pats items = + match pats, items with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | pat :: otherPats, item :: items -> + let matches, vars = matchPattern pat item + if matches then + let matchesRest, varsRest = matchList otherPats items + if matchesRest then true, vars @ varsRest else false, [] + else + false, [] + matchList pats items + + | MPListCons(head, tail), DList(vt, items) -> + match items with + | [] -> false, [] + | headItem :: tailItems -> + let matchesHead, varsHead = matchPattern head headItem + if matchesHead then + let matchesTail, varsTail = matchPattern tail (DList(vt, tailItems)) + if matchesTail then true, varsHead @ varsTail else false, [] + else + false, [] + + | MPTuple(first, second, theRest), DTuple(firstVal, secondVal, theRestVal) -> + // CLEANUP can probably be tidier + let matchesFirst, varsFirst = matchPattern first firstVal + if matchesFirst then + let matchesSecond, varsSecond = matchPattern second secondVal + if matchesSecond then + let rec matchRest pats vals = + match pats, vals with + | [], [] -> true, [] + | [], _ -> false, [] + | _, [] -> false, [] + | thirdPat :: otherPats, firstVal :: otherVals -> + let matches, vars = matchPattern thirdPat firstVal + if matches then + let matchesRest, varsRest = matchRest otherPats otherVals + if matchesRest then + true, varsFirst @ varsSecond @ vars @ varsRest + else + false, [] + else + false, [] + matchRest theRest theRestVal + else + false, [] + else + false, [] + + | _ -> false, [] + + + let matches, vars = matchPattern pat vmState.registers[valueReg] + + if matches then + let vmState = + vars + |> List.fold + (fun vmState (varName, value) -> + { vmState with + symbolTable = Map.add varName value vmState.symbolTable }) + vmState + return! execute exeState vmState (counter + 1) + else + return! execute exeState vmState (counter + failJump + 1) + + + | ExtractTupleItems(extractFrom, firstReg, secondReg, restRegs) -> match vmState.registers[extractFrom] with | DTuple(first, second, rest) -> @@ -133,6 +232,7 @@ let rec execute | _ -> return DString "Error: Expected a tuple for decomposition" | Fail _rte -> return DUnit // TODO + | MatchUnmatched -> return DUnit // TODO } diff --git a/backend/src/LibExecution/ProgramTypes.fs b/backend/src/LibExecution/ProgramTypes.fs index cec0dffedd..24045c2b83 100644 --- a/backend/src/LibExecution/ProgramTypes.fs +++ b/backend/src/LibExecution/ProgramTypes.fs @@ -124,35 +124,35 @@ type LetPattern = theRest : List | LPVariable of id * name : string -// /// Used for pattern matching in a match statement -// type MatchPattern = -// | MPUnit of id +/// Used for pattern matching in a match statement +type MatchPattern = + | MPUnit of id -// | MPBool of id * bool + | MPBool of id * bool -// | MPInt8 of id * int8 -// | MPUInt8 of id * uint8 -// | MPInt16 of id * int16 -// | MPUInt16 of id * uint16 -// | MPInt32 of id * int32 -// | MPUInt32 of id * uint32 -// | MPInt64 of id * int64 -// | MPUInt64 of id * uint64 -// | MPInt128 of id * System.Int128 -// | MPUInt128 of id * System.UInt128 + | MPInt8 of id * int8 + | MPUInt8 of id * uint8 + | MPInt16 of id * int16 + | MPUInt16 of id * uint16 + | MPInt32 of id * int32 + | MPUInt32 of id * uint32 + | MPInt64 of id * int64 + | MPUInt64 of id * uint64 + | MPInt128 of id * System.Int128 + | MPUInt128 of id * System.UInt128 -// | MPFloat of id * Sign * string * string + | MPFloat of id * Sign * string * string -// | MPChar of id * string -// | MPString of id * string + | MPChar of id * string + | MPString of id * string -// | MPList of id * List -// | MPListCons of id * head : MatchPattern * tail : MatchPattern -// | MPTuple of id * MatchPattern * MatchPattern * List + | MPList of id * List + | MPListCons of id * head : MatchPattern * tail : MatchPattern + | MPTuple of id * MatchPattern * MatchPattern * List -// | MPEnum of id * caseName : string * fieldPats : List + //| MPEnum of id * caseName : string * fieldPats : List -// | MPVariable of id * string + | MPVariable of id * string type BinaryOperation = | BinOpAnd @@ -260,15 +260,15 @@ type Expr = // /// `(1 + 2) |> fnName |> (+) 3` // | EPipe of id * Expr * List - // /// Supports `match` expressions - // /// ```fsharp - // /// match x + 2 with // arg - // /// | pattern -> expr // cases[0] - // /// | pattern -> expr - // /// | ... - // /// ``` - // // cases is a list to represent when a user starts typing but doesn't complete it - // | EMatch of id * arg : Expr * cases : List + /// Supports `match` expressions + /// ```fsharp + /// match x + 2 with // arg + /// | pattern -> expr // cases[0] + /// | pattern -> expr + /// | ... + /// ``` + // cases is a list to represent when a user starts typing but doesn't complete it + | EMatch of id * arg : Expr * cases : List // // Composed of binding pattern, the expression to create bindings for, @@ -353,7 +353,7 @@ type Expr = // NameResolution -//and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } +and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } and StringSegment = | StringText of string @@ -409,8 +409,7 @@ module Expr = // | ERecord(id, _, _) // | ERecordUpdate(id, _, _) // | EEnum(id, _, _, _) - // | EMatch(id, _, _) - -> id + | EMatch(id, _, _) -> id // module PipeExpr = // let toID (expr : PipeExpr) : id = diff --git a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs index a36f01d3c1..0f6eaa369d 100644 --- a/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs +++ b/backend/src/LibExecution/ProgramTypesToRuntimeTypes.fs @@ -142,6 +142,9 @@ module LetPattern = | PT.LPTuple(_id, first, second, theRest) -> // reserve the first two registers + // TODO: why do we actually need registers, when we're just assigning variables? + // If RT.LetPattern were more like RT.MatchPattern, we could simply have one instruction that + // assigns the variables in one fell swoop, failing if anything doesn't deconstruct properly. let firstReg, secondReg, rc = rc, rc + 1, rc + 2 let (rcAfterFirst, firstInstrs) = toRT rc first firstReg @@ -166,39 +169,88 @@ module LetPattern = +module MatchPattern = + let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = + match p with + | PT.MPUnit _ -> RT.MPUnit + | PT.MPBool(_, b) -> RT.MPBool b -// module MatchPattern = -// let rec toRT (p : PT.MatchPattern) : RT.MatchPattern = -// match p with -// | PT.MPVariable(id, str) -> RT.MPVariable(id, str) -// | PT.MPEnum(id, caseName, fieldPats) -> -// RT.MPEnum(id, caseName, List.map toRT fieldPats) -// | PT.MPInt64(id, i) -> RT.MPInt64(id, i) -// | PT.MPUInt64(id, i) -> RT.MPUInt64(id, i) -// | PT.MPInt8(id, i) -> RT.MPInt8(id, i) -// | PT.MPUInt8(id, i) -> RT.MPUInt8(id, i) -// | PT.MPInt16(id, i) -> RT.MPInt16(id, i) -// | PT.MPUInt16(id, i) -> RT.MPUInt16(id, i) -// | PT.MPInt32(id, i) -> RT.MPInt32(id, i) -// | PT.MPUInt32(id, i) -> RT.MPUInt32(id, i) -// | PT.MPInt128(id, i) -> RT.MPInt128(id, i) -// | PT.MPUInt128(id, i) -> RT.MPUInt128(id, i) -// | PT.MPBool(id, b) -> RT.MPBool(id, b) -// | PT.MPChar(id, c) -> RT.MPChar(id, c) -// | PT.MPString(id, s) -> RT.MPString(id, s) -// | PT.MPFloat(id, s, w, f) -> -// let w = if w = "" then "0" else w -// RT.MPFloat(id, makeFloat s w f) -// | PT.MPUnit id -> RT.MPUnit id -// | PT.MPTuple(id, first, second, theRest) -> -// RT.MPTuple(id, toRT first, toRT second, List.map toRT theRest) -// | PT.MPList(id, pats) -> RT.MPList(id, List.map toRT pats) -// | PT.MPListCons(id, head, tail) -> RT.MPListCons(id, toRT head, toRT tail) + | PT.MPInt8(_, i) -> RT.MPInt8 i + | PT.MPUInt8(_, i) -> RT.MPUInt8 i + | PT.MPInt16(_, i) -> RT.MPInt16 i + | PT.MPUInt16(_, i) -> RT.MPUInt16 i + | PT.MPInt32(_, i) -> RT.MPInt32 i + | PT.MPUInt32(_, i) -> RT.MPUInt32 i + | PT.MPInt64(_, i) -> RT.MPInt64 i + | PT.MPUInt64(_, i) -> RT.MPUInt64 i + | PT.MPInt128(_, i) -> RT.MPInt128 i + | PT.MPUInt128(_, i) -> RT.MPUInt128 i + + | PT.MPFloat(_, sign, whole, frac) -> RT.MPFloat(makeFloat sign whole frac) + + | PT.MPChar(_, c) -> RT.MPChar c + | PT.MPString(_, s) -> RT.MPString s + + | PT.MPList(_, pats) -> RT.MPList(List.map toRT pats) + | PT.MPListCons(_, head, tail) -> RT.MPListCons(toRT head, toRT tail) + + | PT.MPTuple(_, first, second, theRest) -> + RT.MPTuple(toRT first, toRT second, List.map toRT theRest) + + | PT.MPVariable(_, name) -> RT.MPVariable name + + + let toMatchInstr + (p : PT.MatchPattern) + (valueReg : RT.Register) + (jumpByFail) + : RT.Instruction = + RT.MatchValue(valueReg, toRT p, jumpByFail) + + +module MatchCase = + /// Compiling a MatchCase happens in two phases, because many instructions + /// require knowing how many instructions to jump over, which we can't know + /// until we know the basics of all the cases. + /// + /// This type holds all the information we gather as part of the first phase + /// , in order of where the instrs should be at the end of the second phase. + /// + /// Note: not represented here, we'll also need an unconditional `JumpBy` instr + /// , to get past all the cases. We can only determine how many instrs to jump + /// after the first phases is complete, but it'll land at the end of these. + type IntermediateValue = + { + /// jumpByFail -> instr + /// `RT.MatchValue(valueReg, pat, jumpByFail)` + /// (the `pat` and `valueReg` are known in the first phase) + matchValueInstrFn : int -> RT.Instruction + + /// Evaluation of the `whenCondition` (if it exists -- might be empty) + whenCondInstructions : RT.Instructions + + /// (jumpBy) -> instr + /// `RT.JumpByIfFalse(jumpBy, whenCondResultReg)` + /// (`whenCondResultReg` is known in the first phase) + whenCondJump : Option RT.Instruction> + + /// Evaluation of the RHS + /// + /// Includes `CopyVal(resultReg, rhsResultReg)` + rhsInstrs : RT.Instructions + + /// RC after all instructions + /// + /// Note: Different branches/cases will require different # of registers + /// , so we'll end up taking the max of all the RCs + rc : int + } module Expr = // CLEANUP clearly not the most efficient to do this, but probably fine for now + // TODO ok this is actually really wasteful. a single text string segment could be a single instruction let rec compileString (rc : int) (segments : List) @@ -251,6 +303,7 @@ module Expr = | PT.EString(_id, segments) -> compileString rc segments + | PT.EList(_id, items) -> let listReg = rc let init = (rc + 1, [ RT.LoadVal(listReg, RT.DList(VT.unknown, [])) ]) @@ -266,6 +319,7 @@ module Expr = (regCounter, instrs, listReg) + | PT.EDict(_id, items) -> let dictReg = rc let init = (rc + 1, [ RT.LoadVal(dictReg, RT.DDict(VT.unknown, Map.empty)) ]) @@ -281,6 +335,7 @@ module Expr = (regCounter, instrs, dictReg) + | PT.ETuple(_id, first, second, theRest) -> // save the 'first' register for the result let tupleReg, rc = rc, rc + 1 @@ -384,6 +439,7 @@ module Expr = // (which should fail when we apply it) (rc, [ RT.Fail(RT.RuntimeError.oldError "Couldn't find fn") ], rc) + | PT.EApply(_id, thingToApplyExpr, typeArgs, args) -> let (regCounter, thingToApplyInstrs, thingToApplyReg) = // (usually, a fn name) @@ -413,6 +469,100 @@ module Expr = (regCounter + 1, thingToApplyInstrs @ argInstrs @ [ callInstr ], putResultIn) + | PT.EMatch(_id, expr, cases) -> + // first, the easy part - compile the expression we're `match`ing against. + let (rcAfterExpr, exprInstrs, exprResultReg) = toRT rc expr + + // Shortly, we'll compile each of the cases. + // We'll use this `resultReg` to store the final result of the match + // , so we have a consistent place to look for it. + // (similar to how we handle `EIf` -- refer to that for a simpler example) + let resultReg, rcAfterResult = rcAfterExpr, rcAfterExpr + 1 + + // We compile each `case` in two phases, because some instrs require knowing + // how many instrs to jump over, which we can't know until we know the basics + // of all the cases. + // + // See `MatchCase.IntermediateValue` for more info. + let casesAfterFirstPhase : List = + cases + |> List.map (fun c -> + // compile the `when` condition, if it exists, as much as we can + let rcAfterWhenCond, whenCondInstrs, whenCondJump = + match c.whenCondition with + | None -> (rcAfterResult, [], None) + | Some whenCond -> + let (rcAfterWhenCond, whenCondInstrs, whenCondReg) = + toRT rcAfterResult whenCond + (rcAfterWhenCond, + whenCondInstrs, + Some(fun jumpBy -> RT.JumpByIfFalse(jumpBy, whenCondReg))) + + // compile the `rhs` of the case + let rcAfterRhs, rhsInstrs, rhsResultReg = toRT rcAfterWhenCond c.rhs + + // return the intermediate results, as far along as they are + { matchValueInstrFn = MatchPattern.toMatchInstr c.pat exprResultReg + whenCondInstructions = whenCondInstrs + whenCondJump = whenCondJump + rhsInstrs = rhsInstrs @ [ RT.CopyVal(resultReg, rhsResultReg) ] + rc = rcAfterRhs }) + + let countInstrsForCase (c : MatchCase.IntermediateValue) : int = + 1 // for the `MatchValue` instruction + + List.length c.whenCondInstructions + + (match c.whenCondJump with + | Some _ -> 1 + | None -> 0) + + List.length c.rhsInstrs + + 1 // for the `JumpBy` instruction + + let (cases, _) : List * int = + casesAfterFirstPhase + |> List.map (fun c -> + let instrCount = countInstrsForCase c + (c, instrCount)) + |> List.foldRight + // CLEANUP this works, but hurts the brain a bit. + (fun (acc, runningTotal) (c, instrCount) -> + let newTotal = runningTotal + instrCount + (acc @ [ c, runningTotal ], newTotal)) + ([], 0) + let cases = List.rev cases + + + let caseInstrs = + cases + |> List.fold + (fun instrs (c, instrsAfterThisCaseUntilEndOfMatch) -> + // note: `instrsAfterThisCaseUntilEndOfMatch` does not include + // the final MatchUnmatched instruction + + let caseInstrs = + [ c.matchValueInstrFn ( + countInstrsForCase c + // because we can skip over the MatchValue instr + - 1 + ) ] + @ c.whenCondInstructions + @ (match c.whenCondJump with + // jump to next case if the when condition is false + | Some jump -> [ jump (List.length c.rhsInstrs + 1) ] + | None -> []) + @ c.rhsInstrs + @ [ RT.JumpBy(instrsAfterThisCaseUntilEndOfMatch + 1) ] + + instrs @ caseInstrs) + [] + + + let instrs = exprInstrs @ caseInstrs @ [ RT.MatchUnmatched ] + + let rcAtEnd = casesAfterFirstPhase |> List.map _.rc |> List.max + + (rcAtEnd, instrs, resultReg) + + // let rec toRT (e : PT.Expr) : RT.Instructions = // match e with // // | PT.EConstant(id, Ok name) -> RT.EConstant(id, FQConstantName.toRT name) diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 4ca2e07adf..6de4c20d48 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -122,6 +122,9 @@ module FQFnName = let package (id : uuid) = id + let fqBuiltin (name : string) (version : int) : FQFnName = + Builtin { name = name; version = version } + let fqPackage (id : uuid) : FQFnName = Package id let builtinToString (s : Builtin) : string = @@ -456,7 +459,7 @@ and TypeReference = | TTuple of TypeReference * TypeReference * List | TFn of NEList * TypeReference // | TDB of TypeReference - // | TVariable of string + | TVariable of string // | TCustomType of // NameResolution * // typeArgs : List @@ -496,16 +499,44 @@ and TypeReference = // | TCustomType(_, ts) -> List.forall isConcrete ts | TDict t -> isConcrete t - //| TVariable _-> false + | TVariable _ -> false isConcrete this and Register = int // // TODO: unit of measure -// TODO: consider if each of these should include the Expr ID that they came from -// -// Would Expr ID be enough? -// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) +and MatchPattern = + | MPUnit + | MPBool of bool + | MPInt8 of int8 + | MPUInt8 of uint8 + | MPInt16 of int16 + | MPUInt16 of uint16 + | MPInt32 of int32 + | MPUInt32 of uint32 + | MPInt64 of int64 + | MPUInt64 of uint64 + | MPInt128 of System.Int128 + | MPUInt128 of System.UInt128 + | MPFloat of float + | MPChar of string + | MPString of string + | MPList of List + | MPListCons of head : MatchPattern * tail : MatchPattern // TODO: but the tail is a list... + | MPTuple of + first : MatchPattern * + second : MatchPattern * + theRest : List + | MPVariable of string + +/// TODO: consider if each of these should include the Expr ID that they came from +/// +/// Would Expr ID be enough? +/// I don't _think_ we'd have to note the fn ID or TL ID or script name, but maybe?) +/// +/// We could also record the Instruction Index -> ExprID mapping _adjacent_ to RT, +/// and only load it when needed. +/// That way, the Interpreter could be lighter-weight. and Instruction = /// Push a ("constant") value into a register | LoadVal of loadTo : Register * Dval @@ -568,19 +599,30 @@ and Instruction = /// Fail if this is hit (basically "raise an exception") | Fail of RuntimeError + /// Check if the value in the noted register the noted pattern, + /// and extract vars per MPVariable as relevant. + | MatchValue of + valueReg : Register * // what we're matching against + pat : MatchPattern * + //successJump : int * + failJump : int + + /// Could not find matching case in a match expression + /// CLEANUP we probably need a way to reference back to PT so we can get useful RTEs + /// TODO maybe make this a special case of Fail + | MatchUnmatched + and Instructions = List and InstructionsWithContext = // (rc, instructions, result register) (int * Instructions * Register) + // // Expressions here are runtime variants of the AST in ProgramTypes, having had // // superfluous information removed. // and Expr = - - // // // flow control -// // | EMatch of id * Expr * NEList // // | EAnd of id * lhs : Expr * rhs : Expr // // | EOr of id * lhs : Expr * rhs : Expr @@ -588,7 +630,6 @@ and InstructionsWithContext = // // | ERecordFieldAccess of id * Expr * string // // calling fns and other things -// | EApply of id * Expr * typeArgs : List * args : NEList // //| ELambda of id * pats : NEList * body : Expr // // // working with custom types @@ -603,8 +644,6 @@ and InstructionsWithContext = // // subexpressions to evaluate before evaluating the error. // | EError of id * RuntimeError * List -// // and MatchCase = { pat : MatchPattern; whenCondition : Option; rhs : Expr } - and DvalMap = Map @@ -619,6 +658,10 @@ and DvalMap = Map // body : Expr } and FnValImpl = + // TODO: consider inlining these cases (DLambnda, DNamedBuiltinFn, DNamedPackageFn) + // maybe this includes partially-applied stuff? + // or maybe we have a separate type for that? idk. + //| Lambda of LambdaImpl | NamedFn of FQFnName.FQFnName @@ -1545,7 +1588,10 @@ and ExecutionState = and Registers = Dval array and VMState = - { instructions : Instruction array + { // /// Program counter -- what instruction index are we pointing at? + //pc: int + + instructions : Instruction array registers : Registers resultReg : Register diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index c969ac2a66..8e6ac1c0f6 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -232,10 +232,10 @@ let rec valueTypeUnifies //| TDB innerT, ValueType.Known(KTDB innerV) -> return! r innerT innerV - // | TVariable name, _ -> - // match Map.get name tst with - // | None -> return true - // | Some t -> return! r t actual + | TVariable name, _ -> + match Map.get name tst with + | None -> return true + | Some t -> return! r t actual | _, _ -> return false } @@ -257,13 +257,13 @@ let rec unify // // // // Potentially needs to be removed before we use this type checker for DBs? // // - Could always have a type checking context that allows/disallows any - // | TVariable name, _ -> - // match Map.get name tst with - // // for now, allow undefined type variables. In the future, we would create a - // // type from the value and return any variables defined this way for usage in - // // further arguments and return values. - // | None -> return Ok() - // | Some t -> return! unify context types tst t value + | TVariable name, _ -> + match Map.get name tst with + // for now, allow undefined type variables. In the future, we would create a + // type from the value and return any variables defined this way for usage in + // further arguments and return values. + | None -> return Ok() + | Some t -> return! unify context types tst t value | TBool, DBool _ -> return Ok() | TUnit, DUnit -> return Ok() @@ -455,7 +455,7 @@ let rec unify // | TCustomType _, _ - // | TVariable _, _ + | TVariable _, _ | TFn _, _ // | TDB _, _ diff --git a/backend/src/Prelude/NEList.fs b/backend/src/Prelude/NEList.fs index ddcbb71615..28804c36e3 100644 --- a/backend/src/Prelude/NEList.fs +++ b/backend/src/Prelude/NEList.fs @@ -42,7 +42,9 @@ let map2 (f : 'a -> 'b -> 'c) (l1 : NEList<'a>) (l2 : NEList<'b>) : NEList<'c> = match l1, l2 with | [], [] -> [] | [], _ - | _, [] -> Exception.raiseInternal "NEList.map2: lists have different lengths" [] + | _, [] -> + System.Console.WriteLine((l1, l2)) + Exception.raiseInternal "NEList.map2: lists have different lengths" [] | x1 :: xs1, x2 :: xs2 -> f x1 x2 :: loop xs1 xs2 { head = f l1.head l2.head; tail = loop l1.tail l2.tail } diff --git a/backend/tests/TestUtils/PTShortcuts.fs b/backend/tests/TestUtils/PTShortcuts.fs index e85ac0d049..35603a5d74 100644 --- a/backend/tests/TestUtils/PTShortcuts.fs +++ b/backend/tests/TestUtils/PTShortcuts.fs @@ -23,15 +23,35 @@ let eFloat (sign : Sign) (whole : string) (fraction : string) : Expr = EFloat(gid (), sign, whole, fraction) let eChar (c : string) : Expr = EChar(gid (), c) -let eStr (str : string) : Expr = EString(gid (), [ StringText str ]) - - +let strText (str : string) : StringSegment = StringText str +let strInterp (expr : Expr) : StringSegment = StringInterpolation expr +let eStr (segments : List) : Expr = EString(gid (), segments) let eList (elems : Expr list) : Expr = EList(gid (), elems) - +let eDict (entries : List) : Expr = EDict(gid (), entries) +let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = + ETuple(gid (), first, second, theRest) + + +let lpUnit () : LetPattern = LPUnit(gid ()) +let lpVar (name : string) : LetPattern = LPVariable(gid (), name) +let lpTuple + (first : LetPattern) + (second : LetPattern) + (theRest : LetPattern list) + : LetPattern = + LPTuple(gid (), first, second, theRest) +let eLet (pat : LetPattern) (value : Expr) (body : Expr) : Expr = + ELet(gid (), pat, value, body) let eVar (name : string) : Expr = EVariable(gid (), name) +let eIf (cond : Expr) (thenBranch : Expr) (elseBranch : Option) : Expr = + EIf(gid (), cond, thenBranch, elseBranch) + +let eMatch (expr : Expr) (cases : List) : Expr = + EMatch(gid (), expr, cases) + // let eFieldAccess (expr : Expr) (fieldName : string) : Expr = // ERecordFieldAccess(gid (), expr, fieldName) @@ -79,8 +99,7 @@ let eApply let args = NEList.ofListUnsafe "eApply" [] args EApply(gid (), target, typeArgs, args) -// let eTuple (first : Expr) (second : Expr) (theRest : Expr list) : Expr = -// ETuple(gid (), first, second, theRest) + // let customTypeRecord (fields : List) : TypeDeclaration.T = diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 2b9b0f2c33..9f2f5256ba 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -13,7 +13,7 @@ module E = Tests.ProgramTypesToRuntimeTypes.Expressions let eval pt = uply { - let vmState = PT2RT.Expr.toRT 0 pt |> RT.VMState.fromInstructions + let vmState = pt |> PT2RT.Expr.toRT 0 |> RT.VMState.fromInstructions let! executionState = executionStateFor PT.PackageManager.empty (System.Guid.NewGuid()) false false @@ -21,147 +21,118 @@ let eval pt = return! LibExecution.Interpreter.eval executionState vmState } - -let onePlusTwo = - testTask "1+2" { - let! actual = eval E.onePlusTwo |> Ply.toTask - let expected = RT.DInt64 3L +let t name expr expected = + testTask name { + let! actual = eval expr |> Ply.toTask return Expect.equal actual expected "" } + +let onePlusTwo = t "1+2" E.onePlusTwo (RT.DInt64 3L) + let boolList = - testTask "[true; false; true]" { - let! actual = eval E.boolList |> Ply.toTask - let expected = - RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ]) - return Expect.equal actual expected "" - } + t + "[true; false; true]" + E.boolList + (RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false; RT.DBool true ])) let boolListList = - testTask "[[true; false]; [false; true]]" { - let! actual = eval E.boolListList |> Ply.toTask - let expected = - RT.DList( - VT.unknown, - [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) - RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] - ) - return Expect.equal actual expected "" - } -let letSimple = - testTask "let x = true\nx" { - let! actual = eval E.letSimple |> Ply.toTask - let expected = RT.DBool true - return Expect.equal actual expected "" - } -let letTuple = - testTask "let (x, y) = (1, 2)\nx" { - let! actual = eval E.letTuple |> Ply.toTask - let expected = RT.DInt64 1L - return Expect.equal actual expected "" - } + t + "[[true; false]; [false; true]]" + E.boolListList + (RT.DList( + VT.unknown, + [ RT.DList(VT.unknown, [ RT.DBool true; RT.DBool false ]) + RT.DList(VT.unknown, [ RT.DBool false; RT.DBool true ]) ] + )) +let letSimple = t "let x = true\nx" E.letSimple (RT.DBool true) +let letTuple = t "let (x, y) = (1, 2)\nx" E.letTuple (RT.DInt64 1L) let letTupleNested = - testTask "let (a, (b, c)) = (1, (2, 3))\nb" { - let! actual = eval E.letTupleNested |> Ply.toTask - let expected = RT.DInt64 2L - return Expect.equal actual expected "" - } + t "let (a, (b, c)) = (1, (2, 3))\nb" E.letTupleNested (RT.DInt64 2L) -let simpleString = - testTask "[\"hello\"]" { - let! actual = eval E.simpleString |> Ply.toTask - let expected = RT.DString "hello" - return Expect.equal actual expected "" - } +let simpleString = t "[\"hello\"]" E.simpleString (RT.DString "hello") let stringWithInterpolation = - testTask "[let x = \"world\" in $\"hello {x}\"]" { - let! actual = eval E.stringWithInterpolation |> Ply.toTask - let expected = RT.DString "hello, world" - return Expect.equal actual expected "" - } + t + "[let x = \"world\" in $\"hello {x}\"]" + E.stringWithInterpolation + (RT.DString "hello, world") -let dictEmpty = - testTask "Dict {}" { - let! actual = eval E.dictEmpty |> Ply.toTask - let expected = RT.DDict(VT.unknown, Map.empty) - return Expect.equal actual expected "" - } +let dictEmpty = t "Dict {}" E.dictEmpty (RT.DDict(VT.unknown, Map.empty)) let dictSimple = - testTask "Dict { t: true}" { - let! actual = eval E.dictSimple |> Ply.toTask - let expected = RT.DDict(VT.unknown, Map [ "key", RT.DBool true ]) - return Expect.equal actual expected "" - } + t + "Dict { t: true}" + E.dictSimple + (RT.DDict(VT.unknown, Map [ "key", RT.DBool true ])) let dictMultEntries = - testTask "Dict {t: true; f: false}" { - let! actual = eval E.dictMultEntries |> Ply.toTask - let expected = - RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ]) - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false}" + E.dictMultEntries + (RT.DDict(VT.unknown, Map [ "t", RT.DBool true; "f", RT.DBool false ])) let dictDupeKey = - testTask "Dict {t: true; f: false; t: false}" { - let! actual = eval E.dictDupeKey |> Ply.toTask - let expected = - RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ]) - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false; t: false}" + E.dictDupeKey + (RT.DDict(VT.unknown, Map [ "t", RT.DBool false; "f", RT.DBool false ])) -let ifGotoThenBranch = - testTask "if true then 1 else 2" { - let! actual = eval E.ifGotoThenBranch |> Ply.toTask - let expected = RT.DInt64 1L - return Expect.equal actual expected "" - } +let ifGotoThenBranch = t "if true then 1 else 2" E.ifGotoThenBranch (RT.DInt64 1L) -let ifGotoElseBranch = - testTask "if false then 1 else 2" { - let! actual = eval E.ifGotoElseBranch |> Ply.toTask - let expected = RT.DInt64 2L - return Expect.equal actual expected "" - } -let ifElseMissing = - testTask "if false then 1" { - let! actual = eval E.ifElseMissing |> Ply.toTask - let expected = RT.DUnit - return Expect.equal actual expected "" - } +let ifGotoElseBranch = t "if false then 1 else 2" E.ifGotoElseBranch (RT.DInt64 2L) +let ifElseMissing = t "if false then 1" E.ifElseMissing RT.DUnit let tuple2 = - testTask "(false, true)" { - let! actual = eval E.tuple2 |> Ply.toTask - let expected = RT.DTuple(RT.DBool false, RT.DBool true, []) - return Expect.equal actual expected "" - } + t "(false, true)" E.tuple2 (RT.DTuple(RT.DBool false, RT.DBool true, [])) let tuple3 = - testTask "(false, true, false)" { - let! actual = eval E.tuple3 |> Ply.toTask - let expected = RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ]) - return Expect.equal actual expected "" - } - + t + "(false, true, false)" + E.tuple3 + (RT.DTuple(RT.DBool false, RT.DBool true, [ RT.DBool false ])) let tupleNested = - testTask "((false, true), true, (true, false)))" { - let! actual = eval E.tupleNested |> Ply.toTask - let expected = - RT.DTuple( - RT.DTuple(RT.DBool false, RT.DBool true, []), - RT.DBool true, - [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] - ) - return Expect.equal actual expected "" - } - -// let TODO = -// testTask "TODO" { -// let! actual = eval E.TODO |> Ply.toTask -// let expected = RT.DUnit -// return Expect.equal actual expected "" -// } - + t + "((false, true), true, (true, false)))" + E.tupleNested + (RT.DTuple( + RT.DTuple(RT.DBool false, RT.DBool true, []), + RT.DBool true, + [ RT.DTuple(RT.DBool true, RT.DBool false, []) ] + )) + +let matchSimple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.matchSimple + (RT.DString "second branch") + +let matchNotMatched = + t "match true with\n| false -> \"first branch\"" E.matchNotMatched RT.DUnit + +let matchWithVar = t "match true with\n| x -> x" E.matchWithVar (RT.DBool true) + +let matchWithVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.matchWithVarAndWhenCondition + (RT.DString "second branch") + +let matchList = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.matchList + (RT.DString "first branch") + +let matchListCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.matchListCons + (RT.DList(VT.unknown, [ RT.DInt64 2L ])) + +let matchTuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.matchTuple + (RT.DString "first branch") let tests = testList @@ -183,4 +154,11 @@ let tests = ifElseMissing tuple2 tuple3 - tupleNested ] + tupleNested + matchSimple + matchNotMatched + matchWithVar + //matchWithVarAndWhenCondition + matchList + matchListCons + matchTuple ] diff --git a/backend/tests/Tests/PT2RT.Tests.fs b/backend/tests/Tests/PT2RT.Tests.fs index 99556edfec..416218e576 100644 --- a/backend/tests/Tests/PT2RT.Tests.fs +++ b/backend/tests/Tests/PT2RT.Tests.fs @@ -10,484 +10,597 @@ module VT = RT.ValueType module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module PackageIDs = LibExecution.PackageIDs +open TestUtils.PTShortcuts + // TODO: consider adding an Expect.equalInstructions, // which better points out the diffs in the lists module Expressions = - let one = PT.EInt64(gid (), 1) + let one = eInt64 1 - let onePlusTwo : PT.Expr = - PT.EApply( - gid (), - PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0)), - [], - (NEList.ofList (PT.EInt64(gid (), 1)) [ PT.EInt64(gid (), 2) ]) - ) + let onePlusTwo = + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Add" 0))) + [] + [ eInt64 1; eInt64 2 ] // TODO: try to use undefined variable // TODO: lpunit - let letSimple : PT.Expr = - PT.ELet( - gid (), - PT.LPVariable(gid (), "x"), - PT.EBool(gid (), true), - PT.EVariable(gid (), "x") - ) - let letTuple : PT.Expr = - PT.ELet( - gid (), - PT.LPTuple(gid (), PT.LPVariable(gid (), "x"), PT.LPVariable(gid (), "y"), []), - PT.ETuple(gid (), PT.EInt64(gid (), 1), PT.EInt64(gid (), 2), []), - PT.EVariable(gid (), "x") - ) + let letSimple = eLet (lpVar "x") (eBool true) (eVar "x") + let letTuple = + eLet + (lpTuple (lpVar "x") (lpVar "y") []) + (eTuple (eInt64 1) (eInt64 2) []) + (eVar "x") /// `let (a, (b, c)) = (1, (2, 3)) in b` - let letTupleNested : PT.Expr = - PT.ELet( - gid (), - PT.LPTuple( - gid (), - PT.LPVariable(gid (), "a"), - PT.LPTuple( - gid (), - PT.LPVariable(gid (), "b"), - PT.LPVariable(gid (), "c"), - [] - ), - [] - ), - PT.ETuple( - gid (), - PT.EInt64(gid (), 1), - PT.ETuple(gid (), PT.EInt64(gid (), 2), PT.EInt64(gid (), 3), []), - [] - ), - PT.EVariable(gid (), "b") - ) - - let boolList : PT.Expr = - PT.EList( - gid (), - [ PT.EBool(gid (), true); PT.EBool(gid (), false); PT.EBool(gid (), true) ] - ) - - let boolListList : PT.Expr = - PT.EList( - gid (), - [ PT.EList(gid (), [ PT.EBool(gid (), true); PT.EBool(gid (), false) ]) - PT.EList(gid (), [ PT.EBool(gid (), false); PT.EBool(gid (), true) ]) ] - ) - - let simpleString : PT.Expr = PT.EString(gid (), [ PT.StringText("hello") ]) - - let stringWithInterpolation : PT.Expr = - PT.ELet( - gid (), - PT.LPVariable(gid (), "x"), - PT.EString(gid (), [ PT.StringText ", world" ]), - PT.EString( - gid (), - [ PT.StringText "hello"; PT.StringInterpolation(PT.EVariable(gid (), "x")) ] - ) - ) - - let dictEmpty : PT.Expr = PT.EDict(gid (), []) - let dictSimple : PT.Expr = PT.EDict(gid (), [ "key", PT.EBool(gid (), true) ]) - let dictMultEntries : PT.Expr = - PT.EDict(gid (), [ "t", PT.EBool(gid (), true); "f", PT.EBool(gid (), false) ]) - let dictDupeKey : PT.Expr = - PT.EDict( - gid (), - [ "t", PT.EBool(gid (), true) - "f", PT.EBool(gid (), false) - "t", PT.EBool(gid (), false) ] - ) - - let ifGotoThenBranch : PT.Expr = - PT.EIf( - gid (), - PT.EBool(gid (), true), - PT.EInt64(gid (), 1), - Some(PT.EInt64(gid (), 2)) - ) - let ifGotoElseBranch : PT.Expr = - PT.EIf( - gid (), - PT.EBool(gid (), false), - PT.EInt64(gid (), 1), - Some(PT.EInt64(gid (), 2)) - ) - let ifElseMissing : PT.Expr = - PT.EIf(gid (), PT.EBool(gid (), false), PT.EInt64(gid (), 1), None) + let letTupleNested = + eLet + (lpTuple (lpVar "a") (lpTuple (lpVar "b") (lpVar "c") []) []) + (eTuple (eInt64 1) (eTuple (eInt64 2) (eInt64 3) []) []) + (eVar "b") + + let boolList = eList [ eBool true; eBool false; eBool true ] + + let boolListList = + eList [ eList [ eBool true; eBool false ]; eList [ eBool false; eBool true ] ] + + let simpleString = eStr [ strText "hello" ] + + let stringWithInterpolation = + eLet + (lpVar "x") + (eStr [ strText ", world" ]) + (eStr [ strText "hello"; strInterp (eVar "x") ]) + + let dictEmpty = eDict [] + let dictSimple = eDict [ "key", eBool true ] + let dictMultEntries = eDict [ "t", eBool true; "f", eBool false ] + let dictDupeKey = eDict [ "t", eBool true; "f", eBool false; "t", eBool false ] + + let ifGotoThenBranch = eIf (eBool true) (eInt64 1) (Some(eInt64 2)) + let ifGotoElseBranch = eIf (eBool false) (eInt64 1) (Some(eInt64 2)) + let ifElseMissing = eIf (eBool false) (eInt64 1) None /// (false, true) - let tuple2 : PT.Expr = - PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []) + let tuple2 = eTuple (eBool false) (eBool true) [] /// (false, true, false) - let tuple3 : PT.Expr = - PT.ETuple( - gid (), - PT.EBool(gid (), false), - PT.EBool(gid (), true), - [ PT.EBool(gid (), false) ] - ) + let tuple3 = eTuple (eBool false) (eBool true) [ eBool false ] /// ((false, true), true, (true, false)) - let tupleNested : PT.Expr = - PT.ETuple( - gid (), - PT.ETuple(gid (), PT.EBool(gid (), false), PT.EBool(gid (), true), []), - PT.EBool(gid (), true), - [ PT.ETuple(gid (), PT.EBool(gid (), true), PT.EBool(gid (), false), []) ] - ) + let tupleNested = + eTuple + (eTuple (eBool false) (eBool true) []) + (eBool true) + [ eTuple (eBool true) (eBool false) [] ] + + /// match true with + /// | false -> "first branch" + /// | true -> "second branch" + let matchSimple = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPBool(gid (), true) + whenCondition = None + rhs = eStr [ strText "second branch" ] } ] + + /// match true with + /// | false -> "first branch" + let matchNotMatched = + eMatch + (eBool true) + [ { pat = PT.MPBool(gid (), false) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + + /// match true with + /// | x -> x + let matchWithVar = + eMatch + (eBool true) + [ { pat = PT.MPVariable(gid (), "x"); whenCondition = None; rhs = eVar "x" } ] + + /// match 4 with + /// | 1 -> "first branch" + /// | x when x % 2 == 0 -> "second branch" + let matchWithVarAndWhenCondition = + eMatch + (eInt64 4) + [ { pat = PT.MPInt64(gid (), 1) + whenCondition = None + rhs = eStr [ strText "first branch" ] } + { pat = PT.MPVariable(gid (), "x") + // "is even" + whenCondition = + Some( + eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "equals" 0))) + [] + [ eApply + (PT.EFnName(gid (), Ok(PT.FQFnName.fqBuiltIn "int64Mod" 0))) + [] + [ eVar "x" ] + eInt64 2 ] + ) + rhs = eStr [ strText "second branch" ] } ] + + let matchList = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = PT.MPList(gid (), [ PT.MPInt64(gid (), 1); PT.MPInt64(gid (), 2) ]) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] + let matchListCons = + eMatch + (eList [ eInt64 1; eInt64 2 ]) + [ { pat = + PT.MPListCons( + gid (), + PT.MPInt64(gid (), 1), + PT.MPVariable(gid (), "tail") + ) + whenCondition = None + rhs = eVar "tail" } ] + let matchTuple = + eMatch + (eTuple (eInt64 1) (eInt64 2) []) + [ { pat = PT.MPTuple(gid (), PT.MPInt64(gid (), 1), PT.MPInt64(gid (), 2), []) + whenCondition = None + rhs = eStr [ strText "first branch" ] } ] module E = Expressions -let one = - testTask "1" { - let actual = PT2RT.Expr.toRT 0 E.one - let expected = (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) +let t name expr expected = + testTask name { + let actual = PT2RT.Expr.toRT 0 expr return Expect.equal actual expected "" } +let one = t "1" E.one (1, [ RT.LoadVal(0, RT.DInt64 1L) ], 0) + + let onePlusTwo = - testTask "1+2" { - let actual = PT2RT.Expr.toRT 0 E.onePlusTwo - - let expected = - (4, - [ RT.LoadVal( - 0, - RT.DFnVal( - RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) - ) + t + "1+2" + E.onePlusTwo + (4, + [ RT.LoadVal( + 0, + RT.DFnVal( + RT.NamedFn(RT.FQFnName.Builtin { name = "int64Add"; version = 0 }) ) - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], - 3) - - return Expect.equal actual expected "" - } + ) + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.Apply(3, 0, [], { head = 1; tail = [ 2 ] }) ], + 3) let letSimple = - testTask "let x = true\n x" { - let actual = PT2RT.Expr.toRT 0 E.letSimple - - let expected = - (2, - [ RT.LoadVal(0, RT.DBool true) - RT.SetVar("x", 0) // where the 'true' is stored - RT.GetVar(1, "x") ], - 1) - - return Expect.equal actual expected "" - } + t + "let x = true\n x" + E.letSimple + (2, + [ RT.LoadVal(0, RT.DBool true) + RT.SetVar("x", 0) // where the 'true' is stored + RT.GetVar(1, "x") ], + 1) let letTuple = - testTask "let (x, y) = (1, 2)\nx" { - let actual = PT2RT.Expr.toRT 0 E.letTuple - - let expected = - (6, - [ // register 0 isn't exposed, but used to temporarily store the tuple - RT.LoadVal(1, RT.DInt64 1L) - RT.LoadVal(2, RT.DInt64 2L) - RT.CreateTuple(0, 1, 2, []) - RT.ExtractTupleItems(0, 3, 4, []) - - RT.SetVar("x", 3) - RT.SetVar("y", 4) - - RT.GetVar(5, "x") ], - 5) - - return Expect.equal actual expected "" - } + t + "let (x, y) = (1, 2)\nx" + E.letTuple + (6, + [ // register 0 isn't exposed, but used to temporarily store the tuple + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + RT.ExtractTupleItems(0, 3, 4, []) + + RT.SetVar("x", 3) + RT.SetVar("y", 4) + + RT.GetVar(5, "x") ], + 5) let letTupleNested = - testTask "let (a, (b, c)) = (1, (2, 3)) in b" { - let actual = PT2RT.Expr.toRT 0 E.letTupleNested - - let expected = - (10, - [ // reserve 0 for outer tuple - RT.LoadVal(1, RT.DInt64 1L) - // reserve 2 for inner tuple - RT.LoadVal(3, RT.DInt64 2L) - RT.LoadVal(4, RT.DInt64 3L) - RT.CreateTuple(2, 3, 4, []) // create inner tuple - RT.CreateTuple(0, 1, 2, []) // create outer tuple - RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items - RT.SetVar("a", 5) - RT.ExtractTupleItems(6, 7, 8, []) - RT.SetVar("b", 7) - RT.SetVar("c", 8) - RT.GetVar(9, "b") ], - 9) - - return Expect.equal actual expected "" - } + t + "let (a, (b, c)) = (1, (2, 3)) in b" + E.letTupleNested + (10, + [ // reserve 0 for outer tuple + RT.LoadVal(1, RT.DInt64 1L) + // reserve 2 for inner tuple + RT.LoadVal(3, RT.DInt64 2L) + RT.LoadVal(4, RT.DInt64 3L) + RT.CreateTuple(2, 3, 4, []) // create inner tuple + RT.CreateTuple(0, 1, 2, []) // create outer tuple + RT.ExtractTupleItems(0, 5, 6, []) // extract outer tuple items + RT.SetVar("a", 5) + RT.ExtractTupleItems(6, 7, 8, []) + RT.SetVar("b", 7) + RT.SetVar("c", 8) + RT.GetVar(9, "b") ], + 9) let boolList = - testTask "[true, false, true]" { - let actual = PT2RT.Expr.toRT 0 E.boolList - - let expected = - (4, - [ RT.LoadVal(0, RT.DList(VT.unknown, [])) + t + "[true, false, true]" + E.boolList + (4, + [ RT.LoadVal(0, RT.DList(VT.unknown, [])) - RT.LoadVal(1, RT.DBool true) - RT.AddItemToList(0, 1) + RT.LoadVal(1, RT.DBool true) + RT.AddItemToList(0, 1) - RT.LoadVal(2, RT.DBool false) - RT.AddItemToList(0, 2) + RT.LoadVal(2, RT.DBool false) + RT.AddItemToList(0, 2) - RT.LoadVal(3, RT.DBool true) - RT.AddItemToList(0, 3) ], - 0) - - return Expect.equal actual expected "" - } + RT.LoadVal(3, RT.DBool true) + RT.AddItemToList(0, 3) ], + 0) let boolListList = - testTask "[[true; false]; [false; true]]" { - let actual = PT2RT.Expr.toRT 0 E.boolListList - - let expected = - (7, - [ // create outer list - RT.LoadVal(0, RT.DList(VT.unknown, [])) - - // first inner list - RT.LoadVal(1, RT.DList(VT.unknown, [])) - RT.LoadVal(2, RT.DBool true) - RT.AddItemToList(1, 2) - RT.LoadVal(3, RT.DBool false) - RT.AddItemToList(1, 3) - // add it to outer - RT.AddItemToList(0, 1) - - // second inner list - RT.LoadVal(4, RT.DList(VT.unknown, [])) - RT.LoadVal(5, RT.DBool false) - RT.AddItemToList(4, 5) - RT.LoadVal(6, RT.DBool true) - RT.AddItemToList(4, 6) - // add it to outer - RT.AddItemToList(0, 4) ], - 0) + t + "[[true; false]; [false; true]]" + E.boolListList + (7, + [ // create outer list + RT.LoadVal(0, RT.DList(VT.unknown, [])) + + // first inner list + RT.LoadVal(1, RT.DList(VT.unknown, [])) + RT.LoadVal(2, RT.DBool true) + RT.AddItemToList(1, 2) + RT.LoadVal(3, RT.DBool false) + RT.AddItemToList(1, 3) + // add it to outer + RT.AddItemToList(0, 1) + + // second inner list + RT.LoadVal(4, RT.DList(VT.unknown, [])) + RT.LoadVal(5, RT.DBool false) + RT.AddItemToList(4, 5) + RT.LoadVal(6, RT.DBool true) + RT.AddItemToList(4, 6) + // add it to outer + RT.AddItemToList(0, 4) ], + 0) - return Expect.equal actual expected "" - } let simpleString = - testTask "[\"hello\"]" { - let actual = PT2RT.Expr.toRT 0 E.simpleString - - let expected = - (2, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString "hello") - RT.AppendString(0, 1) ], - 0) - - return Expect.equal actual expected "" - } + t + "[\"hello\"]" + E.simpleString + (2, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString "hello") + RT.AppendString(0, 1) ], + 0) let stringWithInterpolation = - testTask "[let x = \"world\"\n$\"hello {x}\"]" { - let actual = PT2RT.Expr.toRT 0 E.stringWithInterpolation - - let expected = - (5, - [ RT.LoadVal(0, RT.DString "") - RT.LoadVal(1, RT.DString ", world") - RT.AppendString(0, 1) - RT.SetVar("x", 0) - RT.LoadVal(2, RT.DString "") - RT.LoadVal(3, RT.DString "hello") - RT.AppendString(2, 3) - RT.GetVar(4, "x") - RT.AppendString(2, 4) ], - 2) + t + "[let x = \"world\"\n$\"hello {x}\"]" + E.stringWithInterpolation + (5, + [ RT.LoadVal(0, RT.DString "") + RT.LoadVal(1, RT.DString ", world") + RT.AppendString(0, 1) + RT.SetVar("x", 0) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "hello") + RT.AppendString(2, 3) + RT.GetVar(4, "x") + RT.AppendString(2, 4) ], + 2) - return Expect.equal actual expected "" - } let dictEmpty = - testTask "Dict {}" { - let actual = PT2RT.Expr.toRT 0 E.dictEmpty - - let expected = (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) - - return Expect.equal actual expected "" - } + t "Dict {}" E.dictEmpty (1, [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) ], 0) let dictSimple = - testTask "Dict { t: true}" { - let actual = PT2RT.Expr.toRT 0 E.dictSimple - - let expected = - (2, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "key", 1) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict { t: true}" + E.dictSimple + (2, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "key", 1) ], + 0) let dictMultEntries = - testTask "Dict {t: true; f: false}" { - let actual = PT2RT.Expr.toRT 0 E.dictMultEntries - - let expected = - (3, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) - RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false}" + E.dictMultEntries + (3, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) ], + 0) let dictDupeKey = - testTask "Dict {t: true; f: false; t: true}" { - let actual = PT2RT.Expr.toRT 0 E.dictDupeKey - - let expected = - (4, - [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) - RT.LoadVal(1, RT.DBool true) - RT.AddDictEntry(0, "t", 1) - RT.LoadVal(2, RT.DBool false) - RT.AddDictEntry(0, "f", 2) - RT.LoadVal(3, RT.DBool false) - RT.AddDictEntry(0, "t", 3) ], - 0) - - return Expect.equal actual expected "" - } + t + "Dict {t: true; f: false; t: true}" + E.dictDupeKey + (4, + [ RT.LoadVal(0, RT.DDict(VT.unknown, Map.empty)) + RT.LoadVal(1, RT.DBool true) + RT.AddDictEntry(0, "t", 1) + RT.LoadVal(2, RT.DBool false) + RT.AddDictEntry(0, "f", 2) + RT.LoadVal(3, RT.DBool false) + RT.AddDictEntry(0, "t", 3) ], + 0) let ifGotoThenBranch = - testTask "if true then 1 else 2" { - let actual = PT2RT.Expr.toRT 0 E.ifGotoThenBranch + t + "if true then 1 else 2" + E.ifGotoThenBranch + (4, + [ // reserve register 0 for the result - let expected = - (4, - [ // cond - RT.LoadVal(1, RT.DBool true) - RT.JumpByIfFalse(3, 1) + // cond + RT.LoadVal(1, RT.DBool true) + RT.JumpByIfFalse(3, 1) - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) - return Expect.equal actual expected "" - } let ifGotoElseBranch = - testTask "if false then 1 else 2" { - let actual = PT2RT.Expr.toRT 0 E.ifGotoElseBranch - - let expected = - (4, - [ // cond - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(3, 1) + t + "if false then 1 else 2" + E.ifGotoElseBranch + (4, + [ // cond + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(3, 1) - // then - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) - RT.JumpBy 2 + // then + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) + RT.JumpBy 2 - // else - RT.LoadVal(3, RT.DInt64 2L) - RT.CopyVal(0, 3) ], - 0) + // else + RT.LoadVal(3, RT.DInt64 2L) + RT.CopyVal(0, 3) ], + 0) - return Expect.equal actual expected "" - } let ifElseMissing = - testTask "if false then 1" { - let actual = PT2RT.Expr.toRT 0 E.ifElseMissing - - let expected = - (3, - [ RT.LoadVal(0, RT.DUnit) - RT.LoadVal(1, RT.DBool false) - RT.JumpByIfFalse(2, 1) - RT.LoadVal(2, RT.DInt64 1L) - RT.CopyVal(0, 2) ], - 0) + t + "if false then 1" + E.ifElseMissing + (3, + [ RT.LoadVal(0, RT.DUnit) + RT.LoadVal(1, RT.DBool false) + RT.JumpByIfFalse(2, 1) + RT.LoadVal(2, RT.DInt64 1L) + RT.CopyVal(0, 2) ], + 0) - return Expect.equal actual expected "" - } let tuple2 = - testTask "(false, true)" { - let actual = PT2RT.Expr.toRT 0 E.tuple2 - - let expected = - (3, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.CreateTuple(0, 1, 2, []) ], - 0) - - return Expect.equal actual expected "" - } + t + "(false, true)" + E.tuple2 + (3, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.CreateTuple(0, 1, 2, []) ], + 0) let tuple3 = - testTask "(false, true, false)" { - let actual = PT2RT.Expr.toRT 0 E.tuple3 - - let expected = - (4, - [ RT.LoadVal(1, RT.DBool false) - RT.LoadVal(2, RT.DBool true) - RT.LoadVal(3, RT.DBool false) - RT.CreateTuple(0, 1, 2, [ 3 ]) ], - 0) - - return Expect.equal actual expected "" - } + t + "(false, true, false)" + E.tuple3 + (4, + [ RT.LoadVal(1, RT.DBool false) + RT.LoadVal(2, RT.DBool true) + RT.LoadVal(3, RT.DBool false) + RT.CreateTuple(0, 1, 2, [ 3 ]) ], + 0) let tupleNested = - testTask "((false, true), true, (true, false))" { - let actual = PT2RT.Expr.toRT 0 E.tupleNested - - let expected = - (8, - [ // 0 "reserved" for outer tuple - - // first inner tuple (1 "reserved") - RT.LoadVal(2, RT.DBool false) - RT.LoadVal(3, RT.DBool true) - RT.CreateTuple(1, 2, 3, []) - - // middle value - RT.LoadVal(4, RT.DBool true) - - // second inner tuple (5 "reserved") - RT.LoadVal(6, RT.DBool true) - RT.LoadVal(7, RT.DBool false) - RT.CreateTuple(5, 6, 7, []) - - // wrap all in outer tuple - RT.CreateTuple(0, 1, 4, [ 5 ]) ], - 0) - - return Expect.equal actual expected "" - } + t + "((false, true), true, (true, false))" + E.tupleNested + (8, + [ // 0 "reserved" for outer tuple + + // first inner tuple (1 "reserved") + RT.LoadVal(2, RT.DBool false) + RT.LoadVal(3, RT.DBool true) + RT.CreateTuple(1, 2, 3, []) + + // middle value + RT.LoadVal(4, RT.DBool true) + + // second inner tuple (5 "reserved") + RT.LoadVal(6, RT.DBool true) + RT.LoadVal(7, RT.DBool false) + RT.CreateTuple(5, 6, 7, []) + + // wrap all in outer tuple + RT.CreateTuple(0, 1, 4, [ 5 ]) ], + 0) + +let matchSimple = + t + "match true with\n| false -> \"first branch\"\n| true -> \"second branch\"" + E.matchSimple + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.MatchValue(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 7 + + // SECOND BRANCH + RT.MatchValue(0, RT.MPBool true, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "second branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchNotMatched = + t + "match true with\n| false -> \"first branch\"" + E.matchNotMatched + (4, + [ // handle the value we're matching on + RT.LoadVal(0, RT.DBool true) + + // FIRST BRANCH + RT.MatchValue(0, RT.MPBool false, 5) + // rhs + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchWithVar = + t + "match true with\n| x -> x" + E.matchWithVar + (3, + [ RT.LoadVal(0, RT.DBool true) + + RT.MatchValue(0, RT.MPVariable "x", 3) + RT.GetVar(2, "x") + RT.CopyVal(1, 2) + RT.JumpBy 1 + + RT.MatchUnmatched ], + 1) + +let matchWithVarAndWhenCondition = + t + "match 4 with\n| 1 -> \"first branch\"\n| x when x % 2 == 0 -> \"second branch\"" + E.matchWithVarAndWhenCondition + (10, + [ RT.LoadVal(0, RT.DInt64 4L) + + // first branch + RT.MatchValue(0, RT.MPInt64 1L, 5) + RT.LoadVal(2, RT.DString "") + RT.LoadVal(3, RT.DString "first branch") + RT.AppendString(2, 3) + RT.CopyVal(1, 2) + RT.JumpBy 14 + + // second branch + RT.MatchValue(0, RT.MPVariable "x", 12) + RT.LoadVal(2, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "equals" 0)))) + RT.LoadVal(3, (RT.DFnVal(RT.NamedFn(RT.FQFnName.fqBuiltin "int64Mod" 0)))) + RT.GetVar(4, "x") + RT.Apply(5, 3, [], NEList.ofList 4 []) + RT.LoadVal(6, RT.DInt64 2L) + RT.Apply(7, 2, [], NEList.ofList 5 [ 6 ]) + RT.JumpByIfFalse(5, 7) + RT.LoadVal(8, RT.DString "") + RT.LoadVal(9, RT.DString "second branch") + RT.AppendString(8, 9) + RT.CopyVal(1, 8) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 1) + +let matchList = + t + "match [1, 2] with\n| [1, 2] -> \"first branch\"" + E.matchList + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(0, RT.DList(VT.unknown, [])) + RT.LoadVal(1, RT.DInt64 1L) + RT.AddItemToList(0, 1) + RT.LoadVal(2, RT.DInt64 2L) + RT.AddItemToList(0, 2) + + // first branch + RT.MatchValue(0, RT.MPList [ RT.MPInt64 1L; RT.MPInt64 2L ], 5) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + +let matchListCons = + t + "match [1, 2] with\n| 1 :: tail -> tail" + E.matchListCons + (5, + [ // expr, whose result we store in 0 + RT.LoadVal(0, RT.DList(VT.unknown, [])) + RT.LoadVal(1, RT.DInt64 1L) + RT.AddItemToList(0, 1) + RT.LoadVal(2, RT.DInt64 2L) + RT.AddItemToList(0, 2) + + // first branch + RT.MatchValue(0, RT.MPListCons(RT.MPInt64 1L, RT.MPVariable "tail"), 3) + RT.GetVar(4, "tail") + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) + +let matchTuple = + t + "match (1, 2) with\n| (1, 2) -> \"first branch\"" + E.matchTuple + (6, + [ // expr, whose result we store in 0 + RT.LoadVal(1, RT.DInt64 1L) + RT.LoadVal(2, RT.DInt64 2L) + RT.CreateTuple(0, 1, 2, []) + + // first branch + RT.MatchValue(0, RT.MPTuple(RT.MPInt64 1L, RT.MPInt64 2L, []), 5) + RT.LoadVal(4, RT.DString "") + RT.LoadVal(5, RT.DString "first branch") + RT.AppendString(4, 5) + RT.CopyVal(3, 4) + RT.JumpBy 1 + + // handle the case where no branches match + RT.MatchUnmatched ], + 3) let tests = testList @@ -510,4 +623,11 @@ let tests = ifElseMissing tuple2 tuple3 - tupleNested ] + tupleNested + matchSimple + matchNotMatched + matchWithVar + //matchWithVarAndWhenCondition // -- disabled because of fn-calling issues + matchList + matchListCons + matchTuple ] diff --git a/tree-sitter-darklang/package-lock.json b/tree-sitter-darklang/package-lock.json index f2cf375bca..b15741a1bd 100644 --- a/tree-sitter-darklang/package-lock.json +++ b/tree-sitter-darklang/package-lock.json @@ -28,7 +28,6 @@ "integrity": "sha512-XjTcS3wdTy/2cc/ptMLc/WRyOLECRYcMTrSWyhZnj1oGSOWbHLTklgsgRICU3cPfb0vy+oZCC33M43u6R1HSCA==", "dev": true, "hasInstallScript": true, - "license": "MIT", "bin": { "tree-sitter": "cli.js" }