diff --git a/backend/src/Builtins/Builtins.CliHost/Libs/Cli.fs b/backend/src/Builtins/Builtins.CliHost/Libs/Cli.fs index 1032b49b1d..7d48298008 100644 --- a/backend/src/Builtins/Builtins.CliHost/Libs/Cli.fs +++ b/backend/src/Builtins/Builtins.CliHost/Libs/Cli.fs @@ -33,7 +33,9 @@ module WT2PT = LibParser.WrittenTypesToProgramTypes module WTSourceFile = LibParser.SourceFile module Validation = LibParser.Validation module NRslv = LibParser.NameResolver -module Hashing = LibSerialization.Hashing.Hashing +module HashStabilization = LibDB.HashStabilization +module AstTransformer = LibDB.AstTransformer +module PackageLocation = LibDB.PackageLocation /// Load all DBs from the global toplevel set. @@ -166,28 +168,29 @@ let private declarationsToModule (WT2PT.PackageValue.Name.toModules v.name) v) - // WT2PT gives each declaration an empty `Hash ""` placeholder. The graft - // below keys declarations by hash, so without real content hashes a script's - // types, values, or fns can collapse to one entry and only the last one - // survives. - // - // Use the same `Hashing.compute*Hash` helpers package playback uses for - // `Hash ""` declarations. SCC-aware hash stabilization is not needed here - // because pass-1 bodies do not contain resolved sibling references. - let hashType (t : PT.PackageType.PackageType) = - { t with hash = Hashing.computeTypeHash Hashing.Normal t } - let hashValue (v : PT.PackageValue.PackageValue) = - { v with hash = Hashing.computeValueHash Hashing.Normal v } - let hashFn (f : PT.PackageFn.PackageFn) = - { f with hash = Hashing.computeFnHash Hashing.Normal f } + // WT2PT leaves each declaration with an empty `Hash ""`, and the graft below + // keys declarations by hash, so each needs a distinct one before it can be + // grafted. Use a location placeholder, not a content hash: a hash taken + // before resolution is computed over unresolved references, which serialise + // without their names, so two declarations differing only in which sibling + // they mention would hash the same and the graft would keep one of them. + let stampFn (f : PT.PackageFn.PackageFn) loc = + { f with hash = PackageLocation.placeholderHash loc } + let stampType (t : PT.PackageType.PackageType) loc = + { t with hash = PackageLocation.placeholderHash loc } + let stampValue (v : PT.PackageValue.PackageValue) loc = + { v with hash = PackageLocation.placeholderHash loc } // Pass 1: lower against the base pm (intra-script refs unresolved, allowed). // The resolver looks up packages on `state.branchId` (threaded through WT2PT), // so WIP on this branch resolves without wrapping the pm. let pm0 = LibDB.PackageManager.pt - let! fns1 = lowerFns pm0 |> Ply.map (List.map hashFn) - let! types1 = lowerTypes pm0 |> Ply.map (List.map hashType) - let! values1 = lowerValues pm0 |> Ply.map (List.map hashValue) + let! fns1 = + lowerFns pm0 |> Ply.map (fun fns -> List.map2 stampFn fns fnLocations) + let! types1 = + lowerTypes pm0 |> Ply.map (fun ts -> List.map2 stampType ts typeLocations) + let! values1 = + lowerValues pm0 |> Ply.map (fun vs -> List.map2 stampValue vs valueLocations) // Graft the script's own declarations into the pm, keyed by location. let pm1 = @@ -198,33 +201,75 @@ let private declarationsToModule (List.zip fns1 fnLocations) // Pass 2: re-lower with the grafted pm so intra-script references resolve. - // Keep each declaration's pass-1 hash, because pass-2 bodies contain refs to - // those hashes. Re-hashing the resolved bodies would make registered hashes - // disagree with refs embedded in callers. - let! fns = lowerFns pm1 + let! fns2 = + lowerFns pm1 |> Ply.map (fun fns -> List.map2 stampFn fns fnLocations) + let! types2 = + lowerTypes pm1 |> Ply.map (fun ts -> List.map2 stampType ts typeLocations) + let! values2 = + lowerValues pm1 |> Ply.map (fun vs -> List.map2 stampValue vs valueLocations) + + // References are resolved now, so hash for real. That keeps script + // declarations content-addressed: one structurally identical to a package + // declaration lands on the same hash, and a rename changes nothing. + // + // Pass-2 bodies still reference siblings by placeholder, so the hashes have + // to be computed in dependency order with each sibling's real hash + // substituted in. Stabilization does exactly that, batching SCCs, so + // mutually recursive script declarations work too. + let stabilization = + HashStabilization.stabilize + AstTransformer.emptyMapping + { types = + List.map2 + (fun (t : PT.PackageType.PackageType) loc -> + PackageLocation.toFQN loc, (t, t.hash, loc)) + types2 + typeLocations + |> Map.ofList + fns = + List.map2 + (fun (f : PT.PackageFn.PackageFn) loc -> + PackageLocation.toFQN loc, (f, f.hash, loc)) + fns2 + fnLocations + |> Map.ofList + values = + List.map2 + (fun (v : PT.PackageValue.PackageValue) loc -> + PackageLocation.toFQN loc, (v, v.hash, loc)) + values2 + valueLocations + |> Map.ofList } + + let finalHash (current : PT.Hash) (loc : PT.PackageLocation) : PT.Hash = + Map.tryFind (PackageLocation.toFQN loc) stabilization.fqnHashes + |> Option.defaultValue current + + // Rewrite each body so its sibling references point at the final hashes. let fns = List.map2 - (fun (f1 : PT.PackageFn.PackageFn) (f2 : PT.PackageFn.PackageFn) -> - { f2 with hash = f1.hash }) - fns1 - fns - let! types = lowerTypes pm1 + (fun (f : PT.PackageFn.PackageFn) loc -> + { AstTransformer.transformFn stabilization.mapping f with + hash = finalHash f.hash loc }) + fns2 + fnLocations let types = List.map2 - (fun (t1 : PT.PackageType.PackageType) (t2 : PT.PackageType.PackageType) -> - { t2 with hash = t1.hash }) - types1 - types - let! values = lowerValues pm1 + (fun (t : PT.PackageType.PackageType) loc -> + { AstTransformer.transformType stabilization.mapping t with + hash = finalHash t.hash loc }) + types2 + typeLocations let values = List.map2 - (fun (v1 : PT.PackageValue.PackageValue) (v2 : PT.PackageValue.PackageValue) -> - { v2 with hash = v1.hash }) - values1 - values - - // Graft the pass-2 declarations (resolved bodies, pass-1 hashes) for the - // expressions' lowering — their refs then match the returned decls exactly. + (fun (v : PT.PackageValue.PackageValue) loc -> + { AstTransformer.transformValue stabilization.mapping v with + hash = finalHash v.hash loc }) + values2 + valueLocations + + // Graft the final declarations for the expressions' lowering, so their refs + // match the returned decls exactly. let pm2 = pm0 |> PT.PackageManager.withExtras @@ -232,6 +277,24 @@ let private declarationsToModule (List.zip values valueLocations) (List.zip fns fnLocations) + // Register the same declarations so a runtime error can still name them. The + // error outlives this graft: the CLI renders it once execution has returned, + // and the pretty-printer turns hashes back into names by asking where a hash + // is bound. + LibDB.EphemeralPackages.register + (List.map2 + (fun (t : PT.PackageType.PackageType) loc -> t.hash, loc) + types + typeLocations) + (List.map2 + (fun (v : PT.PackageValue.PackageValue) loc -> v.hash, loc) + values + valueLocations) + (List.map2 + (fun (f : PT.PackageFn.PackageFn) loc -> f.hash, loc) + fns + fnLocations) + let emptyContext = { WT2PT.Context.currentFnName = None WT2PT.Context.argMap = Map.empty @@ -486,7 +549,12 @@ let fns () : List = try // A parse failure surfaces a precise diagnostic as a `ParseError` - let! parseResult = parseCliScript branchState "CliScript" filename code + // No module for the script's own declarations. A module named after + // the file put the whole path into every name the runtime prints + // back (`CliScript.rundir/tmp/x.dark.Celsius`), and it buys nothing: + // one script runs per process, and two that declare the same thing + // share a hash anyway. The filename reaches traces via `RunScript`. + let! parseResult = parseCliScript branchState "CliScript" "" code let! parsedScript = match parseResult with | Ok m -> Ply(Ok m) diff --git a/backend/src/Builtins/Builtins.Http.Client/Libs/HttpClient.fs b/backend/src/Builtins/Builtins.Http.Client/Libs/HttpClient.fs index c575a314a4..d4f0eea9ad 100644 --- a/backend/src/Builtins/Builtins.Http.Client/Libs/HttpClient.fs +++ b/backend/src/Builtins/Builtins.Http.Client/Libs/HttpClient.fs @@ -729,6 +729,7 @@ let fns (config : Configuration) : List = ), 2, "headers", + None, VT.list (VT.tuple VT.string VT.string []), Dval.toValueType notAPair, notAPair @@ -909,6 +910,7 @@ let fns (config : Configuration) : List = ), 2, "headers", + None, VT.list (VT.tuple VT.string VT.string []), Dval.toValueType notAPair, notAPair diff --git a/backend/src/LibDB/EphemeralPackages.fs b/backend/src/LibDB/EphemeralPackages.fs new file mode 100644 index 0000000000..cf885b2236 --- /dev/null +++ b/backend/src/LibDB/EphemeralPackages.fs @@ -0,0 +1,76 @@ +/// Declarations that exist in this process but were never written to the store: +/// the types, values and fns a CLI script declares for itself. +/// +/// A runtime error carries content hashes, and it is rendered well after the +/// executor that raised it is gone. The pretty-printer turns a hash back into a +/// name by asking the package manager which locations that hash is bound to, so +/// a declaration the store has never seen renders as a 64-character hash, and a +/// message about the wrong function reads as an ordinary type mismatch. +/// +/// Registering the declarations here puts them in reach of that lookup without +/// threading a second package manager through every pretty-printer entry point. +/// +/// Registrations accumulate rather than replace, so an error can still name a +/// declaration from an enclosing script after a nested one has run. Growth is +/// bounded by content addressing: a hash is registered once however many times +/// its declaration is parsed, and a REPL session's worth of declarations is +/// small. Two names for one hash mean two names for one declaration, which is +/// the situation `pickLocation` already exists to resolve. +module LibDB.EphemeralPackages + +open Prelude + +module PT = LibExecution.ProgramTypes + +/// Hash to every location it is known by. +type private Registry = + { types : Map> + values : Map> + fns : Map> } + +let private empty = { types = Map.empty; values = Map.empty; fns = Map.empty } + +let mutable private registry = empty +let private writeLock = obj () + +let private add + (entries : List) + (m : Map>) + : Map> = + entries + |> List.fold + (fun acc (hash, loc) -> + let existing = Map.tryFind hash acc |> Option.defaultValue [] + if List.contains loc existing then + acc + else + Map.add hash (existing @ [ loc ]) acc) + m + +/// Make these declarations nameable by hash for the rest of the process. +/// +/// Locked because this is a read-modify-write: two lowerings racing would +/// silently lose one of them. Reads stay lock-free, each seeing whichever +/// immutable snapshot is current. +let register + (types : List) + (values : List) + (fns : List) + : unit = + lock writeLock (fun () -> + registry <- + { types = add types registry.types + values = add values registry.values + fns = add fns registry.fns }) + +/// Reverse lookups only. Resolution reads the store directly, and adding a layer +/// to `findType`/`getType` would put this on the parser's hot path for the sake +/// of an error message. +let typeLocations (hash : PT.Hash) : List = + Map.tryFind hash registry.types |> Option.defaultValue [] + +let valueLocations (hash : PT.Hash) : List = + Map.tryFind hash registry.values |> Option.defaultValue [] + +let fnLocations (hash : PT.Hash) : List = + Map.tryFind hash registry.fns |> Option.defaultValue [] diff --git a/backend/src/LibDB/LibDB.fsproj b/backend/src/LibDB/LibDB.fsproj index 0cf396a4f7..be4412f217 100644 --- a/backend/src/LibDB/LibDB.fsproj +++ b/backend/src/LibDB/LibDB.fsproj @@ -39,6 +39,7 @@ + diff --git a/backend/src/LibDB/PackageLocation.fs b/backend/src/LibDB/PackageLocation.fs index a73bf03713..743060c457 100644 --- a/backend/src/LibDB/PackageLocation.fs +++ b/backend/src/LibDB/PackageLocation.fs @@ -9,3 +9,17 @@ let toFQN (loc : PT.PackageLocation) : string = | modules -> let modulesStr = modules |> String.concat "." $"{loc.owner}.{modulesStr}.{loc.name}" + + +/// Deterministic per-location stand-in for a content hash, for use before an +/// item's references are resolved. A content hash computed at that point is +/// lossy: an unresolved reference carries no name, so two items differing only +/// in which unresolved name they mention hash identically, and any hash-keyed +/// registry silently drops one of them. One placeholder per location cannot +/// collide. The real content hash replaces it after resolution. +let placeholderHash (loc : PT.PackageLocation) : PT.Hash = + let bytes = + System.Security.Cryptography.SHA256.HashData( + System.Text.Encoding.UTF8.GetBytes(toFQN loc) + ) + PT.Hash(System.Convert.ToHexString(bytes).ToLowerInvariant()) diff --git a/backend/src/LibDB/PackageManager.fs b/backend/src/LibDB/PackageManager.fs index 2a8eb42767..69781ed6a7 100644 --- a/backend/src/LibDB/PackageManager.fs +++ b/backend/src/LibDB/PackageManager.fs @@ -90,18 +90,34 @@ let pt : PT.PackageManager = getFn = withCache PMPT.Fn.get getValue = withCache PMPT.Value.get + // A CLI script's declarations are never in the store, so without a fallback + // they render as hashes. Only as a fallback, though: hashes are content + // addressed, so a script's private name for some shape is also a name for + // every stored declaration of that shape, and `pickLocation` breaks ties by + // shortest path, which a script's one-segment path always wins. Consulted + // ahead of the store, `type MyErr = | BadFormat` in a script would rename + // `Stdlib.Int.ParseError` for the rest of the process. getTypeLocations = fun branchId id -> - let chain = getBranchChain branchId - PMPT.Type.getLocations chain id + uply { + match! PMPT.Type.getLocations (getBranchChain branchId) id with + | [] -> return EphemeralPackages.typeLocations id + | stored -> return stored + } getValueLocations = fun branchId id -> - let chain = getBranchChain branchId - PMPT.Value.getLocations chain id + uply { + match! PMPT.Value.getLocations (getBranchChain branchId) id with + | [] -> return EphemeralPackages.valueLocations id + | stored -> return stored + } getFnLocations = fun branchId id -> - let chain = getBranchChain branchId - PMPT.Fn.getLocations chain id + uply { + match! PMPT.Fn.getLocations (getBranchChain branchId) id with + | [] -> return EphemeralPackages.fnLocations id + | stored -> return stored + } search = fun (branchId, query) -> diff --git a/backend/src/LibExecution/Interpreter.fs b/backend/src/LibExecution/Interpreter.fs index 769570c5a3..83989e9838 100644 --- a/backend/src/LibExecution/Interpreter.fs +++ b/backend/src/LibExecution/Interpreter.fs @@ -2310,6 +2310,7 @@ let private frameReturnTypeCheckAsync Ply.toTask (TypeReference.toVT exeState.types tst expectedReturnType) RuntimeError.Applications.FnResultNotExpectedType( fnName, + Some expectedReturnType, expectedVT, Dval.toValueType resultOfFrame, resultOfFrame diff --git a/backend/src/LibExecution/RuntimeTypes.fs b/backend/src/LibExecution/RuntimeTypes.fs index 5d5234ebd0..50396a8f8d 100644 --- a/backend/src/LibExecution/RuntimeTypes.fs +++ b/backend/src/LibExecution/RuntimeTypes.fs @@ -1250,9 +1250,14 @@ module RuntimeError = typeName : FQTypeName.FQTypeName * caseName : string + // `declaredType` is the field's type as written in the type declaration, + // or None where the constructor is builtin and nothing was written. It + // supplies names only; `expectedType` remains the authority on shape. See + // the note on `FnParameterNotExpectedType` for why both are needed. | ConstructionFieldOfWrongType of caseName : string * fieldIndex : int * + declaredType : Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval @@ -1270,8 +1275,13 @@ module RuntimeError = | CreationMissingField of fieldName : string | CreationDuplicateField of fieldName : string | CreationFieldNotExpected of fieldName : string + // `declaredType` is the field's type as written in the type declaration, + // or None where the constructor is builtin and nothing was written. It + // supplies names only; `expectedType` remains the authority on shape. See + // the note on `FnParameterNotExpectedType` for why both are needed. | CreationFieldOfWrongType of fieldName : string * + declaredType : Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval @@ -1281,8 +1291,13 @@ module RuntimeError = | UpdateEmptyKey | UpdateDuplicateField of fieldName : string | UpdateFieldNotExpected of fieldName : string + // `declaredType` is the field's type as written in the type declaration, + // or None where the constructor is builtin and nothing was written. It + // supplies names only; `expectedType` remains the authority on shape. See + // the note on `FnParameterNotExpectedType` for why both are needed. | UpdateFieldOfWrongType of fieldName : string * + declaredType : Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval @@ -1308,16 +1323,31 @@ module RuntimeError = | TooManyArgsForFn of fn : FQFnName.FQFnName * expected : int * actual : int + // `declaredType` is the type reference as written at the declaration, or + // None where there was nothing written (a raise site with no declaration + // behind it). `expectedType` stays the authority on shape, because it has + // been through the type symbol table and so has concrete types where the + // declaration had variables; `declaredType` supplies only names. + // + // Both are needed because a `ValueType` carries content hashes, and one + // hash can be bound to several names: `Stdlib.Int`, `Stdlib.Float` and + // `Stdlib.Uuid` all declare `ParseError` as `| BadFormat`, which makes them + // one type with three names. Choosing between those from the hash alone is + // a guess, and it guessed wrong often enough to report an `Int.parse` + // failure as a `Uuid.ParseError`. Names are display metadata and never + // reach the hash, so carrying them costs content addressing nothing. | FnParameterNotExpectedType of fnName : FQFnName.FQFnName * paramIndex : int * paramName : string * + declaredType : Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval | FnResultNotExpectedType of fnName : FQFnName.FQFnName * + declaredType : Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval diff --git a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs index 66a7f87768..2362f09eb5 100644 --- a/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs +++ b/backend/src/LibExecution/RuntimeTypesToDarkTypes.fs @@ -1200,11 +1200,16 @@ module RuntimeError = | RuntimeError.Records.CreationFieldNotExpected fieldName -> "CreationFieldNotExpected", [ DString fieldName ] | RuntimeError.Records.CreationFieldOfWrongType(fieldName, + declaredType, expectedType, actualType, actual) -> "CreationFieldOfWrongType", [ DString fieldName + declaredType + |> C2DT.Option.toDT + TypeReference.toDT + (KTCustomType(TypeReference.typeName (), [])) ValueType.toDT expectedType ValueType.toDT actualType Dval.toDT actual ] @@ -1217,11 +1222,16 @@ module RuntimeError = | RuntimeError.Records.UpdateFieldNotExpected fieldName -> "UpdateFieldNotExpected", [ DString fieldName ] | RuntimeError.Records.UpdateFieldOfWrongType(fieldName, + declaredType, expectedType, actualType, actual) -> "UpdateFieldOfWrongType", [ DString fieldName + declaredType + |> C2DT.Option.toDT + TypeReference.toDT + (KTCustomType(TypeReference.typeName (), [])) ValueType.toDT expectedType ValueType.toDT actualType Dval.toDT actual ] @@ -1251,9 +1261,10 @@ module RuntimeError = _, [], "CreationFieldOfWrongType", - [ fieldName; expectedType; actualType; actual ]) -> + [ fieldName; declaredType; expectedType; actualType; actual ]) -> RuntimeError.Records.CreationFieldOfWrongType( D.string fieldName, + C2DT.Option.fromDT TypeReference.fromDT declaredType, ValueType.fromDT expectedType, ValueType.fromDT actualType, Dval.fromDT actual @@ -1270,9 +1281,10 @@ module RuntimeError = _, [], "UpdateFieldOfWrongType", - [ fieldName; expectedType; actualType; actual ]) -> + [ fieldName; declaredType; expectedType; actualType; actual ]) -> RuntimeError.Records.UpdateFieldOfWrongType( D.string fieldName, + C2DT.Option.fromDT TypeReference.fromDT declaredType, ValueType.fromDT expectedType, ValueType.fromDT actualType, Dval.fromDT actual @@ -1308,12 +1320,17 @@ module RuntimeError = "ConstructionCaseNotFound", [ FQTypeName.toDT typeName; DString caseName ] | RuntimeError.Enums.ConstructionFieldOfWrongType(caseName, fieldIndex, + declaredType, expectedType, actualType, actualValue) -> "ConstructionFieldOfWrongType", [ DString caseName dintOfInt fieldIndex + declaredType + |> C2DT.Option.toDT + TypeReference.toDT + (KTCustomType(TypeReference.typeName (), [])) ValueType.toDT expectedType ValueType.toDT actualType Dval.toDT actualValue ] @@ -1342,10 +1359,16 @@ module RuntimeError = _, [], "ConstructionFieldOfWrongType", - [ caseName; fieldIndex; expectedType; actualType; actualValue ]) -> + [ caseName + fieldIndex + declaredType + expectedType + actualType + actualValue ]) -> RuntimeError.Enums.ConstructionFieldOfWrongType( D.string caseName, D.int fieldIndex, + C2DT.Option.fromDT TypeReference.fromDT declaredType, ValueType.fromDT expectedType, ValueType.fromDT actualType, Dval.fromDT actualValue @@ -1376,6 +1399,7 @@ module RuntimeError = | RuntimeError.Applications.FnParameterNotExpectedType(fnName, paramIndex, paramName, + declaredType, expectedType, actualType, actualValue) -> @@ -1383,15 +1407,24 @@ module RuntimeError = [ FQFnName.toDT fnName dintOfInt paramIndex DString paramName + declaredType + |> C2DT.Option.toDT + TypeReference.toDT + (KTCustomType(TypeReference.typeName (), [])) ValueType.toDT expectedType ValueType.toDT actualType Dval.toDT actualValue ] | RuntimeError.Applications.FnResultNotExpectedType(fnName, + declaredType, expectedType, actualType, actualValue) -> "FnResultNotExpectedType", [ FQFnName.toDT fnName + declaredType + |> C2DT.Option.toDT + TypeReference.toDT + (KTCustomType(TypeReference.typeName (), [])) ValueType.toDT expectedType ValueType.toDT actualType Dval.toDT actualValue ] @@ -1434,11 +1467,18 @@ module RuntimeError = _, [], "FnParameterNotExpectedType", - [ fnName; paramIndex; paramName; expectedType; actualType; actualValue ]) -> + [ fnName + paramIndex + paramName + declaredType + expectedType + actualType + actualValue ]) -> RuntimeError.Applications.FnParameterNotExpectedType( FQFnName.fromDT fnName, D.int paramIndex, D.string paramName, + C2DT.Option.fromDT TypeReference.fromDT declaredType, ValueType.fromDT expectedType, ValueType.fromDT actualType, Dval.fromDT actualValue @@ -1447,9 +1487,10 @@ module RuntimeError = _, [], "FnResultNotExpectedType", - [ fnName; expectedType; actualType; actualValue ]) -> + [ fnName; declaredType; expectedType; actualType; actualValue ]) -> RuntimeError.Applications.FnResultNotExpectedType( FQFnName.fromDT fnName, + C2DT.Option.fromDT TypeReference.fromDT declaredType, ValueType.fromDT expectedType, ValueType.fromDT actualType, Dval.fromDT actualValue diff --git a/backend/src/LibExecution/TypeChecker.fs b/backend/src/LibExecution/TypeChecker.fs index 762047fc35..bfe40f70e1 100644 --- a/backend/src/LibExecution/TypeChecker.fs +++ b/backend/src/LibExecution/TypeChecker.fs @@ -655,17 +655,22 @@ let checkFnParam (actual : Dval) : Ply> = uply { - let! expected = TypeReference.unwrapAlias types expected - match! unify types tst expected actual with + let! unwrapped = TypeReference.unwrapAlias types expected + match! unify types tst unwrapped actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> - let! expected = TypeReference.toVT types tst expected + let! expectedVT = TypeReference.toVT types tst unwrapped return RTE.Applications.FnParameterNotExpectedType( fnName, paramIndex, paramName, - expected, + // The reference as written, from before `unwrapAlias`, so an alias + // reports the alias. Built here rather than above the unify: it exists + // only to describe the failure, and this runs on every parameter of + // every call. + Some expected, + expectedVT, Dval.toValueType actual, actual ) @@ -682,17 +687,19 @@ let checkFnResult (actual : Dval) : Ply> = uply { - let! expected = TypeReference.unwrapAlias types expected - match! unify types tst expected actual with + let! unwrapped = TypeReference.unwrapAlias types expected + match! unify types tst unwrapped actual with | Ok updatedTst -> return Ok updatedTst | Error _path -> // Resolved here rather than before the unify: it exists only to render the error, and computing it // eagerly meant every successful return -- which is nearly all of them -- paid a full type // resolution (`toVT` walks the reference and can hit `Types.find`) to build a message nobody sees. - let! expectedVT = TypeReference.toVT types tst expected + // `Some expected` is built here for the same reason, and is pre-unwrap so an alias reports the alias. + let! expectedVT = TypeReference.toVT types tst unwrapped return RTE.Applications.FnResultNotExpectedType( fnName, + Some expected, expectedVT, Dval.toValueType actual, actual @@ -816,7 +823,14 @@ module DvalCreator = match VT.merge expected vt with | Ok typ -> DEnum(typeName, typeName, [ typ ], "Some", [ dv ]) | Error() -> - RuntimeError.Enums.ConstructionFieldOfWrongType("Some", 0, expected, vt, dv) + RuntimeError.Enums.ConstructionFieldOfWrongType( + "Some", + 0, + None, + expected, + vt, + dv + ) |> RuntimeError.Enum |> raiseRTE threadID @@ -846,6 +860,7 @@ module DvalCreator = RuntimeError.Enums.ConstructionFieldOfWrongType( "Ok", 0, + None, okType, dvalType, dvOk @@ -867,6 +882,7 @@ module DvalCreator = RuntimeError.Enums.ConstructionFieldOfWrongType( "Error", 0, + None, errorType, dvalType, dvError @@ -1056,6 +1072,7 @@ module DvalCreator = RTE.Enums.ConstructionFieldOfWrongType( caseName, fieldIndex, + Some fieldDef, expected, Dval.toValueType actualField, actualField @@ -1088,6 +1105,7 @@ module DvalCreator = RTE.Enums.ConstructionFieldOfWrongType( caseName, fieldIndex, + Some fieldDef, expected, Dval.toValueType actualField, actualField @@ -1352,6 +1370,7 @@ module DvalCreator = return RTE.Records.CreationFieldOfWrongType( fieldName, + Some fieldDef.typ, expected, Dval.toValueType fieldValue, fieldValue @@ -1384,6 +1403,7 @@ module DvalCreator = return RTE.Records.CreationFieldOfWrongType( fieldName, + Some fieldDef.typ, expected, Dval.toValueType fieldValue, fieldValue @@ -1475,6 +1495,7 @@ module DvalCreator = return RTE.Records.UpdateFieldOfWrongType( fieldName, + Some fieldDef.typ, expected, Dval.toValueType fieldValue, fieldValue @@ -1506,6 +1527,7 @@ module DvalCreator = return RTE.Records.UpdateFieldOfWrongType( fieldName, + Some fieldDef.typ, expected, Dval.toValueType fieldValue, fieldValue diff --git a/backend/src/LibParser/Package.fs b/backend/src/LibParser/Package.fs index 004712373d..895b83051d 100644 --- a/backend/src/LibParser/Package.fs +++ b/backend/src/LibParser/Package.fs @@ -61,17 +61,9 @@ let private wtModuleToOps (WT2PT.PackageValue.Name.toModules value.name) value) - // Compute a deterministic name-based placeholder hash for Set*Name ops. - // The real hash replaces this in LoadPackagesFromDisk.computeRealHashes. - let nameBasedHash (loc : PT.PackageLocation) : Hash = - let nameKey = PackageLocation.toFQN loc - let nameBytes = - System.Security.Cryptography.SHA256.HashData( - System.Text.Encoding.UTF8.GetBytes(nameKey) - ) - Hash( - System.BitConverter.ToString(nameBytes).Replace("-", "").ToLowerInvariant() - ) + // Set*Name ops carry a placeholder; the real hash replaces it in + // LoadPackagesFromDisk.computeRealHashes. + let nameBasedHash = PackageLocation.placeholderHash let ops : List = [ for (wtType, ptType) in List.zip modul.types types do diff --git a/backend/src/Wasm/Repl.fs b/backend/src/Wasm/Repl.fs index 6186ec3a21..5f89c3f679 100644 --- a/backend/src/Wasm/Repl.fs +++ b/backend/src/Wasm/Repl.fs @@ -105,17 +105,9 @@ let LoadPackagesFromUrl (snapshotUrl : string) : Task = // ---------- declarations: REPL entries become Repl-owned package items ---------- -/// Mirror of LibParser.Package's placeholder for Set*Name ops; the real hash -/// replaces it in HashStabilization.computeRealHashes. -let private nameBasedHash (loc : PT.PackageLocation) : PT.Hash = - let nameKey = PackageLocation.toFQN loc - let nameBytes = - System.Security.Cryptography.SHA256.HashData( - System.Text.Encoding.UTF8.GetBytes(nameKey) - ) - PT.Hash( - System.BitConverter.ToString(nameBytes).Replace("-", "").ToLowerInvariant() - ) +/// Placeholder for Set*Name ops; the real hash replaces it in +/// HashStabilization.computeRealHashes. +let private nameBasedHash = PackageLocation.placeholderHash type private Classified = { fns : List diff --git a/backend/testfiles/execution/language/error-type-names.dark b/backend/testfiles/execution/language/error-type-names.dark new file mode 100644 index 0000000000..7b52d4d9da --- /dev/null +++ b/backend/testfiles/execution/language/error-type-names.dark @@ -0,0 +1,91 @@ +// Which name a runtime error prints for a type. +// +// Types are content addressed, so one hash can be bound to several names: +// `Stdlib.Int.ParseError`, `Stdlib.Float.ParseError` and `Stdlib.Uuid.ParseError` +// are all `| BadFormat`, which makes them one type with three names. Choosing +// between them from the hash alone is a guess, and it guessed wrong often enough +// to report an `Int.parse` failure as a `Uuid.ParseError`. +// +// The name the author wrote at the declaration decides. That spelling is display +// metadata carried alongside the resolution; it never reaches the hash, so it +// costs content addressing nothing. +// +// Names are fully qualified: testfiles parse with owner "Tests", so `Darklang.` +// prefixes are required. + +module AmbiguousHash = + // The bodies differ on purpose. With the same body these two would be the same + // function: their parameter types share a hash, so nothing would distinguish + // them, they would collapse to one declaration, and this would test whichever + // one survived rather than each of them. + let takesIntParseError (e: Darklang.Stdlib.Int.ParseError) : Int = 1 + let takesUuidParseError (e: Darklang.Stdlib.Uuid.ParseError) : Int = 2 + let returnsIntParseError (n: Int) : Darklang.Stdlib.Int.ParseError = n + + // One hash, three declarations, three names printed. + (takesIntParseError 5) = error="AmbiguousHash.takesIntParseError's 1st parameter `e` expects Darklang.Stdlib.Int.ParseError, but got Int (5)" + (takesUuidParseError 5) = error="AmbiguousHash.takesUuidParseError's 1st parameter `e` expects Darklang.Stdlib.Uuid.ParseError, but got Int (5)" + (returnsIntParseError 5) = error="AmbiguousHash.returnsIntParseError's return value expects Darklang.Stdlib.Int.ParseError, but got Int (5)" + +module NestedInTypeArguments = + // The name has to be chosen per position, not once for the whole type. A + // `ValueType` is a tree of hashes, so every custom type inside it has the same + // problem as the outermost one. + let takesListOfInt (x: List) : Int = 1 + let takesListOfUuid (x: List) : Int = 2 + let takesDeep (x: Dict>) : Int = 3 + + // The sharpest case: one hash, two positions, two names, in one type. + let takesPair + (x: (Darklang.Stdlib.Int.ParseError * Darklang.Stdlib.Uuid.ParseError)) + : Int = + 4 + + (takesListOfInt 5) = error="NestedInTypeArguments.takesListOfInt's 1st parameter `x` expects List, but got Int (5)" + (takesListOfUuid 5) = error="NestedInTypeArguments.takesListOfUuid's 1st parameter `x` expects List, but got Int (5)" + (takesDeep 5) = error="NestedInTypeArguments.takesDeep's 1st parameter `x` expects Dict>, but got Int (5)" + (takesPair 5) = error="NestedInTypeArguments.takesPair's 1st parameter `x` expects (Darklang.Stdlib.Int.ParseError * Darklang.Stdlib.Uuid.ParseError), but got Int (5)" + +module RecordAndEnumFields = + // Same rule, reached through the other messages that print a declared type. + type HasIntParseError = { e: Darklang.Stdlib.Int.ParseError } + type HasUuidParseErrors = { es: List } + type WrapsUuidParseError = | Wrap of Darklang.Stdlib.Uuid.ParseError + + let makeIntRecord () : HasIntParseError = HasIntParseError { e = 5 } + let makeUuidRecord () : HasUuidParseErrors = HasUuidParseErrors { es = 5 } + let makeEnum () : WrapsUuidParseError = WrapsUuidParseError.Wrap 5 + + let updateIntRecord () : HasIntParseError = + let start = + HasIntParseError { e = Darklang.Stdlib.Int.ParseError.BadFormat } + + { start with e = 5 } + + (makeIntRecord ()) = error="Failed to create record. Expected Darklang.Stdlib.Int.ParseError for field `e`, but got 5 (an Int)" + (makeUuidRecord ()) = error="Failed to create record. Expected List for field `es`, but got 5 (an Int)" + (makeEnum ()) = error="Failed to create enum. Expected Darklang.Stdlib.Uuid.ParseError for field 0 in `Wrap`, but got Int (5)" + (updateIntRecord ()) = error="Failed to create updated record. Expected Darklang.Stdlib.Int.ParseError for field `e`, but got 5 (an Int)" + +module UnambiguousHash = + // One location, so there is nothing to choose between and the canonical name is + // printed however the author spelled it. Type arguments survive either way. + let takesOption (o: Darklang.Stdlib.Option.Option) : Int = 1 + + (takesOption 5) = error="UnambiguousHash.takesOption's 1st parameter `o` expects Darklang.Stdlib.Option.Option, but got Int (5)" + +module LocallyDeclared = + // A type no package names, so the declaration here is the only source of one. + // `Tests` is scaffolding the parser stamps on rather than a name anything can + // be reached by, so it comes off; the module the author wrote stays. + // + // The field name is deliberately odd. Give it a shape another declaration + // anywhere in the suite also has and the hash stops being unambiguous, at + // which point the rule above kicks in and the author's own spelling prints + // instead: bare `Celsius`, since that is how it is written here. Both answers + // are right, but only one of them is stable to write down. + type Celsius = { celsiusDegrees: Int } + + let describe (t: Celsius) : String = "ok" + + (describe 5) = error="LocallyDeclared.describe's 1st parameter `t` expects LocallyDeclared.Celsius, but got Int (5)" diff --git a/backend/tests/Tests/CliScriptLowering.Tests.fs b/backend/tests/Tests/CliScriptLowering.Tests.fs new file mode 100644 index 0000000000..30a6a8e874 --- /dev/null +++ b/backend/tests/Tests/CliScriptLowering.Tests.fs @@ -0,0 +1,194 @@ +/// Tests for how a CLI script's own declarations are lowered and identified. +/// +/// `dark run` / `dark eval` parse a script, lower its declarations to PT, and +/// graft them into the package manager keyed by content hash. Two declarations +/// that hash the same collapse into one, and calls to either reach whichever +/// survived, so the hashes these tests assert on are what decides whether a +/// script's functions call each other correctly. +module Tests.CliScriptLowering + +open Expecto +open System.Threading.Tasks +open FSharp.Control.Tasks + +open Prelude + +module RT = LibExecution.RuntimeTypes +module PT = LibExecution.ProgramTypes +module Cli = Builtins.CliHost.Libs.Cli +module CliScript = Builtins.CliHost.Utils.CliScript + +open TestUtils.TestUtils + + +let private parse (code : string) : Task = + task { + let! state = executionStateFor pmPT false Map.empty + let! result = Cli.parseCliScript state "Tests" "script" code |> Ply.toTask + match result with + | Ok m -> return m + | Error diags -> return failtest $"Parse failed: %A{diags}" + } + +let private hashes (items : List) : List = + items |> List.map (fun (PT.Hash h) -> h) + +/// The hash a function's first parameter is typed against, for checking that a +/// declaration is wired to the type it names. +let private firstParamTypeHash (fn : PT.PackageFn.PackageFn) : string = + match fn.parameters.head.typ with + | PT.TCustomType({ resolved = Ok { name = PT.FQTypeName.Package(PT.Hash h) } }, _) -> + h + | other -> failtest $"Expected a resolved package type, got %A{other}" + + +/// A parameter type declared in the same script is unresolved on the first +/// lowering pass, and an unresolved reference serialises without its name. So +/// these two functions are byte-identical at that point, and hashing them there +/// gives one hash for both: the graft keeps one function and `takesA` starts +/// calling `takesB`'s body. Hashing after resolution is what keeps them apart. +let private testUnresolvedRefsDoNotCollide = + testTask "declarations differing only in an unresolved ref stay distinct" { + let! (m : CliScript.PTCliScriptModule) = + parse + "type TA = { a: String }\n\ + type TB = { b: Int }\n\ + let takesA (r: TA) : Int = 7\n\ + let takesB (r: TB) : Int = 7\n\ + 0" + + Expect.hasLength m.types 2 "both types lowered" + Expect.hasLength m.fns 2 "both fns lowered" + + let fnHashes = m.fns |> List.map (fun f -> f.hash) |> hashes + Expect.isTrue + (List.distinct fnHashes |> List.length = 2) + "the two fns have distinct hashes" + + // Each fn is typed against the type it actually named. + let typeHashes = m.types |> List.map (fun t -> t.hash) |> hashes |> Set.ofList + let paramHashes = m.fns |> List.map firstParamTypeHash |> Set.ofList + Expect.equal paramHashes typeHashes "each fn points at a different script type" + } + +/// The other direction. Declarations that really are identical SHOULD share a +/// hash: content addressing means a name is not part of what a thing is, so +/// writing the same function twice under two names defines it once. +let private testIdenticalDeclarationsShareAHash = + testTask "structurally identical declarations share one hash" { + let! (m : CliScript.PTCliScriptModule) = + parse + "let alpha (x: Int) : Int = x + 1\n\ + let beta (x: Int) : Int = x + 1\n\ + 0" + + Expect.hasLength m.fns 2 "both fns lowered" + let fnHashes = m.fns |> List.map (fun f -> f.hash) |> hashes + Expect.isTrue + (List.distinct fnHashes |> List.length = 1) + "identical fns collapse to one hash" + } + +/// Hashing after resolution means the reference graph can contain cycles, so the +/// hashes have to be computed per strongly-connected component rather than in +/// plain dependency order. +let private testMutuallyRecursiveDeclarations = + testTask "mutually recursive fns hash as a batch" { + let! (m : CliScript.PTCliScriptModule) = + parse + "let isEven (n: Int) : Bool = if n == 0 then true else isOdd (n - 1)\n\ + let isOdd (n: Int) : Bool = if n == 0 then false else isEven (n - 1)\n\ + 0" + + Expect.hasLength m.fns 2 "both fns lowered" + let fnHashes = m.fns |> List.map (fun f -> f.hash) |> hashes + Expect.isTrue + (List.distinct fnHashes |> List.length = 2) + "the two fns have distinct hashes" + Expect.isFalse + (fnHashes |> List.contains "") + "neither fn kept the empty placeholder" + } + +/// Content addressing has to reach across the script/package boundary too: a +/// script type with the same shape as a package type IS that type. Identifying +/// script declarations by location instead of content would have cost this. +let private testScriptTypeUnifiesWithPackageType = + testTask "a script type matching a package type shares its hash" { + let! (m : CliScript.PTCliScriptModule) = parse "type MyErr = | BadFormat\n0" + let! (reference : CliScript.PTCliScriptModule) = + parse + "let f (e: Darklang.Stdlib.Int.ParseError) : Int = 1\n\ + 0" + + match m.types, reference.fns with + | [ scriptType ], [ fn ] -> + let (PT.Hash scriptHash) = scriptType.hash + Expect.equal + scriptHash + (firstParamTypeHash fn) + "script-declared type hashes to the package type it duplicates" + | _ -> failtest "expected one script type and one reference fn" + } + + +/// A runtime error carries content hashes and is rendered by the CLI after the +/// executor that raised it is gone, so the pretty-printer turns a hash back into +/// a name by asking the package manager where that hash is bound. A script's +/// declarations are never in the store, so that lookup used to miss and every +/// such name printed as a 64-character hash. +/// +/// Lowering now registers them in `EphemeralPackages`, which `PackageManager.pt` +/// consults ahead of the store. This asserts the lookup, not the rendered +/// string: the string needs CLI dispatch, which lives in `CliTraces.Tests.fs`. +let private testDeclarationsAreNameableAfterLowering = + testTask "lowered declarations can be resolved back to their names" { + let! (m : CliScript.PTCliScriptModule) = + parse "type Celsius = { degrees: Int }\n0" + + match m.types with + | [ celsius ] -> + let! locations = + LibDB.PackageManager.pt.getTypeLocations PT.mainBranchId celsius.hash + |> Ply.toTask + let names = locations |> List.map (fun (l : PT.PackageLocation) -> l.name) + Expect.contains names "Celsius" "the script's type is reachable by hash" + | _ -> failtest "expected exactly one script type" + } + + +/// The registry is a fallback, never an override. +/// +/// Hashes are content addressed, so a script's private name for some shape is +/// also a name for every stored declaration of that shape. `pickLocation` breaks +/// ties by shortest path, and a script's path is one segment, so consulting the +/// registry first would let `type MyErr = | BadFormat` in a throwaway script +/// rename `Stdlib.Int.ParseError` for the rest of the process. +let private testRegistryDoesNotDisplaceStoredNames = + testTask "a script's name does not displace the store's" { + let! (m : CliScript.PTCliScriptModule) = parse "type MyErr = | BadFormat\n0" + + match m.types with + | [ myErr ] -> + let! locations = + LibDB.PackageManager.pt.getTypeLocations PT.mainBranchId myErr.hash + |> Ply.toTask + let names = locations |> List.map (fun (l : PT.PackageLocation) -> l.name) + // Same shape as the stdlib `ParseError`s, so the store names this hash. + Expect.contains names "ParseError" "the stored name is still there" + Expect.isFalse + (List.contains "MyErr" names) + "the script's name does not join the stored ones" + | _ -> failtest "expected exactly one script type" + } + + +let tests = + testList + "CliScriptLowering" + [ testUnresolvedRefsDoNotCollide + testIdenticalDeclarationsShareAHash + testMutuallyRecursiveDeclarations + testScriptTypeUnifiesWithPackageType + testDeclarationsAreNameableAfterLowering + testRegistryDoesNotDisplaceStoredNames ] diff --git a/backend/tests/Tests/CliTraces.Tests.fs b/backend/tests/Tests/CliTraces.Tests.fs index 10cf0dc50d..b8609a6745 100644 --- a/backend/tests/Tests/CliTraces.Tests.fs +++ b/backend/tests/Tests/CliTraces.Tests.fs @@ -206,6 +206,104 @@ let private testEvalCases = "simple expr", [ "eval"; "2L + 3L" ], "5" "string concat", [ "eval"; "\"hello\" ++ \"world\"" ], "helloworld" ] +// ─── Script declaration identity ──────────────────────────────────── + +/// A script's own types, values and fns are grafted into the package manager +/// keyed by content hash, so two declarations that hash the same collapse into +/// one and calls to either reach whichever survived. +/// +/// Collapsing is correct when the declarations really are identical, and wrong +/// when they only look identical because they were hashed before their +/// references resolved: an unresolved reference carries no name, so +/// `f (r: TA) = 7` and `f (r: TB) = 7` serialise the same. +let private testScriptDeclIdentity = + testCliEquals + "script declaration identity" + [ // Both fns are byte-identical apart from a parameter type that is still + // unresolved when the first pass runs. They must stay two functions. + "distinct types behind unresolved refs", + [ "eval" + "type TA = { a: String }\n\ + type TB = { b: Int }\n\ + let takesA (r: TA) : Int = 7\n\ + let takesB (r: TB) : Int = 7\n\ + (takesA (TA { a = \"x\" })) + (takesB (TB { b = 1 }))" ], + "14" + + // The other direction: genuinely identical declarations SHOULD share one + // hash. Collapsing them is content addressing working, not a bug. + "identical fns share one hash", + [ "eval" + "let alpha (x: Int) : Int = x + 1\n\ + let beta (x: Int) : Int = x + 1\n\ + (alpha 1) + (beta 1)" ], + "4" + + // Hashing after resolution means the hash graph can contain cycles, so + // mutually recursive declarations have to be hashed as a batch. + "mutually recursive fns", + [ "eval" + "let isEven (n: Int) : Bool = if n == 0 then true else isOdd (n - 1)\n\ + let isOdd (n: Int) : Bool = if n == 0 then false else isEven (n - 1)\n\ + isEven 10" ], + "true" + + // Content addressing reaches across the script/package boundary: a script + // type with the same shape as a package type IS that type. This is what a + // location-keyed identity scheme would have cost. + "script type unifies with package type", + [ "eval" + "type MyErr = | BadFormat\n\ + let f (e: Darklang.Stdlib.Int.ParseError) : Int = 1\n\ + f (MyErr.BadFormat)" ], + "1" ] + + +// ─── Runtime error rendering ──────────────────────────────────────── + +/// A type mismatch against a package declaration names the function, the +/// parameter and both types. Hashes appearing here instead of names is the +/// failure mode that hid a declaration-collision bug for a whole release: the +/// message named two hashes, so it read as a type mismatch rather than as the +/// wrong function being called. +let private testRteNamesPackageDecls = + cliTest "RTE names package declarations" (fun state -> + task { + let! output = runCli state [ "eval"; "Stdlib.List.length \"not a list\"" ] + Expect.stringContains + output + "Darklang.Stdlib.List.length" + "fn named, not hashed" + Expect.stringContains output "1st parameter `list`" "parameter named" + Expect.stringContains output "expects List<_>" "expected type named" + Expect.stringContains output "but got String" "actual type named" + }) + +/// The same message for a script's own declarations. These are never in the +/// store, and the CLI renders the error after the executor holding them is gone, +/// so the pretty-printer's hash-to-name lookup used to miss and fall back to +/// printing 64-character hashes. That is what made a declaration-collision bug +/// read as an ordinary type mismatch. +let private testRteNamesScriptDecls = + cliTest "RTE names script declarations" (fun state -> + task { + let! output = + runCli + state + [ "eval" + "type Celsius = { degrees: Int }\n\ + type Fahrenheit = { degrees: Float }\n\ + let describe (t: Celsius) : String = \"ok\"\n\ + describe (Fahrenheit { degrees = 1.0 })" ] + Expect.stringContains output "describe's 1st parameter `t`" "fn named" + Expect.stringContains output "expects Celsius" "expected type named" + Expect.stringContains output "but got Fahrenheit" "actual type named" + // Bare, not `CliScript.Celsius`: the owner is scaffolding the parser + // stamped on, and no name can reach the declaration through it. + Expect.isFalse (output.Contains "CliScript.") "no scaffolding owner" + }) + + let private testListFunctions = cliTest "ls Stdlib.List" (fun state -> task { @@ -775,6 +873,9 @@ let tests = testStatusCommand testRunCases testEvalCases + testScriptDeclIdentity + testRteNamesPackageDecls + testRteNamesScriptDecls testListFunctions testViewFunction testListTypes diff --git a/backend/tests/Tests/Interpreter.Tests.fs b/backend/tests/Tests/Interpreter.Tests.fs index 0bc0224035..8914fac6ad 100644 --- a/backend/tests/Tests/Interpreter.Tests.fs +++ b/backend/tests/Tests/Interpreter.Tests.fs @@ -368,7 +368,13 @@ module RecordUpdate = "let r = Test.Test { key = true }\nlet r2 = { r | key = 1 }\nr2.key" E.RecordUpdate.fieldWithWrongType (RTE.Record( - RTE.Records.UpdateFieldOfWrongType("key", VT.bool, VT.int64, RT.DInt64 1L) + RTE.Records.UpdateFieldOfWrongType( + "key", + Some RT.TBool, + VT.bool, + VT.int64, + RT.DInt64 1L + ) )) let tests = diff --git a/backend/tests/Tests/Tests.fs b/backend/tests/Tests/Tests.fs index fc9a923d91..0529d14af1 100644 --- a/backend/tests/Tests/Tests.fs +++ b/backend/tests/Tests/Tests.fs @@ -58,6 +58,7 @@ let main (args : string array) : int = // Uncomment the line below to run them; no filter reaches them while it is commented out, // so nothing currently exercises the tracer end to end. // Tests.CliTraces.tests + Tests.CliScriptLowering.tests Tests.Toplevels.tests // cross-cutting diff --git a/backend/tests/Tests/Tests.fsproj b/backend/tests/Tests/Tests.fsproj index 636a351097..8d9f2b337b 100644 --- a/backend/tests/Tests/Tests.fsproj +++ b/backend/tests/Tests/Tests.fsproj @@ -45,6 +45,7 @@ + diff --git a/packages/darklang/languageTools/runtimeErrors.dark b/packages/darklang/languageTools/runtimeErrors.dark index ea688677c8..2f1c98a73b 100644 --- a/packages/darklang/languageTools/runtimeErrors.dark +++ b/packages/darklang/languageTools/runtimeErrors.dark @@ -69,6 +69,7 @@ module Enums = | ConstructionFieldOfWrongType of caseName: String * fieldIndex: Int * + declaredType: Stdlib.Option.Option * expectedType: ValueType * actualType: ValueType * actualValue: Dval @@ -83,6 +84,7 @@ module Records = | CreationFieldNotExpected of fieldName: String | CreationFieldOfWrongType of fieldName: String * + declaredType: Stdlib.Option.Option * expectedType: ValueType * actualType: ValueType * actualValue: Dval @@ -94,6 +96,7 @@ module Records = | UpdateFieldNotExpected of fieldName: String | UpdateFieldOfWrongType of fieldName: String * + declaredType: Stdlib.Option.Option * expectedType: ValueType * actualType: ValueType * actualValue : Dval @@ -110,8 +113,8 @@ module Applications = | WrongNumberOfTypeArgsForFn of fn: FQFnName.FQFnName * expected: Int * actual: Int | CannotApplyTypeArgsMoreThanOnce | TooManyArgsForFn of fn: FQFnName.FQFnName * expected: Int * actual: Int - | FnParameterNotExpectedType of fnName : FQFnName.FQFnName * paramIndex: Int * paramName : String * expectedType : ValueType * actualType : ValueType * actualValue : Dval - | FnResultNotExpectedType of fnName : FQFnName.FQFnName * expectedType : ValueType * actualType : ValueType * actualValue : Dval + | FnParameterNotExpectedType of fnName : FQFnName.FQFnName * paramIndex: Int * paramName : String * declaredType : Stdlib.Option.Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval + | FnResultNotExpectedType of fnName : FQFnName.FQFnName * declaredType : Stdlib.Option.Option * expectedType : ValueType * actualType : ValueType * actualValue : Dval | CannotApplyTypeArgsToLambda | TooManyArgsForLambda of lambdaExprId: ID * expected: Int * actual: Int diff --git a/packages/darklang/prettyPrinter/common.dark b/packages/darklang/prettyPrinter/common.dark index 18928abbf6..a0be10d44b 100644 --- a/packages/darklang/prettyPrinter/common.dark +++ b/packages/darklang/prettyPrinter/common.dark @@ -158,11 +158,14 @@ let shortenName let remaining = Stdlib.List.drop fullPath shared // Nothing shared and not ours: an explicit `Stdlib.` prefix still resolves, so drop the owner for - // Darklang's own packages and leave anyone else's fully qualified. + // Darklang's own packages and leave anyone else's fully qualified. `Tests` and `CliScript` come off + // for a different reason: they are scaffolding the parser stamped on, not names anything can be + // reached by, so printing them tells the reader nothing. + let ownerComesOff = + owner == "Darklang" || owner == "Tests" || owner == "CliScript" || owner == "" + let remaining = - if shared == 0 && owner == "Darklang" then - Stdlib.List.drop fullPath 1 - else if shared == 0 && owner == "Tests" then + if shared == 0 && ownerComesOff then Stdlib.List.drop fullPath 1 else remaining diff --git a/packages/darklang/prettyPrinter/runtimeError.dark b/packages/darklang/prettyPrinter/runtimeError.dark index 4e963c66b4..d91639cafe 100644 --- a/packages/darklang/prettyPrinter/runtimeError.dark +++ b/packages/darklang/prettyPrinter/runtimeError.dark @@ -38,6 +38,12 @@ module RuntimeError = | TypeReference of TypeReference | TypeOfValue of Dval // CLEANUP should these all just be ValueTypes? | ValueType of ValueType + /// A value type together with the type reference it was declared as. One + /// content hash can be bound to several names, so the declaration is the + /// only thing that says which of them the author meant. + | DeclaredValueType of + Stdlib.Option.Option * + ValueType | FieldName of String // records and enums | InlineFieldName of String // records and enums @@ -100,6 +106,8 @@ module RuntimeError = | TypeReference t -> typeReference branchId t | TypeOfValue dv -> Dval.valueTypeName branchId dv | ValueType vt -> valueType branchId vt + | DeclaredValueType(declared, vt) -> + declaredValueType branchId declared vt | FieldName f -> $"`{f}`" | InlineFieldName f -> f | VarName v -> $"`{v}`" @@ -303,10 +311,10 @@ module RuntimeError = // ES.TypeName typeName // ES.String " record" ] - | CreationFieldOfWrongType (fieldName, expectedType, actualType, actualValue) -> + | CreationFieldOfWrongType(fieldName, declaredType, expectedType, actualType, actualValue) -> [ ES.String "Failed to create record. " ES.String "Expected " - ES.ValueType expectedType + ES.DeclaredValueType(declaredType, expectedType) ES.String " for field " ES.FieldName fieldName ES.String ", but got " @@ -334,10 +342,10 @@ module RuntimeError = // ES.TypeName typeName // ES.String " record" ] - | UpdateFieldOfWrongType(fieldName, expectedType, actualType, actualValue) -> + | UpdateFieldOfWrongType(fieldName, declaredType, expectedType, actualType, actualValue) -> [ ES.String "Failed to create updated record. " ES.String "Expected " - ES.ValueType expectedType + ES.DeclaredValueType(declaredType, expectedType) ES.String " for field " ES.FieldName fieldName ES.String ", but got " @@ -382,10 +390,10 @@ module RuntimeError = ES.String " in " ES.TypeName typeName ] - | ConstructionFieldOfWrongType (caseName, fieldIndex, expectedType, actualType, actualValue) -> + | ConstructionFieldOfWrongType(caseName, fieldIndex, declaredType, expectedType, actualType, actualValue) -> [ ES.String "Failed to create enum. " ES.String "Expected " - ES.ValueType expectedType + ES.DeclaredValueType(declaredType, expectedType) ES.String " for field " ES.Int fieldIndex ES.String " in " @@ -429,23 +437,23 @@ module RuntimeError = ES.Count(expected, ES.String "argument", ES.String "arguments") ES.String ", but got " ES.Count(actual, ES.String "argument", ES.String "arguments") ] - | FnParameterNotExpectedType(fnName, paramIndex, paramName, expectedType, actualType, actualValue) -> + | FnParameterNotExpectedType(fnName, paramIndex, paramName, declaredType, expectedType, actualType, actualValue) -> [ ES.FunctionName fnName ES.String "'s " ES.Ordinal(paramIndex + 1) ES.String " parameter " ES.ParamName paramName ES.String " expects " - ES.ValueType expectedType + ES.DeclaredValueType(declaredType, expectedType) ES.String ", but got " ES.ValueType actualType ES.String " (" ES.FullValue actualValue ES.String ")" ] - | FnResultNotExpectedType(fnName, expectedType, actualType, actualValue) -> + | FnResultNotExpectedType(fnName, declaredType, expectedType, actualType, actualValue) -> [ ES.FunctionName fnName ES.String "'s return value expects " - ES.ValueType expectedType + ES.DeclaredValueType(declaredType, expectedType) ES.String ", but got " ES.ValueType actualType ES.String " (" diff --git a/packages/darklang/prettyPrinter/runtimeTypes.dark b/packages/darklang/prettyPrinter/runtimeTypes.dark index 773492a437..214bea566b 100644 --- a/packages/darklang/prettyPrinter/runtimeTypes.dark +++ b/packages/darklang/prettyPrinter/runtimeTypes.dark @@ -28,8 +28,14 @@ let packageName let modules = Stdlib.String.join modules "." $"{modules}." + // Owners that are scaffolding rather than a namespace someone chose: a + // testfile's declarations, and the ones a CLI script declares for itself. + // Printing the scaffolding back at the reader is noise, and for a script it is + // worse than noise, since `CliScript` is not a name anything can be reached by. match owner with - | "Tests" -> $"{modulesPart}{name}" + | "" + | "Tests" + | "CliScript" -> $"{modulesPart}{name}" | _ -> $"{owner}.{modulesPart}{name}" /// Given PM locations for a hash, resolve to best display name. @@ -370,6 +376,111 @@ let valueType | Known kt -> knownType branchId kt | Unknown -> "_" + +/// A value type, named the way it was written where it was declared. +/// +/// Two sources, each authoritative about a different thing. The `ValueType` is +/// the authority on shape: it has been through the type symbol table, so where +/// the declaration said `List<'a>` it says `List`. The declared +/// `TypeReference` is the authority on names: a hash bound to one location has +/// one name and needs no help, but bound to several, every one of those names is +/// equally true of the type and choosing between them from the hash is a guess. +/// `Stdlib.Int.ParseError`, `Stdlib.Float.ParseError` and +/// `Stdlib.Uuid.ParseError` are all `| BadFormat`, so they are one type with +/// three names, and an `Int.parse` failure reported as a `Uuid.ParseError` is a +/// real thing this printed. +/// +/// So walk the two together, taking shape from the left and names from the +/// right. They can stop lining up: an alias unwraps to something of a different +/// shape, a type variable resolves to a concrete type, a raise site has no +/// declaration at all. Wherever that happens the declaration is dropped for that +/// subtree and the rest is named canonically, which is the answer +/// gives on its own. +let declaredValueType + (branchId: Uuid) + (declared: Stdlib.Option.Option) + (vt: LanguageTools.RuntimeTypes.ValueType) + : String = + match vt with + | Unknown -> "_" + | Known kt -> declaredKnownType branchId declared kt + + +let declaredKnownType + (branchId: Uuid) + (declared: Stdlib.Option.Option) + (kt: LanguageTools.RuntimeTypes.KnownType) + : String = + // The declared reference for the nth type argument, when the declaration has + // the same shape and so has an nth type argument to give. + let nth + (refs: List) + (i: Int) + : Stdlib.Option.Option = + Stdlib.List.getAt refs i + + match kt, declared with + | KTStream inner, Some(TStream dInner) -> + $"Stream<{declaredValueType branchId (Stdlib.Option.Option.Some dInner) inner}>" + + | KTList inner, Some(TList dInner) -> + $"List<{declaredValueType branchId (Stdlib.Option.Option.Some dInner) inner}>" + + | KTDict inner, Some(TDict dInner) -> + $"Dict<{declaredValueType branchId (Stdlib.Option.Option.Some dInner) inner}>" + + | KTTuple(t1, t2, trest), Some(TTuple(d1, d2, drest)) -> + let items = Stdlib.List.append [ t1; t2 ] trest + let declaredItems = Stdlib.List.append [ d1; d2 ] drest + + if (Stdlib.List.length items) == (Stdlib.List.length declaredItems) then + items + |> Stdlib.List.indexedMap (fun i item -> + declaredValueType branchId (nth declaredItems i) item) + |> Stdlib.String.join " * " + |> fun s -> $"({s})" + else + knownType branchId kt + + | KTFn(argTypes, retType), Some(TFn(dArgTypes, dRetType)) -> + if (Stdlib.List.length argTypes) == (Stdlib.List.length dArgTypes) then + let args = + argTypes + |> Stdlib.List.indexedMap (fun i arg -> + declaredValueType branchId (nth dArgTypes i) arg) + + let ret = + declaredValueType branchId (Stdlib.Option.Option.Some dRetType) retType + + (Stdlib.List.push args ret) |> Stdlib.String.join " -> " + else + knownType branchId kt + + | KTCustomType(Package hash, typeArgs), Some(TCustomType(dName, dTypeArgs)) -> + let typeArgsPortion = + match typeArgs with + | [] -> "" + | args -> + args + |> Stdlib.List.indexedMap (fun i arg -> + declaredValueType branchId (nth dTypeArgs i) arg) + |> Stdlib.String.join ", " + |> fun betweenBrackets -> "<" ++ betweenBrackets ++ ">" + + let locations = Darklang.LanguageTools.PackageManager.Type.locations branchId hash + + let namePart = + resolvePackageHashWithOriginalName + LanguageTools.PackageManager.PickContext.empty + locations + dName.originalName + hash + + namePart ++ typeArgsPortion + + | _, _ -> knownType branchId kt + + let letPattern (pat: LanguageTools.RuntimeTypes.LetPattern) : String = match pat with | LPVariable _reg ->