diff --git a/backend/experiments/BwdDangerServer/DangerExecution.fs b/backend/experiments/BwdDangerServer/DangerExecution.fs index e005cd215c..c5759f7e34 100644 --- a/backend/experiments/BwdDangerServer/DangerExecution.fs +++ b/backend/experiments/BwdDangerServer/DangerExecution.fs @@ -10,7 +10,6 @@ open Prelude module RT = LibExecution.RuntimeTypes module VT = RT.ValueType -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module AT = LibExecution.AnalysisTypes @@ -148,7 +147,7 @@ let executeHandler let fields : List = [ "statusCode", RT.DInt 500 - "headers", Dval.list (RT.KTTuple(VT.string, VT.string, [])) [] + "headers", RT.Dval.list (RT.KTTuple(VT.string, VT.string, [])) [] "body", RT.DBytes(UTF8.toBytes msg) ] RT.DRecord(typeName, typeName, [], Map fields) diff --git a/backend/experiments/BwdDangerServer/Libs/Experiments.fs b/backend/experiments/BwdDangerServer/Libs/Experiments.fs index 22207fc1f2..5fbca83fe8 100644 --- a/backend/experiments/BwdDangerServer/Libs/Experiments.fs +++ b/backend/experiments/BwdDangerServer/Libs/Experiments.fs @@ -8,7 +8,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes // This makes extra careful that we're only accessing files where we expect to diff --git a/backend/src/BuiltinCli/Libs/Directory.fs b/backend/src/BuiltinCli/Libs/Directory.fs index d1bb4efdbd..925a489a05 100644 --- a/backend/src/BuiltinCli/Libs/Directory.fs +++ b/backend/src/BuiltinCli/Libs/Directory.fs @@ -7,7 +7,6 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes module VT = ValueType -module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts diff --git a/backend/src/BuiltinCli/Libs/Environment.fs b/backend/src/BuiltinCli/Libs/Environment.fs index 729bbd8049..4e13c86e0c 100644 --- a/backend/src/BuiltinCli/Libs/Environment.fs +++ b/backend/src/BuiltinCli/Libs/Environment.fs @@ -7,8 +7,6 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes -module VT = ValueType -module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts diff --git a/backend/src/BuiltinCli/Libs/File.fs b/backend/src/BuiltinCli/Libs/File.fs index edc0f8277d..ae37e771de 100644 --- a/backend/src/BuiltinCli/Libs/File.fs +++ b/backend/src/BuiltinCli/Libs/File.fs @@ -6,8 +6,6 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes -module VT = ValueType -module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts diff --git a/backend/src/BuiltinCli/Libs/Process.fs b/backend/src/BuiltinCli/Libs/Process.fs index 5195c20754..41def77fc4 100644 --- a/backend/src/BuiltinCli/Libs/Process.fs +++ b/backend/src/BuiltinCli/Libs/Process.fs @@ -7,7 +7,6 @@ open FSharp.Control.Tasks open Prelude open LibExecution.RuntimeTypes -module Dval = LibExecution.Dval module Builtin = LibExecution.Builtin open Builtin.Shortcuts diff --git a/backend/src/BuiltinCliHost/Libs/Cli.fs b/backend/src/BuiltinCliHost/Libs/Cli.fs index 6c679863a3..d50cbfc8e5 100644 --- a/backend/src/BuiltinCliHost/Libs/Cli.fs +++ b/backend/src/BuiltinCliHost/Libs/Cli.fs @@ -11,7 +11,6 @@ open LibExecution.Builtin.Shortcuts module PT = LibExecution.ProgramTypes module RT = LibExecution.RuntimeTypes module VT = RT.ValueType -module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module RT2DT = LibExecution.RuntimeTypesToDarkTypes module Exe = LibExecution.Execution diff --git a/backend/src/BuiltinCloudExecution/Libs/DB.fs b/backend/src/BuiltinCloudExecution/Libs/DB.fs index 683f5bc81b..ebb19718c6 100644 --- a/backend/src/BuiltinCloudExecution/Libs/DB.fs +++ b/backend/src/BuiltinCloudExecution/Libs/DB.fs @@ -6,8 +6,8 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval module UserDB = LibCloud.UserDB module Db = LibCloud.Db @@ -81,7 +81,7 @@ let fns : List = uply { let db = state.program.dbs[dbname] let! result = UserDB.getOption state db key - return TypeChecker.DvalCreator.option VT.unknownDbTODO result + return Dval.checkedOption VT.unknownDbTODO result } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -111,10 +111,7 @@ let fns : List = |> UserDB.getMany state db if List.length items = List.length keys then - return - items - |> TypeChecker.DvalCreator.list valueType - |> Dval.optionSome optType + return items |> Dval.checkedList valueType |> Dval.optionSome optType else return Dval.optionNone optType } @@ -142,7 +139,7 @@ let fns : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getMany state db - return result |> TypeChecker.DvalCreator.list VT.unknownDbTODO + return result |> Dval.checkedList VT.unknownDbTODO } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -167,7 +164,7 @@ let fns : List = | DString s -> s | dv -> Exception.raiseInternal "keys aren't strings" [ "key", dv ]) |> UserDB.getManyWithKeys state db - return TypeChecker.DvalCreator.dict VT.unknownDbTODO result + return Dval.checkedDict VT.unknownDbTODO result } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -224,10 +221,7 @@ let fns : List = uply { let db = state.program.dbs[dbname] let! results = UserDB.getAll state db - return - results - |> List.map snd - |> TypeChecker.DvalCreator.list VT.unknownDbTODO + return results |> List.map snd |> Dval.checkedList VT.unknownDbTODO } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -247,7 +241,7 @@ let fns : List = uply { let db = state.program.dbs[dbname] let! result = UserDB.getAll state db - return TypeChecker.DvalCreator.dict VT.unknownDbTODO result + return Dval.checkedDict VT.unknownDbTODO result } | _ -> incorrectArgs ()) sqlSpec = NotQueryable @@ -322,8 +316,7 @@ let fns : List = let db = state.program.dbs[dbname] let! results = UserDB.queryValues state db b match results with - | Ok results -> - return results |> TypeChecker.DvalCreator.list VT.unknownDbTODO + | Ok results -> return results |> Dval.checkedList VT.unknownDbTODO | Error rte -> return raiseUntargetedRTE rte with e -> return handleUnexpectedExceptionDuringQuery state dbname b e @@ -348,8 +341,7 @@ let fns : List = let db = state.program.dbs[dbname] let! results = UserDB.query state db b match results with - | Ok results -> - return TypeChecker.DvalCreator.dict VT.unknownDbTODO results + | Ok results -> return Dval.checkedDict VT.unknownDbTODO results | Error rte -> return raiseUntargetedRTE rte with e -> return handleUnexpectedExceptionDuringQuery state dbname b e @@ -376,8 +368,8 @@ let fns : List = let! results = UserDB.query state db b match results with - | Ok [ (_, v) ] -> return TypeChecker.DvalCreator.optionSome optType v - | Ok _ -> return TypeChecker.DvalCreator.optionNone optType + | Ok [ (_, v) ] -> return Dval.checkedOptionSome optType v + | Ok _ -> return Dval.checkedOptionNone optType | Error rte -> return raiseUntargetedRTE rte with e -> return handleUnexpectedExceptionDuringQuery state dbname b e @@ -405,11 +397,8 @@ let fns : List = match results with | Ok [ (key, dv) ] -> - return - TypeChecker.DvalCreator.optionSome - optType - (DTuple(DString key, dv, [])) - | Ok _ -> return TypeChecker.DvalCreator.optionNone optType + return Dval.checkedOptionSome optType (DTuple(DString key, dv, [])) + | Ok _ -> return Dval.checkedOptionNone optType | Error rte -> return raiseUntargetedRTE rte with e -> return handleUnexpectedExceptionDuringQuery state dbname b e diff --git a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs index 6922a3b85d..749b5500ab 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Canvases.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Canvases.fs @@ -9,7 +9,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module Canvas = LibCloud.Canvas module Serialize = LibCloud.Serialize diff --git a/backend/src/BuiltinDarkInternal/Libs/DBs.fs b/backend/src/BuiltinDarkInternal/Libs/DBs.fs index a56abed790..9611e1e3e6 100644 --- a/backend/src/BuiltinDarkInternal/Libs/DBs.fs +++ b/backend/src/BuiltinDarkInternal/Libs/DBs.fs @@ -7,7 +7,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module Dval = LibExecution.Dval module UserDB = LibCloud.UserDB let modules = [ "DarkInternal"; "Canvas"; "DB" ] diff --git a/backend/src/BuiltinDarkInternal/Libs/Documentation.fs b/backend/src/BuiltinDarkInternal/Libs/Documentation.fs index 61a889833d..02cf94dcfa 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Documentation.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Documentation.fs @@ -9,7 +9,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval let modules = [ "DarkInternal"; "Documentation" ] diff --git a/backend/src/BuiltinDarkInternal/Libs/Domains.fs b/backend/src/BuiltinDarkInternal/Libs/Domains.fs index 5f1f8822f0..f417c757f1 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Domains.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Domains.fs @@ -7,8 +7,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval module Canvas = LibCloud.Canvas let modules = [ "DarkInternal"; "Canvas"; "Domain" ] diff --git a/backend/src/BuiltinDarkInternal/Libs/Infra.fs b/backend/src/BuiltinDarkInternal/Libs/Infra.fs index 94e594ed13..f9902e1117 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Infra.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Infra.fs @@ -7,8 +7,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval module DvalReprDeveloper = LibExecution.DvalReprDeveloper module Telemetry = LibService.Telemetry diff --git a/backend/src/BuiltinDarkInternal/Libs/Secrets.fs b/backend/src/BuiltinDarkInternal/Libs/Secrets.fs index 1207a21df3..e9fccca458 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Secrets.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Secrets.fs @@ -7,8 +7,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval module Secret = LibCloud.Secret diff --git a/backend/src/BuiltinDarkInternal/Libs/Workers.fs b/backend/src/BuiltinDarkInternal/Libs/Workers.fs index f3f3317794..c8691dbe90 100644 --- a/backend/src/BuiltinDarkInternal/Libs/Workers.fs +++ b/backend/src/BuiltinDarkInternal/Libs/Workers.fs @@ -8,7 +8,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module Dval = LibExecution.Dval module DarkDateTime = LibExecution.DarkDateTime module SchedulingRules = LibCloud.QueueSchedulingRules module Pusher = LibCloud.Pusher diff --git a/backend/src/BuiltinExecution/Libs/Base64.fs b/backend/src/BuiltinExecution/Libs/Base64.fs index c33e467e00..9dcaef6866 100644 --- a/backend/src/BuiltinExecution/Libs/Base64.fs +++ b/backend/src/BuiltinExecution/Libs/Base64.fs @@ -9,7 +9,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval let types : List = [] diff --git a/backend/src/BuiltinExecution/Libs/Bytes.fs b/backend/src/BuiltinExecution/Libs/Bytes.fs index 9fbb331a6d..9492f2b869 100644 --- a/backend/src/BuiltinExecution/Libs/Bytes.fs +++ b/backend/src/BuiltinExecution/Libs/Bytes.fs @@ -8,8 +8,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module Dval = LibExecution.Dval - let types : List = [] let modules = [ "Bytes" ] diff --git a/backend/src/BuiltinExecution/Libs/Char.fs b/backend/src/BuiltinExecution/Libs/Char.fs index 15c5a54e8a..6bbd546a75 100644 --- a/backend/src/BuiltinExecution/Libs/Char.fs +++ b/backend/src/BuiltinExecution/Libs/Char.fs @@ -8,9 +8,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval - let types : List = [] let constants : List = [] diff --git a/backend/src/BuiltinExecution/Libs/DateTime.fs b/backend/src/BuiltinExecution/Libs/DateTime.fs index 02830b4766..b09b79395b 100644 --- a/backend/src/BuiltinExecution/Libs/DateTime.fs +++ b/backend/src/BuiltinExecution/Libs/DateTime.fs @@ -5,8 +5,6 @@ type Instant = NodaTime.Instant open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval module DarkDateTime = LibExecution.DarkDateTime let ISO8601Format = "yyyy-MM-ddTHH:mm:ssZ" diff --git a/backend/src/BuiltinExecution/Libs/Dict.fs b/backend/src/BuiltinExecution/Libs/Dict.fs index aaec3f1fea..445b298463 100644 --- a/backend/src/BuiltinExecution/Libs/Dict.fs +++ b/backend/src/BuiltinExecution/Libs/Dict.fs @@ -7,9 +7,9 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval module VT = ValueType -module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter let varA = TVariable "a" @@ -116,7 +116,7 @@ let fns : List = [ "dval", dv ] List.fold f Map.empty l - |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + |> Dval.checkedDictFromMap VT.unknownTODO |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -155,10 +155,8 @@ let fns : List = match result with | Some entries -> - DDict(dictType, entries) - |> TypeChecker.DvalCreator.optionSome optType - |> Ply - | None -> TypeChecker.DvalCreator.optionNone optType |> Ply + DDict(dictType, entries) |> Dval.checkedOptionSome optType |> Ply + | None -> Dval.checkedOptionNone optType |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -175,7 +173,7 @@ let fns : List = fn = (function | _, _, [ DDict(_vtTODO, o); DString s ] -> - Map.find s o |> TypeChecker.DvalCreator.option VT.unknownTODO |> Ply + Map.find s o |> Dval.checkedOption VT.unknownTODO |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -227,7 +225,7 @@ let fns : List = Interpreter.applyFnVal state state.caller b [] args) mapped - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + return Dval.checkedDictFromMap VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -301,7 +299,7 @@ let fns : List = TypeChecker.raiseFnValResultNotExpectedType state.caller v TBool } let! result = Ply.Map.filterSequentially f o - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + return Dval.checkedDictFromMap VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -360,7 +358,7 @@ let fns : List = } let! result = Ply.Map.filterMapSequentially f o - return TypeChecker.DvalCreator.dictFromMap VT.unknownTODO result + return Dval.checkedDictFromMap VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -392,7 +390,7 @@ let fns : List = (function | _, _, [ DDict(_vtTODO1, l); DDict(_vtTODO2, r) ] -> Map.mergeFavoringRight l r - |> TypeChecker.DvalCreator.dictFromMap VT.unknownTODO + |> Dval.checkedDictFromMap VT.unknownTODO |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented diff --git a/backend/src/BuiltinExecution/Libs/Float.fs b/backend/src/BuiltinExecution/Libs/Float.fs index 6a5fa1a787..daeb4191b9 100644 --- a/backend/src/BuiltinExecution/Libs/Float.fs +++ b/backend/src/BuiltinExecution/Libs/Float.fs @@ -6,9 +6,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval - let types : List = [] let constants : List = [] diff --git a/backend/src/BuiltinExecution/Libs/Int.fs b/backend/src/BuiltinExecution/Libs/Int.fs index b6ca3b7cd0..205615e960 100644 --- a/backend/src/BuiltinExecution/Libs/Int.fs +++ b/backend/src/BuiltinExecution/Libs/Int.fs @@ -9,9 +9,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval - let types : List = [] let constants : List = [] diff --git a/backend/src/BuiltinExecution/Libs/Json.fs b/backend/src/BuiltinExecution/Libs/Json.fs index f533b83d65..a2ee2e6dc0 100644 --- a/backend/src/BuiltinExecution/Libs/Json.fs +++ b/backend/src/BuiltinExecution/Libs/Json.fs @@ -8,8 +8,8 @@ open LibExecution.Builtin.Shortcuts module DarkDateTime = LibExecution.DarkDateTime module VT = ValueType -module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval // parsing @@ -421,7 +421,7 @@ let parse |> Seq.mapi (fun i v -> convert nested (JsonPath.Part.Index i :: pathSoFar) v) |> Seq.toList |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.list VT.unknownTODO) + |> Ply.map (Dval.checkedList VT.unknownTODO) | TTuple(t1, t2, rest), JsonValueKind.Array -> let values = j.EnumerateArray() |> Seq.toList @@ -447,7 +447,7 @@ let parse }) |> Seq.toList |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.dict VT.unknownTODO) + |> Ply.map (Dval.checkedDict VT.unknownTODO) | TCustomType(Ok typeName, typeArgs), jsonValueKind -> uply { @@ -523,8 +523,7 @@ let parse let path = JsonPath.Part.Index index :: casePath return err (ParseError.EnumExtraField(fieldJson.GetRawText(), path)) else - return! - TypeChecker.DvalCreator.enum typeName typeName caseName fields + return! Dval.checkedEnum typeName typeName caseName fields | [] -> return raiseCantMatchWithType typ j pathSoFar | cases -> @@ -566,7 +565,7 @@ let parse }) |> Ply.List.flatten - return! TypeChecker.DvalCreator.record typeName fields + return! Dval.checkedRecord typeName fields } @@ -650,8 +649,8 @@ let fns : List = fn = let okType = VT.unknownTODO // "a" let errType = KTCustomType(ParseError.typeName, []) |> VT.known - let resultOk = TypeChecker.DvalCreator.resultOk okType errType - let resultError = TypeChecker.DvalCreator.resultError okType errType + let resultOk = Dval.checkedResultOk okType errType + let resultError = Dval.checkedResultError okType errType (function | state, [ typeArg ], [ DString arg ] -> let types = ExecutionState.availableTypes state diff --git a/backend/src/BuiltinExecution/Libs/List.fs b/backend/src/BuiltinExecution/Libs/List.fs index d70fd46fb8..958672ea51 100644 --- a/backend/src/BuiltinExecution/Libs/List.fs +++ b/backend/src/BuiltinExecution/Libs/List.fs @@ -5,10 +5,10 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter module TypeChecker = LibExecution.TypeChecker module DvalReprDeveloper = LibExecution.DvalReprDeveloper +module Dval = LibExecution.Dval // CLEANUP something like type ComparatorResult = Higher | Lower | Same @@ -387,8 +387,8 @@ let fns : List = of control." fn = let okType = VT.unknownTODO - let resultOk = TypeChecker.DvalCreator.resultOk okType VT.string - let resultError = TypeChecker.DvalCreator.resultError okType VT.string + let resultOk = Dval.checkedResultOk okType VT.string + let resultError = Dval.checkedResultError okType VT.string (function | state, _, [ DList(vt, list); DFnVal f ] -> @@ -434,7 +434,7 @@ let fns : List = | _, _, [ DList(vt1, l1); DList(_vt2, l2) ] -> // VTTODO should fail here in the case of vt1 conflicting with vt2? // (or is this handled by the interpreter?) - Ply(TypeChecker.DvalCreator.list vt1 (List.append l1 l2)) + Ply(Dval.checkedList vt1 (List.append l1 l2)) | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure @@ -534,7 +534,7 @@ let fns : List = } let! result = Ply.List.filterMapSequentially f l - return TypeChecker.DvalCreator.list VT.unknownTODO result + return Dval.checkedList VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -570,7 +570,7 @@ let fns : List = Interpreter.applyFnVal state state.caller b [] args) list - return TypeChecker.DvalCreator.list VT.unknownTODO result + return Dval.checkedList VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -617,7 +617,7 @@ let fns : List = Interpreter.applyFnVal state state.caller b [] args) list - return TypeChecker.DvalCreator.list VT.unknownTODO result + return Dval.checkedList VT.unknownTODO result } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -654,7 +654,7 @@ let fns : List = | state, _, [ DList(_vtTODO1, l1); DList(_vtTODO2, l2); DFnVal b ] -> uply { if List.length l1 <> List.length l2 then - return TypeChecker.DvalCreator.optionNone optType + return Dval.checkedOptionNone optType else let list = List.zip l1 l2 @@ -666,8 +666,8 @@ let fns : List = list return - TypeChecker.DvalCreator.list VT.unknownTODO result - |> TypeChecker.DvalCreator.optionSome optType + Dval.checkedList VT.unknownTODO result + |> Dval.checkedOptionSome optType } | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented @@ -686,14 +686,14 @@ let fns : List = fn = let optType = VT.unknownTODO (function - | _, _, [ DList(_, []) ] -> TypeChecker.DvalCreator.optionNone optType |> Ply + | _, _, [ DList(_, []) ] -> Dval.checkedOptionNone optType |> Ply | _, _, [ DList(_, l) ] -> // Will return <= (length - 1) // Maximum value is Int64.MaxValue which is half of UInt64.MaxValue, but // that won't affect this as we won't have a list that big for a long long // long time. let index = RNG.GetInt32(l.Length) - (List.tryItem index l) |> TypeChecker.DvalCreator.option optType |> Ply + (List.tryItem index l) |> Dval.checkedOption optType |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Impure diff --git a/backend/src/BuiltinExecution/Libs/Math.fs b/backend/src/BuiltinExecution/Libs/Math.fs index d11a6a764b..54a8af5d8a 100644 --- a/backend/src/BuiltinExecution/Libs/Math.fs +++ b/backend/src/BuiltinExecution/Libs/Math.fs @@ -9,9 +9,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval - let varA = TVariable "a" diff --git a/backend/src/BuiltinExecution/Libs/NoModule.fs b/backend/src/BuiltinExecution/Libs/NoModule.fs index 0d6fb4683e..3ff98b6b35 100644 --- a/backend/src/BuiltinExecution/Libs/NoModule.fs +++ b/backend/src/BuiltinExecution/Libs/NoModule.fs @@ -7,7 +7,6 @@ module DvalReprDeveloper = LibExecution.DvalReprDeveloper open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module Dval = LibExecution.Dval let rec equals (a : Dval) (b : Dval) : bool = diff --git a/backend/src/BuiltinExecution/Libs/String.fs b/backend/src/BuiltinExecution/Libs/String.fs index 4e46e413e3..b660204682 100644 --- a/backend/src/BuiltinExecution/Libs/String.fs +++ b/backend/src/BuiltinExecution/Libs/String.fs @@ -13,8 +13,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker module Interpreter = LibExecution.Interpreter diff --git a/backend/src/BuiltinExecution/Libs/Uuid.fs b/backend/src/BuiltinExecution/Libs/Uuid.fs index 7e1cae17d1..4a5442d8dc 100644 --- a/backend/src/BuiltinExecution/Libs/Uuid.fs +++ b/backend/src/BuiltinExecution/Libs/Uuid.fs @@ -4,11 +4,9 @@ open System.Threading.Tasks open System.Numerics open FSharp.Control.Tasks -open LibExecution.RuntimeTypes open Prelude +open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts -module VT = ValueType -module Dval = LibExecution.Dval let types : List = [] let constants : List = [] diff --git a/backend/src/BuiltinExecution/Libs/X509.fs b/backend/src/BuiltinExecution/Libs/X509.fs index ced9e4ba1c..584b248153 100644 --- a/backend/src/BuiltinExecution/Libs/X509.fs +++ b/backend/src/BuiltinExecution/Libs/X509.fs @@ -8,7 +8,6 @@ open Prelude open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval let varA = TVariable "a" let varB = TVariable "b" diff --git a/backend/src/Cli/Cli.fs b/backend/src/Cli/Cli.fs index 4a2d8c08b7..fbf849430d 100644 --- a/backend/src/Cli/Cli.fs +++ b/backend/src/Cli/Cli.fs @@ -6,7 +6,6 @@ open FSharp.Control.Tasks open Prelude module RT = LibExecution.RuntimeTypes -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module Exe = LibExecution.Execution @@ -88,7 +87,7 @@ let execute let state = state () let fnName = RT.FnName.fqPackage "Darklang" [ "Cli" ] "executeCliCommand" 0 let args = - args |> List.map RT.DString |> Dval.list RT.KTString |> NEList.singleton + args |> List.map RT.DString |> RT.Dval.list RT.KTString |> NEList.singleton return! Exe.executeFunction state None fnName [] args } diff --git a/backend/src/LibCloud/SqlCompiler.fs b/backend/src/LibCloud/SqlCompiler.fs index 4fdc5b6e29..7986d2d8c4 100644 --- a/backend/src/LibCloud/SqlCompiler.fs +++ b/backend/src/LibCloud/SqlCompiler.fs @@ -16,6 +16,7 @@ module VT = ValueType module DvalReprDeveloper = LibExecution.DvalReprDeveloper module DvalReprInternalQueryable = LibExecution.DvalReprInternalQueryable module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval module RuntimeTypesAst = LibExecution.RuntimeTypesAst @@ -599,12 +600,7 @@ let rec lambdaToSql // TODO: handle cases where `fields` is non-empty | EEnum(id, sourceTypeName, sourceCaseName, []) -> let source = Some(tlid, id) - let! dv = - TypeChecker.DvalCreator.enum - sourceTypeName - sourceTypeName - sourceCaseName - [] + let! dv = Dval.checkedEnum sourceTypeName sourceTypeName sourceCaseName [] let typeArgs = [] // TODO - get from the dval above? maybe typeName too... let typ = TCustomType(Ok sourceTypeName, typeArgs) diff --git a/backend/src/LibCloudExecution/CloudExecution.fs b/backend/src/LibCloudExecution/CloudExecution.fs index 3ad827e1af..9f57c82561 100644 --- a/backend/src/LibCloudExecution/CloudExecution.fs +++ b/backend/src/LibCloudExecution/CloudExecution.fs @@ -9,7 +9,6 @@ open System.Threading.Tasks open Prelude module RT = LibExecution.RuntimeTypes -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module AT = LibExecution.AnalysisTypes @@ -147,7 +146,8 @@ let executeHandler let fields = [ ("statusCode", RT.DInt 500) ("headers", - [] |> Dval.list (RT.KTTuple(RT.ValueType.string, RT.ValueType.string, []))) + [] + |> RT.Dval.list (RT.KTTuple(RT.ValueType.string, RT.ValueType.string, []))) ("body", RT.DBytes(msg |> UTF8.toBytes)) ] RT.DRecord(typeName, typeName, [], Map fields) diff --git a/backend/src/LibExecution/Dval.fs b/backend/src/LibExecution/Dval.fs index f75c960e91..01d205d25d 100644 --- a/backend/src/LibExecution/Dval.fs +++ b/backend/src/LibExecution/Dval.fs @@ -1,88 +1,285 @@ -/// Simple pass-through functions for creating Dvals +/// Dvals should be created carefully: +/// - to have the correct valueTypes, where appropriate +/// i.e. we should not have DList(Known KTInt, [ DString("hi") ]) +/// +/// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes +/// i.e. `List.append [1] ["hi"]` should fail +/// because we can't merge `Known KTInt` and `Known KTString` +/// +/// These functions are intended to help with both of these, in cases where +/// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types +/// of a Dval in some F# code). module LibExecution.Dval open Prelude -open LibExecution.RuntimeTypes +open RuntimeTypes module VT = ValueType +// TODO: maybe these should include `KnownType`s instead of `ValueType`s +// really this should be ErrorType +type DvalCreationError = -let int (i : int) = DInt(int64 i) + /// When building up a list, we found a value that didn't match the list's type + /// + /// `[1; "2"]` the types of `1` and `"2"` don't match + | ListAppend of vt : ValueType * item : Dval * vtOfDv : ValueType -let list (typ : KnownType) (list : List) : Dval = DList(VT.known typ, list) -let dict (typ : KnownType) (entries : List) : Dval = - DDict(VT.known typ, Map entries) + /// Record type declares a field that is not present in the record + /// + /// type Foo = { a: Int, b: Int } + /// let x: Foo = { a: 1 } + | RecordMissingField of + typeName : TypeName.TypeName * + fieldName : string * + typ : TypeReference -let dictFromMap (typ : KnownType) (entries : Map) : Dval = - DDict(VT.known typ, entries) + /// Record declaration has duplicate field names + /// + /// type Foo = { a: Int, a: Int } + /// let x: Foo = { a: 1; b = 2; a: 1; } + | RecordDuplicateField of typeName : TypeName.TypeName * fieldName : string -/// VTTODO -/// the interpreter "throws away" any valueTypes currently, -/// so while these .option and .result functions are great in that they -/// return the correct typeArgs, they conflict with what the interpreter will do -/// -/// So, to make some tests happy, let's ignore these for now. -/// -/// (might need better explanation^) -let ignoreAndUseEmpty (_ignoredForNow : List) = [] + // TODO add `Enum` case + // The `Option` and `Result` cases below will likely be removeable once complete + //| Enum + | Option of vt : ValueType * item : Dval * vtOfDv : ValueType + | ResultOk of + okVt : ValueType * + errVt : ValueType * + okDv : Dval * + vtOfDv : ValueType + | ResultError of + okVt : ValueType * + errVt : ValueType * + errDv : Dval * + vtOfDv : ValueType -let optionType = TypeName.fqPackage "Darklang" [ "Stdlib"; "Option" ] "Option" 0 +module RTE = + module RT2DT = RuntimeTypesToDarkTypes + let typeName = RuntimeError.name [ "DvalCreation" ] "Error" 0 -let optionSome (innerType : KnownType) (dv : Dval) : Dval = - DEnum( - optionType, - optionType, - ignoreAndUseEmpty [ VT.known innerType ], - "Some", - [ dv ] - ) + let toDT (error : DvalCreationError) : Dval = + let (caseName, fields) = + match error with + | ListAppend(vt, item, vtOfDv) -> + "ListAppend", + [ RT2DT.Dval.ValueType.toDT vt + RT2DT.Dval.toDT item + RT2DT.Dval.ValueType.toDT vtOfDv ] -let optionNone (innerType : KnownType) : Dval = - DEnum(optionType, optionType, ignoreAndUseEmpty [ VT.known innerType ], "None", []) + | RecordMissingField(typeName, fieldName, typ) -> + "RecordMissingField", + [ RT2DT.TypeName.toDT typeName + DString fieldName + RT2DT.TypeReference.toDT typ ] + + | RecordDuplicateField(typeName, fieldName) -> + "RecordDuplicateField", [ RT2DT.TypeName.toDT typeName; DString fieldName ] + + | Option(vt, item, vtOfDv) -> + "Option", + [ RT2DT.Dval.ValueType.toDT vt + RT2DT.Dval.toDT item + RT2DT.Dval.ValueType.toDT vtOfDv ] + + | ResultOk(okVt, errVt, okDv, vtOfDv) -> + "ResultOk", + [ RT2DT.Dval.ValueType.toDT okVt + RT2DT.Dval.ValueType.toDT errVt + RT2DT.Dval.toDT okDv + RT2DT.Dval.ValueType.toDT vtOfDv ] + + | ResultError(okVt, errVt, errDv, vtOfDv) -> + "ResultError", + [ RT2DT.Dval.ValueType.toDT okVt + RT2DT.Dval.ValueType.toDT errVt + RT2DT.Dval.toDT errDv + RT2DT.Dval.ValueType.toDT vtOfDv ] + + DEnum(typeName, typeName, [], caseName, fields) + + +let checkedList (initialType : ValueType) (list : List) : Dval = + let (typ, dvs) = + List.fold + (fun (typ, list) dv -> + let dvalType = Dval.toValueType dv + + match VT.merge typ dvalType with + | Ok newType -> newType, dv :: list + | Error() -> + ListAppend(typ, dv, dvalType) + |> RTE.toDT + |> RuntimeError.dvalCreationError + |> raiseRTE None) + (initialType, []) + list + + DList(typ, List.rev dvs) + + +let checkedDict (typ : ValueType) (entries : List) : Dval = + // TODO: dictPush, etc. + DDict(typ, Map entries) + +let checkedDictFromMap (typ : ValueType) (entries : Map) : Dval = + // TODO: dictPush, etc. + DDict(typ, entries) + +// CLEANUP - this fn was unused so I commented it out +// remove? or will it be handy? +// let dict (fields : List) : Dval = +// // Give a warning for duplicate keys +// List.fold +// (DDict(Map.empty)) +// (fun m (k, v) -> +// match m, k, v with +// // TYPESCLEANUP: remove hacks +// // If we're propagating a fakeval keep doing it. We handle it without this line but let's be certain +// | m, _k, _v when isFake m -> m +// // Errors should propagate (but only if we're not already propagating an error) +// | DDict _, _, v when isFake v -> v +// // Skip empty rows +// | _, "", _ -> DError(None, $"Empty key: {k}") +// // Error if the key appears twice +// | DDict m, k, _v when Map.containsKey k m -> +// DError(None, $"Duplicate key: {k}") +// // Otherwise add it +// | DDict m, k, v -> DDict(Map.add k v m) +// // If we haven't got a DDict we're propagating an error so let it go +// | m, _, _ -> m) +// fields -let option (innerType : KnownType) (dv : Option) : Dval = - match dv with - | Some dv -> optionSome innerType dv - | None -> optionNone innerType +let checkedOptionSome (innerType : ValueType) (dv : Dval) : Dval = + let typeName = Dval.optionType -let resultType = TypeName.fqPackage "Darklang" [ "Stdlib"; "Result" ] "Result" 0 + let dvalType = Dval.toValueType dv + match VT.merge innerType dvalType with + | Ok typ -> + DEnum(typeName, typeName, Dval.ignoreAndUseEmpty [ typ ], "Some", [ dv ]) + | Error() -> + RuntimeError.oldError + $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" + |> raiseRTE None -let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = +let checkedOptionNone (innerType : ValueType) : Dval = DEnum( - resultType, - resultType, - ignoreAndUseEmpty [ ValueType.Known okType; ValueType.Known errorType ], - "Ok", - [ dvOk ] + Dval.optionType, + Dval.optionType, + Dval.ignoreAndUseEmpty [ innerType ], + "None", + [] ) -let resultError - (okType : KnownType) - (errorType : KnownType) - (dvError : Dval) +let checkedOption (innerType : ValueType) (dv : Option) : Dval = + match dv with + | Some dv -> checkedOptionSome innerType dv + | None -> checkedOptionNone innerType + + + +let checkedResultOk + (okType : ValueType) + (errorType : ValueType) + (dvOk : Dval) : Dval = + let dvalType = Dval.toValueType dvOk + match VT.merge okType dvalType with + | Ok typ -> + DEnum( + Dval.resultType, + Dval.resultType, + Dval.ignoreAndUseEmpty [ typ; errorType ], + "Ok", + [ dvOk ] + ) + | Error() -> + RuntimeError.oldError + $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" + |> raiseRTE None - DEnum( - resultType, - resultType, - ignoreAndUseEmpty [ ValueType.known okType; ValueType.known errorType ], - "Error", - [ dvError ] - ) +let checkedResultError + (okType : ValueType) + (errorType : ValueType) + (dvError : Dval) + : Dval = + let dvalType = Dval.toValueType dvError + match VT.merge errorType dvalType with + | Ok typ -> + DEnum( + Dval.resultType, + Dval.resultType, + Dval.ignoreAndUseEmpty [ okType; typ ], + "Error", + [ dvError ] + ) + | Error() -> + RuntimeError.oldError + $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" + |> raiseRTE None -let result - (okType : KnownType) - (errorType : KnownType) +let checkedResult + (okType : ValueType) + (errorType : ValueType) (dv : Result) : Dval = match dv with - | Ok dv -> resultOk okType errorType dv - | Error dv -> resultError okType errorType dv + | Ok dv -> checkedResultOk okType errorType dv + | Error dv -> checkedResultError okType errorType dv + + +/// Constructs a Dval.DRecord, ensuring that the fields match the expected shape +/// +/// note: if provided, the typeArgs must match the # of typeArgs expected by the type +let checkedRecord + (typeName : TypeName.TypeName) + (fields : List) + : Ply = + let resolvedTypeName = typeName // TODO: alias lookup, etc. + + let fields = + List.fold + (fun fields (k, v) -> + match fields, k, v with + // skip empty rows + | _, "", _ -> raiseUntargetedRTE (RuntimeError.oldError "Empty key") + + // error if the key appears twice + | fields, k, _v when Map.containsKey k fields -> + raiseUntargetedRTE (RuntimeError.oldError $"Duplicate key: {k}") + + // otherwise add it + | fields, k, v -> Map.add k v fields) + Map.empty + fields + + // TODO: + // - pass in a (types: Types) arg + // - use it to determine type args of resultant Dval + // - ensure fields match the expected shape (defined by type args and field defs) + // - this process should also effect the type args of the resultant Dval + DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply + + +let checkedEnum + (resolvedTypeName : TypeName.TypeName) // todo: remove + (sourceTypeName : TypeName.TypeName) + (caseName : string) + (fields : List) + : Ply = + // TODO: + // - use passed-in Types to determine type args of resultant Dval + // - ensure fields match the expected shape (defined by type args and field defs) + // - this process should also effect the type args of the resultant Dval + + DEnum(resolvedTypeName, sourceTypeName, VT.typeArgsTODO, caseName, fields) + |> Ply diff --git a/backend/src/LibExecution/DvalReprInternalQueryable.fs b/backend/src/LibExecution/DvalReprInternalQueryable.fs index 71f9ec1332..209a61c3fa 100644 --- a/backend/src/LibExecution/DvalReprInternalQueryable.fs +++ b/backend/src/LibExecution/DvalReprInternalQueryable.fs @@ -262,7 +262,7 @@ let parseJsonV0 (types : Types) (typ : TypeReference) (str : string) : Ply |> Seq.map (convert nested) |> Seq.toList |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.list VT.unknownTODO) + |> Ply.map (Dval.checkedList VT.unknownTODO) | TTuple(t1, t2, rest), JsonValueKind.Array -> let arr = j.EnumerateArray() |> Seq.toList @@ -284,7 +284,7 @@ let parseJsonV0 (types : Types) (typ : TypeReference) (str : string) : Ply |> Map.toList |> List.map (fun (k, v) -> convert typ v |> Ply.map (fun v -> k, v)) |> Ply.List.flatten - |> Ply.map (TypeChecker.DvalCreator.dict VT.unknownTODO) + |> Ply.map (Dval.checkedDict VT.unknownTODO) | TCustomType(Ok typeName, typeArgs), valueKind -> @@ -352,7 +352,7 @@ let parseJsonV0 (types : Types) (typ : TypeReference) (str : string) : Ply |> Ply.List.flatten // TYPESCLEANUP: I don't think the sourceTypeName is right here? - return! TypeChecker.DvalCreator.enum typeName typeName caseName fields + return! Dval.checkedEnum typeName typeName caseName fields | _, _ -> return Exception.raiseInternal diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 24737eb76e..c437f106f5 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -310,7 +310,7 @@ let rec eval | EList(_id, exprs) -> let! results = Ply.List.mapSequentially (eval state tlid tst st) exprs - return TypeChecker.DvalCreator.list VT.unknown results + return Dval.checkedList VT.unknown results | ETuple(_id, first, second, theRest) -> @@ -415,7 +415,7 @@ let rec eval let! v = eval state tlid tst st v return (k, v) }) - return TypeChecker.DvalCreator.dict ValueType.Unknown fields + return Dval.checkedDict ValueType.Unknown fields | EFnName(_id, name) -> return DFnVal(NamedFn name) @@ -598,7 +598,7 @@ let rec eval | DList(vt, headVal :: tailVals) -> let! (headPass, headVars) = checkPattern headVal headPat let! (tailPass, tailVars) = - checkPattern (TypeChecker.DvalCreator.list vt tailVals) tailPat + checkPattern (Dval.checkedList vt tailVals) tailPat let allSubVars = headVars @ tailVars let pass = headPass && tailPass @@ -723,12 +723,7 @@ let rec eval [] (List.zip case.fields fields) - return! - TypeChecker.DvalCreator.enum - resolvedTypeName - sourceTypeName - caseName - fields + return! Dval.checkedEnum resolvedTypeName sourceTypeName caseName fields | EError(id, rte, exprs) -> let! (_ : List) = Ply.List.mapSequentially (eval state tlid tst st) exprs diff --git a/backend/src/LibExecution/LibExecution.fsproj b/backend/src/LibExecution/LibExecution.fsproj index 9e71778741..0ef0c40f82 100644 --- a/backend/src/LibExecution/LibExecution.fsproj +++ b/backend/src/LibExecution/LibExecution.fsproj @@ -12,7 +12,6 @@ - @@ -21,6 +20,7 @@ + diff --git a/backend/src/LibExecution/NameResolutionError.fs b/backend/src/LibExecution/NameResolutionError.fs index 714b9c1492..2c9635ec14 100644 --- a/backend/src/LibExecution/NameResolutionError.fs +++ b/backend/src/LibExecution/NameResolutionError.fs @@ -9,9 +9,21 @@ module D = DvalDecoder type ErrorType = | NotFound + + // TODO: this should be a TypeCheckerError, not a NameResolutionError | ExpectedEnumButNot + + // TODO: this should be a TypeCheckerError, not a NameResolutionError | ExpectedRecordButNot + + // User tried to create enum like `Some(1)`, without specifying type like `Option.Some(1)` | MissingEnumModuleName of caseName : string + + /// TODO rephrase this to UnparseablePackageName + /// + /// Roughly, the name should match these rules: + /// - types should look like `List` or `List_v1` + /// - functions and constants should look like `List.fakeFunction` or `List.fakeFunction_v1` | InvalidPackageName type NameType = diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index e074390d80..33e5f68c5a 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -798,6 +798,8 @@ module RuntimeError = let typeCheckerError field = case "TypeCheckerError" [ field ] + let dvalCreationError field = case "DvalCreationError" [ field ] + let jsonError field = case "JsonError" [ field ] let sqlCompilerRuntimeError (internalError : RuntimeError) = @@ -1039,6 +1041,95 @@ module Dval = | DDB _ -> ValueType.Unknown + let int (i : int) = DInt(int64 i) + + let list (typ : KnownType) (list : List) : Dval = + DList(ValueType.known typ, list) + + let dict (typ : KnownType) (entries : List) : Dval = + DDict(ValueType.known typ, Map entries) + + let dictFromMap (typ : KnownType) (entries : Map) : Dval = + DDict(ValueType.known typ, entries) + + + /// VTTODO + /// the interpreter "throws away" any valueTypes currently, + /// so while these .option and .result functions are great in that they + /// return the correct typeArgs, they conflict with what the interpreter will do + /// + /// So, to make some tests happy, let's ignore these for now. + /// + /// (might need better explanation^) + let ignoreAndUseEmpty (_ignoredForNow : List) = [] + + + + let optionType = TypeName.fqPackage "Darklang" [ "Stdlib"; "Option" ] "Option" 0 + + + let optionSome (innerType : KnownType) (dv : Dval) : Dval = + DEnum( + optionType, + optionType, + ignoreAndUseEmpty [ ValueType.known innerType ], + "Some", + [ dv ] + ) + + let optionNone (innerType : KnownType) : Dval = + DEnum( + optionType, + optionType, + ignoreAndUseEmpty [ ValueType.known innerType ], + "None", + [] + ) + + let option (innerType : KnownType) (dv : Option) : Dval = + match dv with + | Some dv -> optionSome innerType dv + | None -> optionNone innerType + + + + let resultType = TypeName.fqPackage "Darklang" [ "Stdlib"; "Result" ] "Result" 0 + + + let resultOk (okType : KnownType) (errorType : KnownType) (dvOk : Dval) : Dval = + DEnum( + resultType, + resultType, + ignoreAndUseEmpty [ ValueType.Known okType; ValueType.Known errorType ], + "Ok", + [ dvOk ] + ) + + let resultError + (okType : KnownType) + (errorType : KnownType) + (dvError : Dval) + : Dval = + + DEnum( + resultType, + resultType, + ignoreAndUseEmpty [ ValueType.known okType; ValueType.known errorType ], + "Error", + [ dvError ] + ) + + let result + (okType : KnownType) + (errorType : KnownType) + (dv : Result) + : Dval = + match dv with + | Ok dv -> resultOk okType errorType dv + | Error dv -> resultError okType errorType dv + + + let asList (dv : Dval) : Option> = match dv with | DList(_, l) -> Some l diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs index 0d25f95f5a..b55f1b3d42 100644 --- a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs +++ b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs @@ -844,7 +844,8 @@ module Dval = | _ -> Exception.raiseInternal "Invalid KnownType" [] module ValueType = - let knownType = KTCustomType(rtTyp [] "ValueType" 0, []) + let typeName = rtTyp [] "ValueType" 0 + let knownType = KTCustomType(typeName, []) let toDT (vt : ValueType) : Dval = let (caseName, fields) = @@ -853,7 +854,6 @@ module Dval = | ValueType.Known kt -> let kt = KnownType.toDT kt "Known", [ kt ] - let typeName = rtTyp [] "ValueType" 0 DEnum(typeName, typeName, [], caseName, fields) let fromDT (d : Dval) : ValueType = diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index abd6b5eae1..9f7b2a0fed 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -14,23 +14,48 @@ let combineErrorsUnit (l : NEList>) : Result = type Location = Option type Context = + /// An argument used in a function call did not match + /// the type expected for the function's corresponding parameter | FunctionCallParameter of fnName : FnName.FnName * parameter : Param * paramIndex : int * // caller : Option * // TODO add caller location : Location + + /// The result of calling function did match the function signature's expected return type | FunctionCallResult of fnName : FnName.FnName * returnType : TypeReference * // caller : Option * // TODO add caller location : Location + + | DBQueryVariable of + varName : string * + expected : TypeReference * + location : Location + + | DBSchemaType of + name : string * + expectedType : TypeReference * + location : Location + + /// We eval'd a passed-in fn value (lambda or named function), + /// and its result was of the wrong type + /// + /// TODO should we include the dval here? + /// TODO rename `returnType` to `expectedType` everywhere relevant + | FnValResult of returnType : TypeReference * location : Location + + + // TODO remove this soon, in favor of a `DvalCreationError` error | RecordField of recordTypeName : TypeName.TypeName * fieldName : string * fieldType : TypeReference * location : Location - | DictKey of key : string * typ : TypeReference * Location + + // TODO remove this soon, in favor of a `DvalCreationError` error | EnumField of enumTypeName : TypeName.TypeName * caseName : string * @@ -38,45 +63,29 @@ type Context = fieldCount : int * fieldType : TypeReference * location : Location - | DBQueryVariable of - varName : string * - expected : TypeReference * - location : Location - | DBSchemaType of - name : string * - expectedType : TypeReference * - location : Location - | ListIndex of index : int * listTyp : TypeReference * parent : Context - | TupleIndex of index : int * elementType : TypeReference * parent : Context - | FnValResult of returnType : TypeReference * location : Location -module Context = - let rec toLocation (c : Context) : Location = - match c with - | FunctionCallParameter(_, _, _, location) -> location - | FunctionCallResult(_, _, location) -> location - | RecordField(_, _, _, location) -> location - | DictKey(_, _, location) -> location - | EnumField(_, _, _, _, _, location) -> location - | DBQueryVariable(_, _, location) -> location - | DBSchemaType(_, _, location) -> location - | ListIndex(_, _, parent) -> toLocation parent - | TupleIndex(_, _, parent) -> toLocation parent - | FnValResult(_, location) -> location - +// elsewhere known as `TypeCheckerError` type Error = + /// We tried to look up a type, but couldn't find it + | TypeDoesntExist of TypeName.TypeName * Context + + + /// There was an expectation that some value would be of a particular TypeReference, + /// but it was not | ValueNotExpectedType of // CLEANUP consider reordering fields to (context * expectedType * actualValue) actualValue : Dval * + + // TODO There seems to be some redundancy between this expectedType and ones within the Context expectedType : TypeReference * + Context - | TypeDoesntExist of TypeName.TypeName * Context -module Error = +module Error = module RT2DT = RuntimeTypesToDarkTypes module Location = @@ -85,12 +94,11 @@ module Error = match location with | None -> Dval.optionNone optType | Some(tlid, id) -> - let tlid = DInt(int64 tlid) - let id = DInt(int64 id) - Dval.optionSome optType (DTuple(tlid, id, [])) - + DTuple(DInt(int64 tlid), DInt(int64 id), []) |> Dval.optionSome optType module Context = + let typeName = RuntimeError.name [ "TypeChecker" ] "Context" 0 + let rec toDT (context : Context) : Dval = let (caseName, fields) = match context with @@ -114,10 +122,6 @@ module Error = RT2DT.TypeReference.toDT fieldType Location.toDT location ] - | DictKey(key, typ, location) -> - "DictKey", - [ DString key; RT2DT.TypeReference.toDT typ; Location.toDT location ] - | EnumField(enumTypeName, caseName, fieldIndex, @@ -144,21 +148,15 @@ module Error = RT2DT.TypeReference.toDT expectedType Location.toDT location ] - | ListIndex(index, listTyp, parent) -> - "ListIndex", [ DInt index; RT2DT.TypeReference.toDT listTyp; toDT parent ] - - | TupleIndex(index, elementType, parent) -> - "TupleIndex", - [ DInt index; RT2DT.TypeReference.toDT elementType; toDT parent ] - | FnValResult(returnType, location) -> "FnValResult", [ RT2DT.TypeReference.toDT returnType; Location.toDT location ] - let typeName = RuntimeError.name [ "TypeChecker" ] "Context" 0 DEnum(typeName, typeName, [], caseName, fields) + let typeName = RuntimeError.name [ "TypeChecker" ] "Error" 0 + let toRuntimeError (e : Error) : RuntimeError = let (caseName, fields) = match e with @@ -171,10 +169,9 @@ module Error = | TypeDoesntExist(typeName, context) -> "TypeDoesntExist", [ RT2DT.TypeName.toDT typeName; Context.toDT context ] - let typeName = RuntimeError.name [ "TypeChecker" ] "Error" 0 - DEnum(typeName, typeName, [], caseName, fields) |> RuntimeError.typeCheckerError + let raiseValueNotExpectedType (source : Source) (dv : Dval) @@ -509,195 +506,3 @@ let checkFunctionReturnType : Ply> = let context = FunctionCallResult(fn.name, fn.returnType, None) unify context types tst fn.returnType result - - -/// Helpers for creating type-checked Dvals -/// (lists, records, enums, etc.) -/// -/// Dvals should be created carefully: -/// - to have the correct valueTypes, where appropriate -/// i.e. we should not have DList(Known KTInt, [ DString("hi") ]) -/// -/// - similarly, we should fail when trying to merge Dvals with conflicting valueTypes -/// i.e. `List.append [1] ["hi"]` should fail -/// because we can't merge `Known KTInt` and `Known KTString` -/// -/// These functions are intended to help with both of these, in cases where -/// the functions in Dval.fs are insufficient (i.e. we don't know the Dark sub-types -/// of a Dval in some F# code). -/// -/// TODO: review _all_ usages of these functions -module DvalCreator = - let list (initialType : ValueType) (list : List) : Dval = - let (typ, dvs) = - List.fold - (fun (typ, list) dv -> - let dvalType = Dval.toValueType dv - - match VT.merge typ dvalType with - | Ok newType -> newType, dv :: list - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.list typ)} and {ValueType.toString (VT.list dvalType)}" - |> raiseRTE None) - (initialType, []) - (List.rev list) - - DList(typ, dvs) - - - let dict (typ : ValueType) (entries : List) : Dval = - // TODO: dictPush, etc. - DDict(typ, Map entries) - - let dictFromMap (typ : ValueType) (entries : Map) : Dval = - // TODO: dictPush, etc. - DDict(typ, entries) - - // CLEANUP - this fn was unused so I commented it out - // remove? or will it be handy? - // let dict (fields : List) : Dval = - // // Give a warning for duplicate keys - // List.fold - // (DDict(Map.empty)) - // (fun m (k, v) -> - // match m, k, v with - // // TYPESCLEANUP: remove hacks - // // If we're propagating a fakeval keep doing it. We handle it without this line but let's be certain - // | m, _k, _v when isFake m -> m - // // Errors should propagate (but only if we're not already propagating an error) - // | DDict _, _, v when isFake v -> v - // // Skip empty rows - // | _, "", _ -> DError(None, $"Empty key: {k}") - // // Error if the key appears twice - // | DDict m, k, _v when Map.containsKey k m -> - // DError(None, $"Duplicate key: {k}") - // // Otherwise add it - // | DDict m, k, v -> DDict(Map.add k v m) - // // If we haven't got a DDict we're propagating an error so let it go - // | m, _, _ -> m) - // fields - - - - let optionSome (innerType : ValueType) (dv : Dval) : Dval = - let typeName = Dval.optionType - - let dvalType = Dval.toValueType dv - - match VT.merge innerType dvalType with - | Ok typ -> - DEnum(typeName, typeName, Dval.ignoreAndUseEmpty [ typ ], "Some", [ dv ]) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType typeName [ innerType ])} and {ValueType.toString (VT.customType typeName [ dvalType ])}" - |> raiseRTE None - - let optionNone (innerType : ValueType) : Dval = - DEnum( - Dval.optionType, - Dval.optionType, - Dval.ignoreAndUseEmpty [ innerType ], - "None", - [] - ) - - let option (innerType : ValueType) (dv : Option) : Dval = - match dv with - | Some dv -> optionSome innerType dv - | None -> optionNone innerType - - - - let resultOk (okType : ValueType) (errorType : ValueType) (dvOk : Dval) : Dval = - let dvalType = Dval.toValueType dvOk - match VT.merge okType dvalType with - | Ok typ -> - DEnum( - Dval.resultType, - Dval.resultType, - Dval.ignoreAndUseEmpty [ typ; errorType ], - "Ok", - [ dvOk ] - ) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ dvalType; errorType ])}" - |> raiseRTE None - - let resultError - (okType : ValueType) - (errorType : ValueType) - (dvError : Dval) - : Dval = - let dvalType = Dval.toValueType dvError - match VT.merge errorType dvalType with - | Ok typ -> - DEnum( - Dval.resultType, - Dval.resultType, - Dval.ignoreAndUseEmpty [ okType; typ ], - "Error", - [ dvError ] - ) - | Error() -> - RuntimeError.oldError - $"Could not merge types {ValueType.toString (VT.customType Dval.resultType [ okType; errorType ])} and {ValueType.toString (VT.customType Dval.resultType [ okType; dvalType ])}" - |> raiseRTE None - - let result - (okType : ValueType) - (errorType : ValueType) - (dv : Result) - : Dval = - match dv with - | Ok dv -> resultOk okType errorType dv - | Error dv -> resultError okType errorType dv - - - /// Constructs a Dval.DRecord, ensuring that the fields match the expected shape - /// - /// note: if provided, the typeArgs must match the # of typeArgs expected by the type - let record - (typeName : TypeName.TypeName) - (fields : List) - : Ply = - let resolvedTypeName = typeName // TODO: alias lookup, etc. - - let fields = - List.fold - (fun fields (k, v) -> - match fields, k, v with - // skip empty rows - | _, "", _ -> raiseUntargetedRTE (RuntimeError.oldError "Empty key") - - // error if the key appears twice - | fields, k, _v when Map.containsKey k fields -> - raiseUntargetedRTE (RuntimeError.oldError $"Duplicate key: {k}") - - // otherwise add it - | fields, k, v -> Map.add k v fields) - Map.empty - fields - - // TODO: - // - pass in a (types: Types) arg - // - use it to determine type args of resultant Dval - // - ensure fields match the expected shape (defined by type args and field defs) - // - this process should also effect the type args of the resultant Dval - DRecord(resolvedTypeName, typeName, VT.typeArgsTODO, fields) |> Ply - - - let enum - (resolvedTypeName : TypeName.TypeName) // todo: remove - (sourceTypeName : TypeName.TypeName) - (caseName : string) - (fields : List) - : Ply = - // TODO: - // - use passed-in Types to determine type args of resultant Dval - // - ensure fields match the expected shape (defined by type args and field defs) - // - this process should also effect the type args of the resultant Dval - - DEnum(resolvedTypeName, sourceTypeName, VT.typeArgsTODO, caseName, fields) - |> Ply diff --git a/backend/src/LibHttpMiddleware/Http.fs b/backend/src/LibHttpMiddleware/Http.fs index eef14f1e59..4fffc2a0c1 100644 --- a/backend/src/LibHttpMiddleware/Http.fs +++ b/backend/src/LibHttpMiddleware/Http.fs @@ -7,7 +7,6 @@ module LibHttpMiddleware.Http open Prelude open LibExecution.Builtin.Shortcuts -module Dval = LibExecution.Dval module RT = LibExecution.RuntimeTypes module Telemetry = LibService.Telemetry @@ -29,7 +28,7 @@ module Request = headers |> lowercaseHeaderKeys |> List.map (fun (k, v) -> RT.DTuple(RT.DString(k), RT.DString(v), [])) - |> Dval.list headerType + |> RT.Dval.list headerType let fields = [ "body", RT.DBytes body; "headers", headers; "url", RT.DString uri ] diff --git a/backend/src/LibParser/FSharpToWrittenTypes.fs b/backend/src/LibParser/FSharpToWrittenTypes.fs index 01ec00127f..b6983dfa93 100644 --- a/backend/src/LibParser/FSharpToWrittenTypes.fs +++ b/backend/src/LibParser/FSharpToWrittenTypes.fs @@ -216,7 +216,9 @@ module Expr = match fnName with | Regex.Regex "^([a-z][a-z0-9A-Z]*[']?)_v(\d+)$" [ name; version ] -> Ok(name, (int version)) + | Regex.Regex "^([a-z][a-z0-9A-Z]*[']?)$" [ name ] -> Ok(name, 0) + | _ -> Error "Bad format in fn name" let parseEnum (enumName : string) : Option = diff --git a/backend/src/LocalExec/Libs/List.fs b/backend/src/LocalExec/Libs/List.fs index 9b3376ea55..e847c26a85 100644 --- a/backend/src/LocalExec/Libs/List.fs +++ b/backend/src/LocalExec/Libs/List.fs @@ -9,9 +9,9 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module Interpreter = LibExecution.Interpreter module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval let varA = TVariable "a" @@ -75,7 +75,7 @@ let fns : List = | DList(_vtTODO, l) -> List.append acc l | _ -> Exception.raiseInternal "flatten: expected list of lists" [] - List.fold f [] l |> TypeChecker.DvalCreator.list VT.unknownTODO |> Ply + List.fold f [] l |> Dval.checkedList VT.unknownTODO |> Ply | _ -> incorrectArgs ()) sqlSpec = NotYetImplemented previewable = Pure diff --git a/backend/src/LocalExec/Libs/Packages.fs b/backend/src/LocalExec/Libs/Packages.fs index 0b88aec4ca..bf9d44e85b 100644 --- a/backend/src/LocalExec/Libs/Packages.fs +++ b/backend/src/LocalExec/Libs/Packages.fs @@ -12,7 +12,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module PT2DT = LibExecution.ProgramTypesToDarkTypes let types : List = diff --git a/backend/src/LocalExec/Libs/Packages2.fs b/backend/src/LocalExec/Libs/Packages2.fs index c994ab3126..c2c9d16134 100644 --- a/backend/src/LocalExec/Libs/Packages2.fs +++ b/backend/src/LocalExec/Libs/Packages2.fs @@ -9,7 +9,6 @@ open LibExecution.RuntimeTypes open LibExecution.Builtin.Shortcuts module VT = ValueType -module Dval = LibExecution.Dval module PT2DT = LibExecution.ProgramTypesToDarkTypes let packageManager = LibCloud.PackageManager.packageManager diff --git a/backend/src/LocalExec/LocalExec.fs b/backend/src/LocalExec/LocalExec.fs index c3a173b497..31769a326a 100644 --- a/backend/src/LocalExec/LocalExec.fs +++ b/backend/src/LocalExec/LocalExec.fs @@ -7,7 +7,6 @@ open FSharp.Control.Tasks open Prelude module RT = LibExecution.RuntimeTypes -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes module Exe = LibExecution.Execution @@ -281,7 +280,8 @@ let runLocalExecScript (args : string[]) : Ply = packageManager = Some LibCloud.PackageManager.packageManager } let! modul = LibParser.Canvas.parseFromFile nameResolver mainFile - let args = args |> Array.toList |> List.map RT.DString |> Dval.list RT.KTString + let args = + args |> Array.toList |> List.map RT.DString |> RT.Dval.list RT.KTString let result = execute modul (Map [ "args", args ]) diff --git a/backend/src/Wasm/Libs/Editor.fs b/backend/src/Wasm/Libs/Editor.fs index 9f5d91e691..c4633ffb60 100644 --- a/backend/src/Wasm/Libs/Editor.fs +++ b/backend/src/Wasm/Libs/Editor.fs @@ -10,8 +10,8 @@ open LibExecution.Builtin.Shortcuts open Wasm.EvalHelpers module VT = ValueType -module Dval = LibExecution.Dval module TypeChecker = LibExecution.TypeChecker +module Dval = LibExecution.Dval let types : List = [] let constants : List = [] @@ -47,8 +47,8 @@ let fns : List = "Get the editor's global current state (maintained in the WASM runtime)" fn = let okType = VT.unknownTODO - let resultOk = TypeChecker.DvalCreator.resultOk okType VT.string - let resultError = TypeChecker.DvalCreator.resultOk okType VT.string + let resultOk = Dval.checkedResultOk okType VT.string + let resultError = Dval.checkedResultOk okType VT.string (function | _, [ _typeParam ], [ DUnit ] -> try @@ -74,7 +74,7 @@ let fns : List = | _, [ _typeParam ], [ v ] -> // TODO: verify that the type matches the given typeParam editor <- { editor with CurrentState = v } - TypeChecker.DvalCreator.resultOk VT.unknownTODO VT.string v |> Ply + Dval.checkedResultOk VT.unknownTODO VT.string v |> Ply | _ -> incorrectArgs ()) sqlSpec = NotQueryable previewable = Impure diff --git a/backend/testfiles/execution/stdlib/list.dark b/backend/testfiles/execution/stdlib/list.dark index 3b2f313540..37a3e81a95 100644 --- a/backend/testfiles/execution/stdlib/list.dark +++ b/backend/testfiles/execution/stdlib/list.dark @@ -1,7 +1,14 @@ -// CLEANUP the following tests should fail on having mixed types -//[1; 2.3] = Builtin.Test.derrorMessage "Cannot form a list of mixed types - the 2nd element does not match the type of previous elements" -//[(1,10);10;(3,30)] = Builtin.Test.derrorMessage "Cannot form a list of mixed types ..." -//[(1,10);(2,20);(3,30,40)] = Builtin.Test.derrorMessage "Cannot form a list of mixed types" +[ 1; 2.3 ] = Builtin.Test.derrorMessage + "Type Conflict: Mixing data types (Int and Float) in list creation. +Cannot include item of type Float(2.3) in a list of type Int. Lists can only contain values of a single type." + +[ (1, 10); 10; (3, 30) ] = Builtin.Test.derrorMessage + "Type Conflict: Mixing data types ((Int, Int) and Int) in list creation. +Cannot include item of type Int(10) in a list of type (Int, Int). Lists can only contain values of a single type." + +// CLEANUP the f# parse seems to be preventing us from including the following test +//[ (1, 10); (2, 20); (3, 30, 40) ] = Builtin.Test.derrorMessage +// "Cannot form a list of mixed types" PACKAGE.Darklang.Stdlib.List.all_v0 [] (fun item -> item < 3) = true @@ -120,13 +127,17 @@ PACKAGE.Darklang.Stdlib.List.findFirst [ 0; 5; -6; -10 ] (fun x -> x < 0) = PACK PACKAGE.Darklang.Stdlib.List.findFirst [ 1; -33; 3; -2; 12 ] (fun x -> (x < 0 && x % 2 == 0)) = PACKAGE.Darklang.Stdlib.Option.Option.Some -2 -// CLEANUP once DList contains typeRefs, this test may be uncommented and the error message updated: -// PACKAGE.Darklang.Stdlib.List.flatten_v0 [1;2;3] = -// Builtin.Test.runtimeError "In List.flatten's 1st argument (`list`), the value should be a List>. However, a List ([1; 2; 3]) was passed instead.\n\nExpected: List>\nActual: List: [1; 2; 3]" +PACKAGE.Darklang.Stdlib.List.flatten_v0 [ 1; 2; 3 ] = Builtin.Test.derrorMessage + "PACKAGE.Darklang.Stdlib.List.flatten's 1st argument (`list`) should be a List>. However, a List ([ 1, 2, ...) was passed instead. + +Expected: (list: List>) +Actual: a List: [\n 1, 2, 3\n]" + PACKAGE.Darklang.Stdlib.List.flatten_v0 [ [ 1 ]; [ 2 ]; [ 3 ] ] = [ 1; 2; 3 ] PACKAGE.Darklang.Stdlib.List.flatten_v0 [ [ 1 ]; [ [ 2; 3 ] ] ] = Builtin.Test.derrorMessage - "Could not merge types List>> and List>" + "Type Conflict: Mixing data types (List and List>) in list creation. +Cannot include item of type List>([ [ ...) in a list of type List. Lists can only contain values of a single type." PACKAGE.Darklang.Stdlib.List.flatten_v0 [ [ [] ] ] = [ [] ] PACKAGE.Darklang.Stdlib.List.flatten_v0 [ [] ] = [] @@ -181,14 +192,16 @@ PACKAGE.Darklang.Stdlib.List.interleave_v0 [] [ 4; 5; 6 ] = [ 4; 5; 6 ] PACKAGE.Darklang.Stdlib.List.interleave_v0 [] [] = [] PACKAGE.Darklang.Stdlib.List.interleave_v0 [ "a"; "b"; "c" ] [ 0 ] = Builtin.Test.derrorMessage - "Could not merge types List and List" + "Type Conflict: Mixing data types (String and Int) in list creation. +Cannot include item of type Int(0) in a list of type String. Lists can only contain values of a single type." PACKAGE.Darklang.Stdlib.List.interpose_v0 [ 1; 2; 3 ] 5 = [ 1; 5; 2; 5; 3 ] PACKAGE.Darklang.Stdlib.List.interpose_v0 [ 1 ] 5 = [ 1 ] PACKAGE.Darklang.Stdlib.List.interpose_v0 [] 5 = [] PACKAGE.Darklang.Stdlib.List.interpose_v0 [ "a"; "b"; "c" ] 0 = Builtin.Test.derrorMessage - "Could not merge types List and List" + "Type Conflict: Mixing data types (String and Int) in list creation. +Cannot include item of type Int(0) in a list of type String. Lists can only contain values of a single type." PACKAGE.Darklang.Stdlib.List.isEmpty_v0 [ 1 ] = false @@ -410,7 +423,8 @@ PACKAGE.Darklang.Stdlib.List.uniqueBy_v0 [ 7; 42; 7; 2; 10 ] (fun x -> x) = [ 2 PACKAGE.Darklang.Stdlib.List.uniqueBy_v0 [] (fun x -> x) = [] PACKAGE.Darklang.Stdlib.List.uniqueBy_v0 [ 6; 2.0 ] (fun x -> x) = Builtin.Test.derrorMessage - "Could not merge types List and List" + "Type Conflict: Mixing data types (Int and Float) in list creation. +Cannot include item of type Float(2.0) in a list of type Int. Lists can only contain values of a single type." PACKAGE.Darklang.Stdlib.List.unique_v0 [ 1; 2; 3; 4 ] = [ 1; 2; 3; 4 ] PACKAGE.Darklang.Stdlib.List.unique_v0 [ 1; 1; 1; 1 ] = [ 1 ] diff --git a/backend/tests/TestUtils/LibTest.fs b/backend/tests/TestUtils/LibTest.fs index fc4e004e5a..ecff6711dc 100644 --- a/backend/tests/TestUtils/LibTest.fs +++ b/backend/tests/TestUtils/LibTest.fs @@ -15,7 +15,6 @@ open LibExecution.Builtin.Shortcuts module VT = ValueType module PT = LibExecution.ProgramTypes -module Dval = LibExecution.Dval module PT2RT = LibExecution.ProgramTypesToRuntimeTypes open LibCloud.Db diff --git a/backend/tests/TestUtils/TestUtils.fs b/backend/tests/TestUtils/TestUtils.fs index a03f501504..3ad04bb403 100644 --- a/backend/tests/TestUtils/TestUtils.fs +++ b/backend/tests/TestUtils/TestUtils.fs @@ -14,7 +14,6 @@ open Prelude module DarkDateTime = LibExecution.DarkDateTime module RT = LibExecution.RuntimeTypes module VT = RT.ValueType -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module AT = LibExecution.AnalysisTypes module PT2RT = LibExecution.ProgramTypesToRuntimeTypes diff --git a/backend/tests/Tests/DvalRepr.Tests.fs b/backend/tests/Tests/DvalRepr.Tests.fs index a066b5ac35..b7dc5899c2 100644 --- a/backend/tests/Tests/DvalRepr.Tests.fs +++ b/backend/tests/Tests/DvalRepr.Tests.fs @@ -9,7 +9,6 @@ open TestUtils.TestUtils module RT = LibExecution.RuntimeTypes module VT = RT.ValueType -module Dval = LibExecution.Dval module PT = LibExecution.ProgramTypes module DvalReprDeveloper = LibExecution.DvalReprDeveloper diff --git a/backend/tests/Tests/Execution.Tests.fs b/backend/tests/Tests/Execution.Tests.fs index c500f2904d..5e7d19fab7 100644 --- a/backend/tests/Tests/Execution.Tests.fs +++ b/backend/tests/Tests/Execution.Tests.fs @@ -11,8 +11,6 @@ open TestUtils.TestUtils open LibExecution.RuntimeTypes open TestUtils.RTShortcuts -module VT = ValueType -module Dval = LibExecution.Dval module Exe = LibExecution.Execution module RuntimeTypesAst = LibExecution.RuntimeTypesAst diff --git a/backend/tests/Tests/Serialization.TestValues.fs b/backend/tests/Tests/Serialization.TestValues.fs index 730133ff8b..7650fea4db 100644 --- a/backend/tests/Tests/Serialization.TestValues.fs +++ b/backend/tests/Tests/Serialization.TestValues.fs @@ -9,7 +9,6 @@ open Prelude open TestUtils.TestUtils module PT = LibExecution.ProgramTypes -module Dval = LibExecution.Dval module RT = LibExecution.RuntimeTypes module BinarySerialization = LibBinarySerialization.BinarySerialization diff --git a/packages/darklang/languageTools/runtimeErrors/cli.dark b/packages/darklang/languageTools/runtimeErrors/cli.dark index f36fd34c61..9896c5321d 100644 --- a/packages/darklang/languageTools/runtimeErrors/cli.dark +++ b/packages/darklang/languageTools/runtimeErrors/cli.dark @@ -6,5 +6,4 @@ module Darklang = | MultipleExpressionsToExecute | NoExpressionsToExecute | UncaughtException of String * List - | NonIntReturned of - actuallyReturned: PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval \ No newline at end of file + | NonIntReturned of actuallyReturned: RuntimeTypes.Dval.Dval \ No newline at end of file diff --git a/packages/darklang/languageTools/runtimeErrors/dvalCreation.dark b/packages/darklang/languageTools/runtimeErrors/dvalCreation.dark new file mode 100644 index 0000000000..e39bfa0ba0 --- /dev/null +++ b/packages/darklang/languageTools/runtimeErrors/dvalCreation.dark @@ -0,0 +1,123 @@ +module Darklang = + module LanguageTools = + module RuntimeErrors = + module DvalCreation = + + // + type Option = PACKAGE.Darklang.Stdlib.Option.Option + type ID = PACKAGE.Darklang.LanguageTools.ID + type TLID = PACKAGE.Darklang.LanguageTools.TLID + + // language + type RTTypeReference = + PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeReference + + type RTDval = PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval + type RTValueType = PACKAGE.Darklang.LanguageTools.RuntimeTypes.ValueType + + type RTTypeName = + PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeName.TypeName + + // RuntimeErrors + type REErrorOutput = PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorOutput + + type ES = + PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorSegment.ErrorSegment + // + + // type Context = + // | UserCode // (they wrote it) + // | SqlCompiler + // | Expr of TLID * ID + // | BuiltinFnResult of fnName: String + + type Error = + | ListAppend of vt: RTValueType * item: RTDval * vtOfDv: RTValueType + + | RecordMissingField of + typeName: RTTypeName * + fieldName: String * + typ: RTTypeReference + + | RecordDuplicateField of typeName: RTTypeName * fieldName: String + + | Option of vt: RTValueType * item: RTDval * vtOfDv: RTValueType + + | ResultOk of + okVt: RTValueType * + errVt: RTValueType * + okDv: RTDval * + vtOfDv: RTValueType + + | ResultError of + okVt: RTValueType * + errVt: RTValueType * + errDv: RTDval * + vtOfDv: RTValueType + + let toSegments (e: Error) : REErrorOutput = + match e with + | ListAppend(vt, item, vtOfDv) -> + ErrorOutput + { summary = + [ ES.String "Type Conflict: Mixing data types (" + ES.ValueType vt + ES.String " and " + ES.ValueType vtOfDv + ES.String ") in list creation." ] + extraExplanation = + [ ES.String "\nCannot include item of type " + ES.ValueType vtOfDv + ES.String "(" + ES.InlineValue item + ES.String ") in a list of type " + ES.ValueType vt + ES.String ". Lists can only contain values of a single type." ] + actual = [] + expected = [] } + + | RecordMissingField(typeName, fieldName, typ) -> + ErrorOutput + { summary = + [ ES.String "Missing field in record"; ES.TypeName typeName ] + extraExplanation = + [ ES.String "\n" + ES.TypeName typeName + ES.String $"definition includes field {fieldName} of type " + ES.TypeReference typ + ES.String ", but no such field was provided" ] + actual = [] + expected = [] } + + | RecordDuplicateField(typeName, fieldName) -> + ErrorOutput + { summary = + [ ES.String "Duplicate field in record"; ES.TypeName typeName ] + extraExplanation = + [ ES.String "\n" + ES.TypeName typeName + ES.String + $"value declaration includes field {fieldName} more than once" ] + actual = [] + expected = [] } + + | Option(vt, item, vtOfDv) -> + ErrorOutput + { summary = [ ES.String "Failed to create Option of expected type" ] + extraExplanation = [] + actual = [ ES.Dval item; ES.ValueType vtOfDv ] + expected = [ ES.ValueType vt ] } + + | ResultOk(okVt, errVt, okDv, vtOfDv) -> + ErrorOutput + { summary = [ ES.String "Failed to create Result of expected type" ] + extraExplanation = [] + actual = [ ES.Dval okDv; ES.ValueType vtOfDv ] + expected = [ ES.ValueType okVt; ES.ValueType errVt ] } + + | ResultError(okVt, errVt, errDv, vtOfDv) -> + ErrorOutput + { summary = [ ES.String "Failed to create Result of expected type" ] + extraExplanation = [] + actual = [ ES.Dval errDv; ES.ValueType vtOfDv ] + expected = [ ES.ValueType okVt; ES.ValueType errVt ] } \ No newline at end of file diff --git a/packages/darklang/languageTools/runtimeErrors/execution.dark b/packages/darklang/languageTools/runtimeErrors/execution.dark index 1c7481d192..41f047dedf 100644 --- a/packages/darklang/languageTools/runtimeErrors/execution.dark +++ b/packages/darklang/languageTools/runtimeErrors/execution.dark @@ -2,6 +2,11 @@ module Darklang = module LanguageTools = module RuntimeErrors = module Execution = + // + type ES = + PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorSegment.ErrorSegment + // + type Error = | MatchExprUnmatched of RuntimeTypes.Dval.Dval | MatchExprPatternWrongType of String * RuntimeTypes.Dval.Dval @@ -12,9 +17,7 @@ module Darklang = let toSegments (e: Error) : ErrorOutput = match e with | MatchExprUnmatched dv -> - let summary = - [ ErrorSegment.ErrorSegment.String "No match for " - ErrorSegment.ErrorSegment.InlineValue dv ] + let summary = [ ES.String "No match for "; ES.InlineValue dv ] // TODO include patterns in error message let extraExplanation = [] @@ -28,21 +31,13 @@ module Darklang = | MatchExprEnumPatternWrongCount(caseName, expected, actual) -> let summary = - [ ErrorSegment.ErrorSegment.String caseName - ErrorSegment.ErrorSegment.String " pattern is expecting " - ErrorSegment.ErrorSegment.Count( - expected, - ErrorSegment.ErrorSegment.String "field", - ErrorSegment.ErrorSegment.String "fields" - ) - ErrorSegment.ErrorSegment.String ", but " - ErrorSegment.ErrorSegment.String caseName - ErrorSegment.ErrorSegment.String " has " - ErrorSegment.ErrorSegment.Count( - actual, - ErrorSegment.ErrorSegment.String "field", - ErrorSegment.ErrorSegment.String "fields" - ) ] + [ ES.String caseName + ES.String " pattern is expecting " + ES.Count(expected, ES.String "field", ES.String "fields") + ES.String ", but " + ES.String caseName + ES.String " has " + ES.Count(actual, ES.String "field", ES.String "fields") ] let extraExplanation = [] @@ -56,14 +51,14 @@ module Darklang = | MatchExprPatternWrongType(patternType, dv) -> let summary = // "Cannot match Int value 6 with a Float pattern" - [ ErrorSegment.ErrorSegment.String "Cannot match " - ErrorSegment.ErrorSegment.TypeOfValue dv - ErrorSegment.ErrorSegment.String " value " - ErrorSegment.ErrorSegment.InlineValue dv - ErrorSegment.ErrorSegment.String " with " - ErrorSegment.ErrorSegment.IndefiniteArticle - ErrorSegment.ErrorSegment.String patternType - ErrorSegment.ErrorSegment.String " pattern" ] + [ ES.String "Cannot match " + ES.TypeOfValue dv + ES.String " value " + ES.InlineValue dv + ES.String " with " + ES.IndefiniteArticle + ES.String patternType + ES.String " pattern" ] let extraExplanation = [] @@ -76,9 +71,8 @@ module Darklang = // Expected String in string interpolation, got 1.0 | NonStringInStringInterpolation dv -> let summary = - [ ErrorSegment.ErrorSegment.String - "Expected String in string interpolation, got " - ErrorSegment.ErrorSegment.InlineValue dv ] + [ ES.String "Expected String in string interpolation, got " + ES.InlineValue dv ] let extraExplanation = [] @@ -90,9 +84,9 @@ module Darklang = | ConstDoesntExist name -> let summary = - [ ErrorSegment.ErrorSegment.String "Constant " - ErrorSegment.ErrorSegment.ConstantName name - ErrorSegment.ErrorSegment.String " doesn't exist" ] + [ ES.String "Constant " + ES.ConstantName name + ES.String " doesn't exist" ] let extraExplanation = [] diff --git a/packages/darklang/languageTools/runtimeErrors/json.dark b/packages/darklang/languageTools/runtimeErrors/json.dark index df2bbe1b3f..0c5d77378c 100644 --- a/packages/darklang/languageTools/runtimeErrors/json.dark +++ b/packages/darklang/languageTools/runtimeErrors/json.dark @@ -2,14 +2,18 @@ module Darklang = module LanguageTools = module RuntimeErrors = module Json = + // + type ES = + PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorSegment.ErrorSegment + // + type Error = UnsupportedType of RuntimeTypes.TypeReference let toSegments (e: Error) : ErrorOutput = match e with | UnsupportedType typ -> let summary = - [ ErrorSegment.ErrorSegment.String "Unsupported type in JSON: " - ErrorSegment.ErrorSegment.TypeReference typ ] + [ ES.String "Unsupported type in JSON: "; ES.TypeReference typ ] let extraExplanation = let parse = @@ -29,16 +33,14 @@ module Darklang = ) - [ ErrorSegment.ErrorSegment.String + [ ES.String ". Some types are not supported in Json serialization, and cannot be used as arguments to " - ErrorSegment.ErrorSegment.FunctionName parse - ErrorSegment.ErrorSegment.String " or " - ErrorSegment.ErrorSegment.FunctionName serialize ] + ES.FunctionName parse + ES.String " or " + ES.FunctionName serialize ] ErrorOutput { summary = summary extraExplanation = extraExplanation - actual = [ ErrorSegment.ErrorSegment.TypeReference typ ] - expected = - [ ErrorSegment.ErrorSegment.String - "A supported type (Int, String, etc)" ] } \ No newline at end of file + actual = [ ES.TypeReference typ ] + expected = [ ES.String "A supported type (Int, String, etc)" ] } \ No newline at end of file diff --git a/packages/darklang/languageTools/runtimeErrors/nameResolution.dark b/packages/darklang/languageTools/runtimeErrors/nameResolution.dark index d0cee54e68..5f6e33f1a6 100644 --- a/packages/darklang/languageTools/runtimeErrors/nameResolution.dark +++ b/packages/darklang/languageTools/runtimeErrors/nameResolution.dark @@ -2,6 +2,11 @@ module Darklang = module LanguageTools = module RuntimeErrors = module NameResolution = + // + type ES = + PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorSegment.ErrorSegment + // + type ErrorType = | NotFound | ExpectedEnumButNot @@ -36,10 +41,8 @@ module Darklang = ErrorOutput { summary = - [ ErrorSegment.ErrorSegment.String $"There is no {nameType} named " - ErrorSegment.ErrorSegment.InlineVarName( - PACKAGE.Darklang.Stdlib.String.join e.names "." - ) ] + [ ES.String $"There is no {nameType} named " + ES.InlineVarName(Stdlib.String.join e.names ".") ] extraExplanation = [] actual = [] expected = [] } @@ -47,12 +50,12 @@ module Darklang = | MissingEnumModuleName caseName -> let name = let names = Builtin.List.append e.names [ caseName ] - ErrorSegment.ErrorSegment.VarName(Builtin.String.join names ".") + ES.VarName(Builtin.String.join names ".") let summary = - [ ErrorSegment.ErrorSegment.String "Missing type name for enum case" - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.String caseName ] + [ ES.String "Missing type name for enum case" + ES.String ": " + ES.String caseName ] ErrorOutput { summary = summary @@ -62,10 +65,8 @@ module Darklang = | InvalidPackageName -> let summary = - [ ErrorSegment.ErrorSegment.String "Invalid package name " - ErrorSegment.ErrorSegment.InlineVarName( - PACKAGE.Darklang.Stdlib.String.join e.names "." - ) ] + [ ES.String "Invalid package name " + ES.InlineVarName(Stdlib.String.join e.names ".") ] ErrorOutput { summary = summary @@ -75,11 +76,9 @@ module Darklang = | ExpectedRecordButNot -> let summary = - [ ErrorSegment.ErrorSegment.String "Expected a record but " - ErrorSegment.ErrorSegment.InlineVarName( - PACKAGE.Darklang.Stdlib.String.join e.names "." - ) - ErrorSegment.ErrorSegment.String " is an enum" ] + [ ES.String "Expected a record but " + ES.InlineVarName(Stdlib.String.join e.names ".") + ES.String " is an enum" ] ErrorOutput { summary = summary @@ -91,9 +90,7 @@ module Darklang = // RTETODO: // | ExpectedEnumButNot ErrorOutput - { summary = - [ ErrorSegment.ErrorSegment.String - "RTETODO NameResolution.toSegments" ] + { summary = [ ES.String "RTETODO NameResolution.toSegments" ] extraExplanation = [] actual = [] expected = [] } \ No newline at end of file diff --git a/packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark b/packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark index 25a9d8e946..d6c6d7a268 100644 --- a/packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark +++ b/packages/darklang/languageTools/runtimeErrors/runtimeErrors.dark @@ -42,6 +42,7 @@ module Darklang = | InlineVarName of String // -- Dvals + | ValueType of PACKAGE.Darklang.LanguageTools.RuntimeTypes.ValueType | InlineValue of PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval // possibly shortened to be shown inline | FullValue of PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval @@ -103,6 +104,8 @@ module Darklang = |> PACKAGE.Darklang.Stdlib.String.join "" | FullValue dv -> PACKAGE.Darklang.PrettyPrinter.RuntimeTypes.dval dv + | ValueType vt -> + PACKAGE.Darklang.PrettyPrinter.RuntimeTypes.valueType vt | segment -> $"(RTETODO toString parts {(Builtin.Json.serialize segment)})" @@ -123,18 +126,28 @@ module Darklang = // maybe as cases of that (e.g. TypeCheckerError, NameResolutionError) type Error = - | CliError of PACKAGE.Darklang.LanguageTools.RuntimeErrors.Cli.Error - | TypeCheckerError of - PACKAGE.Darklang.LanguageTools.RuntimeErrors.TypeChecker.Error - | NameResolutionError of - PACKAGE.Darklang.LanguageTools.RuntimeErrors.NameResolution.Error + | TypeCheckerError of RuntimeErrors.TypeChecker.Error + + | DvalCreationError of RuntimeErrors.DvalCreation.Error + + /// Errors specific to resolving names + | NameResolutionError of RuntimeErrors.NameResolution.Error + + /// Errors specific to the SqlCompiler (used to compile DB.query lambdas) | SqlCompilerRuntimeError of Error - | ExecutionError of - PACKAGE.Darklang.LanguageTools.RuntimeErrors.Execution.Error - | JsonError of PACKAGE.Darklang.LanguageTools.RuntimeErrors.Json.Error + + /// Errors that happen somewhere in the Darklang interpreter + | ExecutionError of RuntimeErrors.Execution.Error + + /// Json.parse<'a> or Json.serialize<'a> failed in a surprising way + | JsonError of RuntimeErrors.Json.Error + + /// Errors specific to running darklang-cli (or LocalExec, for internal use) + | CliError of RuntimeErrors.Cli.Error | OldStringErrorTODO of String + let sqlErrorTemplate = "You're using our new experimental Datastore query compiler. It compiles your lambdas into optimized (and partially indexed) Datastore queries, which should be reasonably fast.\n\nUnfortunately, we hit a snag while compiling your lambda. We only support a subset of Darklang's functionality, but will be expanding it in the future.\n\nSome Darklang code is not supported in DB::query lambdas for now, and some of it won't be supported because it's an odd thing to do in a datastore query. If you think your operation should be supported, let us know in #general in Discord.\n\n Error: " @@ -154,9 +167,8 @@ module Darklang = // | CliError err -> Cli.Error.toSegments err | TypeCheckerError err -> TypeChecker.Error.toSegments err - + | DvalCreationError err -> DvalCreation.toSegments err | NameResolutionError err -> NameResolution.toSegments err - | ExecutionError err -> Execution.toSegments err | SqlCompilerRuntimeError err -> diff --git a/packages/darklang/languageTools/runtimeErrors/typeChecker.dark b/packages/darklang/languageTools/runtimeErrors/typeChecker.dark index 2d45d17610..6a815b7315 100644 --- a/packages/darklang/languageTools/runtimeErrors/typeChecker.dark +++ b/packages/darklang/languageTools/runtimeErrors/typeChecker.dark @@ -1,29 +1,31 @@ module Darklang = module LanguageTools = module RuntimeErrors = - // - type Option = PACKAGE.Darklang.Stdlib.Option.Option - type ID = PACKAGE.Darklang.LanguageTools.ID - type TLID = PACKAGE.Darklang.LanguageTools.TLID + // CLEANUP consider renaming this module to RuntimeTypeChecker + module TypeChecker = - // language - type RTTypeReference = - PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeReference + // + type Option = PACKAGE.Darklang.Stdlib.Option.Option + type ID = PACKAGE.Darklang.LanguageTools.ID + type TLID = PACKAGE.Darklang.LanguageTools.TLID - type RTDval = PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval + // language + type RTTypeReference = + PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeReference - type RTTypeName = PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeName.TypeName + type RTDval = PACKAGE.Darklang.LanguageTools.RuntimeTypes.Dval.Dval + type RTTypeName = PACKAGE.Darklang.LanguageTools.RuntimeTypes.TypeName.TypeName - type RTFnName = PACKAGE.Darklang.LanguageTools.RuntimeTypes.FnName.FnName - type RTParam = PACKAGE.Darklang.LanguageTools.RuntimeTypes.Param + type RTFnName = PACKAGE.Darklang.LanguageTools.RuntimeTypes.FnName.FnName + type RTParam = PACKAGE.Darklang.LanguageTools.RuntimeTypes.Param - // RuntimeErrors - type REErrorOutput = PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorOutput - // + // RuntimeErrors + type REErrorOutput = PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorOutput + type ES = + PACKAGE.Darklang.LanguageTools.RuntimeErrors.ErrorSegment.ErrorSegment + // - // CLEANUP consider renaming this module to RuntimeTypeChecker - module TypeChecker = type Location = Option type Context = @@ -44,8 +46,6 @@ module Darklang = fieldType: RTTypeReference * location: Location - | DictKey of key: String * typ: (RTTypeReference * Location) - | EnumField of enumTypeName: RTTypeName * caseName: String * @@ -64,14 +64,9 @@ module Darklang = expectedType: RTTypeReference * location: Location - | ListIndex of index: Int * listTyp: RTTypeReference * parent: Context - - | TupleIndex of index: Int * elementType: RTTypeReference * parent: Context - | FnValResult of returnType: RTTypeReference * location: Location - type Error = | ValueNotExpectedType of actualValue: RTDval * @@ -86,12 +81,9 @@ module Darklang = // | TCK.FunctionCallParameter(_, parameter, _, _) -> parameter.name // | TCK.FunctionCallResult(_, _, _) -> "result" // | TCK.RecordField(_, fieldName, _, _) -> fieldName - // | TCK.DictKey(key, _, _) -> $".{key}" // | TCK.EnumField(_, caseName, _, _, _, _) -> caseName // | TCK.DBSchemaType(dbName, _, _) -> dbName // | TCK.DBQueryVariable(varName, _, _) -> varName - // | TCK.ListIndex(index, _, parent) -> valuePath parent + $"[{index}]" - // | TCK.TupleIndex(index, _, parent) -> valuePath parent + $"[{index}]" "RTETODO: valuePath" let rootContext (context: Context) : Context = @@ -99,100 +91,71 @@ module Darklang = | FunctionCallParameter _ -> context | FunctionCallResult _ -> context | RecordField _ -> context - | DictKey _ -> context | EnumField _ -> context | DBSchemaType _ -> context | DBQueryVariable _ -> context - | ListIndex(_, _, parent) -> rootContext parent - | TupleIndex(_, _, parent) -> rootContext parent | FnValResult(_, _) -> context /// Return the segments describing the context as a short name, used in the description of errors - let contextSummary (context: Context) : List = + let contextSummary (context: Context) : List = match context with | FunctionCallParameter(fnName, parameter, paramIndex, _) -> - [ ErrorSegment.ErrorSegment.FunctionName fnName - ErrorSegment.ErrorSegment.String "'s " - ErrorSegment.ErrorSegment.Ordinal(paramIndex + 1) - ErrorSegment.ErrorSegment.String " argument (" - ErrorSegment.ErrorSegment.ParamName parameter.name - ErrorSegment.ErrorSegment.String ")" ] + [ ES.FunctionName fnName + ES.String "'s " + ES.Ordinal(paramIndex + 1) + ES.String " argument (" + ES.ParamName parameter.name + ES.String ")" ] | FunctionCallResult(fnName, returnType, _) -> - [ ErrorSegment.ErrorSegment.FunctionName fnName - ErrorSegment.ErrorSegment.String "'s return value" ] - - + [ ES.FunctionName fnName; ES.String "'s return value" ] | RecordField(recordType, fieldName, _, _) -> - [ ErrorSegment.ErrorSegment.TypeName recordType - ErrorSegment.ErrorSegment.String "'s " - ErrorSegment.ErrorSegment.FieldName fieldName - ErrorSegment.ErrorSegment.String " field" ] - - // | DictKey(key, _, _) -> - // let typeName = - // FQName.BuiltIn { name = TypeName.TypeName "Dict"; modules = []; version = 0 } - // [ TypeName typeName; String "'s "; FieldName key; String " value" ] + [ ES.TypeName recordType + ES.String "'s " + ES.FieldName fieldName + ES.String " field" ] | EnumField(enumType, caseName, fieldIndex, _, _, _) -> - [ ErrorSegment.ErrorSegment.TypeName enumType - ErrorSegment.ErrorSegment.String "." - ErrorSegment.ErrorSegment.InlineFieldName caseName - ErrorSegment.ErrorSegment.String "'s " - ErrorSegment.ErrorSegment.Ordinal(fieldIndex + 1) - ErrorSegment.ErrorSegment.String " argument" ] + [ ES.TypeName enumType + ES.String "." + ES.InlineFieldName caseName + ES.String "'s " + ES.Ordinal(fieldIndex + 1) + ES.String " argument" ] | DBSchemaType(dbName, expectedType, _) -> - [ ErrorSegment.ErrorSegment.String "DB " - ErrorSegment.ErrorSegment.DBName dbName - ErrorSegment.ErrorSegment.String "'s value" ] + [ ES.String "DB "; ES.DBName dbName; ES.String "'s value" ] | DBQueryVariable(varName, _, _) -> - [ ErrorSegment.ErrorSegment.String "Variable " - ErrorSegment.ErrorSegment.VarName varName ] - - | TupleIndex(index, typ, parent) -> - let rootContext = rootContext parent - - [ String "In " ] - @ contextSummary rootContext - @ [ String ", the nested value "; VarName(valuePath context) ] - - | ListIndex(index, typ, parent) -> - let rootContext = rootContext parent - - [ String "In " ] - @ contextSummary rootContext - @ [ String ", the nested value "; VarName(valuePath context) ] + [ ES.String "Variable "; ES.VarName varName ] - | FnValResult(_, _) -> - [ ErrorSegment.ErrorSegment.String "Function return value" ] + | FnValResult(_, _) -> [ ES.String "Function return value" ] let rec contextAsActualExpected (argument: RuntimeTypes.Dval.Dval) (context: Context) - : List * List = + : List * List = // RTETODO: We do actual and expected in the same function so that we can display // them the same way. This hasn't been ported for all Context types, but // should be. let defaultActual = - [ ErrorSegment.ErrorSegment.IndefiniteArticle - ErrorSegment.ErrorSegment.TypeOfValue argument - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.FullValue argument ] + [ ES.IndefiniteArticle + ES.TypeOfValue argument + ES.String ": " + ES.FullValue argument ] match context with | FunctionCallParameter(fnName, parameter, paramIndex, _) -> let segments = - [ ErrorSegment.ErrorSegment.String "(" - ErrorSegment.ErrorSegment.InlineParamName parameter.name - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.TypeReference parameter.typ - ErrorSegment.ErrorSegment.String ")" ] + [ ES.String "(" + ES.InlineParamName parameter.name + ES.String ": " + ES.TypeReference parameter.typ + ES.String ")" ] (defaultActual, segments) @@ -200,7 +163,7 @@ module Darklang = | FunctionCallResult(fnName, returnType, _) -> // format: // Option - let segment = [ ErrorSegment.ErrorSegment.TypeReference returnType ] + let segment = [ ES.TypeReference returnType ] (defaultActual, segment) @@ -218,81 +181,53 @@ module Darklang = let segment = PACKAGE.Darklang.Stdlib.List.append - [ ErrorSegment.ErrorSegment.String "({ " - ErrorSegment.ErrorSegment.InlineFieldName fieldName - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.TypeReference fieldType - ErrorSegment.ErrorSegment.String "; ... })" ] + [ ES.String "({ " + ES.InlineFieldName fieldName + ES.String ": " + ES.TypeReference fieldType + ES.String "; ... })" ] comment (defaultActual, segment) - | DictKey(key, typ, _) -> - // format: - // ({ "name" : String; ... }) - let segment = - [ ErrorSegment.ErrorSegment.String "({ " - ErrorSegment.ErrorSegment.InlineFieldName key - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.TypeReference typ - ErrorSegment.ErrorSegment.String "; ... })" ] - - defaultActual, segment - - - | EnumField(enumType, caseName, fieldIndex, fieldCount, fieldType, _) -> // format: // Ok (..., string, ...) // some description // RTETODO: extract description from the type definition later - let prefix = - if fieldIndex == 0 then - [] - else - [ ErrorSegment.ErrorSegment.String "..., " ] + let prefix = if fieldIndex == 0 then [] else [ ES.String "..., " ] let suffix = if fieldIndex == fieldCount - 1 then [] else - [ ErrorSegment.ErrorSegment.String ", ..." ] + [ ES.String ", ..." ] - let openParen = - if fieldCount > 0 then - [ ErrorSegment.ErrorSegment.String "(" ] - else - [] + let openParen = if fieldCount > 0 then [ ES.String "(" ] else [] - let closeParen = - if fieldCount > 0 then - [ ErrorSegment.ErrorSegment.String ")" ] - else - [] + let closeParen = if fieldCount > 0 then [ ES.String ")" ] else [] //CLEANUP de-duplicate these 2 segments a bit let fieldTypeSegment = - [ ErrorSegment.ErrorSegment.ShortTypeName enumType - ErrorSegment.ErrorSegment.String "." - ErrorSegment.ErrorSegment.InlineFieldName caseName - ErrorSegment.ErrorSegment.String " " ] + [ ES.ShortTypeName enumType + ES.String "." + ES.InlineFieldName caseName + ES.String " " ] |> PACKAGE.Darklang.Stdlib.List.append openParen |> PACKAGE.Darklang.Stdlib.List.append prefix - |> PACKAGE.Darklang.Stdlib.List.append - [ ErrorSegment.ErrorSegment.TypeReference fieldType ] + |> PACKAGE.Darklang.Stdlib.List.append [ ES.TypeReference fieldType ] |> PACKAGE.Darklang.Stdlib.List.append suffix |> PACKAGE.Darklang.Stdlib.List.append closeParen let argumentSegment = - [ ErrorSegment.ErrorSegment.ShortTypeName enumType - ErrorSegment.ErrorSegment.String "." - ErrorSegment.ErrorSegment.InlineFieldName caseName - ErrorSegment.ErrorSegment.String " " ] + [ ES.ShortTypeName enumType + ES.String "." + ES.InlineFieldName caseName + ES.String " " ] |> PACKAGE.Darklang.Stdlib.List.append openParen |> PACKAGE.Darklang.Stdlib.List.append prefix - |> PACKAGE.Darklang.Stdlib.List.append - [ ErrorSegment.ErrorSegment.TypeOfValue argument ] + |> PACKAGE.Darklang.Stdlib.List.append [ ES.TypeOfValue argument ] |> PACKAGE.Darklang.Stdlib.List.append suffix |> PACKAGE.Darklang.Stdlib.List.append closeParen @@ -300,28 +235,22 @@ module Darklang = | DBSchemaType(dbName, expectedType, _) -> - let segment = [ ErrorSegment.ErrorSegment.TypeReference expectedType ] + let segment = [ ES.TypeReference expectedType ] (defaultActual, segment) | DBQueryVariable(varName, expected, _) -> let segment = - [ ErrorSegment.ErrorSegment.String "(" - ErrorSegment.ErrorSegment.InlineVarName varName - ErrorSegment.ErrorSegment.String ": " - ErrorSegment.ErrorSegment.TypeReference expected - ErrorSegment.ErrorSegment.String ")" ] + [ ES.String "(" + ES.InlineVarName varName + ES.String ": " + ES.TypeReference expected + ES.String ")" ] (defaultActual, segment) - | ListIndex(index, typ, parent) -> - defaultActual, [ ErrorSegment.ErrorSegment.TypeReference typ ] - - | TupleIndex(index, typ, parent) -> - defaultActual, [ ErrorSegment.ErrorSegment.TypeReference typ ] - | FnValResult(returnType, _) -> - defaultActual, [ ErrorSegment.ErrorSegment.TypeReference returnType ] + defaultActual, [ ES.TypeReference returnType ] let contextVerb (context: Context) : String = @@ -329,33 +258,38 @@ module Darklang = | FunctionCallParameter _ -> "passed" | FunctionCallResult _ -> "returned" | RecordField _ -> "passed" - | DictKey _ -> "passed" | EnumField _ -> "passed" | DBSchemaType _ -> "passed" | DBQueryVariable _ -> "passed" - | ListIndex _ -> "passed" - | TupleIndex _ -> "passed" | FnValResult _ -> "returned" let toSegments (e: Error) : REErrorOutput = match e with + | TypeDoesntExist(typeName, context) -> + ErrorOutput + { summary = + [ ES.String "Couldn't find type"; ES.TypeReference typeName ] + extraExplanation = [] + actual = [] + expected = [] } + | ValueNotExpectedType(argument, expected, context) -> let summary = PACKAGE.Darklang.Stdlib.List.append (contextSummary context) - [ ErrorSegment.ErrorSegment.String " should be " - ErrorSegment.ErrorSegment.IndefiniteArticle - ErrorSegment.ErrorSegment.TypeReference expected ] + [ ES.String " should be " + ES.IndefiniteArticle + ES.TypeReference expected ] let extraExplanation = - [ ErrorSegment.ErrorSegment.String ". However, " - ErrorSegment.ErrorSegment.IndefiniteArticle - ErrorSegment.ErrorSegment.TypeOfValue argument - ErrorSegment.ErrorSegment.String " (" - ErrorSegment.ErrorSegment.InlineValue argument - ErrorSegment.ErrorSegment.String ") was " - ErrorSegment.ErrorSegment.String(contextVerb context) - ErrorSegment.ErrorSegment.String " instead." ] + [ ES.String ". However, " + ES.IndefiniteArticle + ES.TypeOfValue argument + ES.String " (" + ES.InlineValue argument + ES.String ") was " + ES.String(contextVerb context) + ES.String " instead." ] let (actual, expected) = contextAsActualExpected argument context @@ -363,13 +297,4 @@ module Darklang = { summary = summary extraExplanation = extraExplanation actual = actual - expected = expected } - - | _ -> - ErrorOutput - { summary = - [ ErrorSegment.ErrorSegment.String - "RTETODO typeChecker.toSegments" ] - extraExplanation = [] - actual = [] - expected = [] } \ No newline at end of file + expected = expected } \ No newline at end of file diff --git a/packages/darklang/stdlib/list.dark b/packages/darklang/stdlib/list.dark index bc676dade7..8f80fad5d5 100644 --- a/packages/darklang/stdlib/list.dark +++ b/packages/darklang/stdlib/list.dark @@ -141,25 +141,21 @@ module Darklang = match list with | [] -> [] | [ single ] -> [ single ] - | head :: tail -> - (PACKAGE.Darklang.Stdlib.List.interpose tail sep) - |> PACKAGE.Darklang.Stdlib.List.push_v0 sep - |> PACKAGE.Darklang.Stdlib.List.push_v0 head + | head :: tail -> List.append [ head; sep ] (List.interpose tail sep) - /// Returns a list with the first value from then the first value - /// from , then the second value from then the second value - /// other list. + /// Returns a list with + /// the first value from , then + /// the first value from , then + /// the second value from , then + /// the second value ofrom , etc. let interleave (l1: List<'a>) (l2: List<'a>) : List<'a> = match l1 with - | [] -> l2 | aHead :: aTail -> match l2 with + | bHead :: bTail -> List.append [ aHead; bHead ] (interleave aTail bTail) | [] -> l1 - | bHead :: bTail -> - (PACKAGE.Darklang.Stdlib.List.interleave aTail bTail) - |> PACKAGE.Darklang.Stdlib.List.push_v0 bHead - |> PACKAGE.Darklang.Stdlib.List.push_v0 aHead + | [] -> l2 /// Returns the passed list, with only unique values, where uniqueness is based