From ee758a2e22194ec903d1c8f4e06c21ca51f695a1 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 5 Dec 2023 12:36:32 -0500 Subject: [PATCH 1/3] adjust upgrade PPE to fix alias mishap bug previously, any alias of an "old" thing would essentially prevent it from being updated to the new corresponding thing. this patch attempts to solve that problem by adjusting the PPE we use to print things --- .../src/Unison/PrettyPrintEnv/Names.hs | 16 +++- .../tests/Unison/Core/Test/Name.hs | 12 +-- .../Codebase/Editor/HandleInput/Upgrade.hs | 93 ++++++++++++++----- unison-core/src/Unison/Name.hs | 14 +-- 4 files changed, 94 insertions(+), 41 deletions(-) diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs index bc09a0d3bd..3989a91b38 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs @@ -1,6 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -module Unison.PrettyPrintEnv.Names (fromNames, fromSuffixNames) where +module Unison.PrettyPrintEnv.Names + ( fromNames, + fromSuffixNames, + prioritize, + shortestUniqueSuffixes, + ) +where import Data.Set qualified as Set import Unison.HashQualified' qualified as HQ' @@ -46,16 +52,16 @@ fromSuffixNames len names = PrettyPrintEnv terms' types' NamesWithHistory.termName len r names & Set.toList & fmap (\n -> (n, n)) - & shortestUniqueSuffixes r (Names.terms $ NamesWithHistory.currentNames names) + & shortestUniqueSuffixes (Names.terms $ NamesWithHistory.currentNames names) & prioritize types' r = NamesWithHistory.typeName len r names & Set.toList & fmap (\n -> (n, n)) - & shortestUniqueSuffixes r (Names.types $ NamesWithHistory.currentNames names) + & shortestUniqueSuffixes (Names.types $ NamesWithHistory.currentNames names) & prioritize -- | Reduce the provided names to their minimal unique suffix within the scope of the given -- relation. -shortestUniqueSuffixes :: (Ord ref) => ref -> Rel.Relation Name ref -> [(a, HQ'.HashQualified Name)] -> [(a, HQ'.HashQualified Name)] -shortestUniqueSuffixes ref rel names = names <&> second (fmap (\name -> Name.shortestUniqueSuffix name ref rel)) +shortestUniqueSuffixes :: (Ord ref) => Rel.Relation Name ref -> [(a, HQ'.HashQualified Name)] -> [(a, HQ'.HashQualified Name)] +shortestUniqueSuffixes rel names = names <&> second (fmap (\name -> Name.shortestUniqueSuffix name rel)) diff --git a/parser-typechecker/tests/Unison/Core/Test/Name.hs b/parser-typechecker/tests/Unison/Core/Test/Name.hs index d64c7d296b..0776d9bc3e 100644 --- a/parser-typechecker/tests/Unison/Core/Test/Name.hs +++ b/parser-typechecker/tests/Unison/Core/Test/Name.hs @@ -92,24 +92,24 @@ testSuffixSearch = (Name.searchBySuffix (n "map") rel) expectEqual' (n "List.map") - (Name.shortestUniqueSuffix (n "base.List.map") 1 rel) + (Name.shortestUniqueSuffix (n "base.List.map") rel) expectEqual' (n "Set.map") - (Name.shortestUniqueSuffix (n "base.Set.map") 2 rel) + (Name.shortestUniqueSuffix (n "base.Set.map") rel) expectEqual' (n "baz") - (Name.shortestUniqueSuffix (n "foo.bar.baz") 3 rel) + (Name.shortestUniqueSuffix (n "foo.bar.baz") rel) expectEqual' (n "a.b.c") - (Name.shortestUniqueSuffix (n "a.b.c") 3 rel) + (Name.shortestUniqueSuffix (n "a.b.c") rel) expectEqual' (n "a1.b.c") - (Name.shortestUniqueSuffix (n "a1.b.c") 3 rel) + (Name.shortestUniqueSuffix (n "a1.b.c") rel) note . show $ Name.reverseSegments (n ".") note . show $ Name.reverseSegments (n "..") tests [ scope "(.) shortest unique suffix" $ - expectEqual' (n ".") (Name.shortestUniqueSuffix (n "..") 6 rel), + expectEqual' (n ".") (Name.shortestUniqueSuffix (n "..") rel), scope "(.) search by suffix" $ expectEqual' (Set.fromList [6]) (Name.searchBySuffix (n ".") rel) ] diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index 271a57d7e5..b6a02722b2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -33,17 +33,23 @@ import Unison.Codebase.Editor.HandleInput.Update2 ) import Unison.Codebase.Editor.Output qualified as Output import Unison.Codebase.Path qualified as Path +import Unison.HashQualified' qualified as HQ' import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) import Unison.NameSegment qualified as NameSegment +import Unison.Names (Names (..)) import Unison.Names qualified as Names import Unison.NamesWithHistory qualified as NamesWithHistory import Unison.Prelude +import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) +import Unison.PrettyPrintEnv.Names qualified as PPE.Names +import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED (addFallback) import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project (ProjectAndBranch (..), ProjectBranchName) import Unison.Sqlite (Transaction) import Unison.UnisonFile qualified as UnisonFile +import Unison.Util.Relation qualified as Relation import Witch (unsafeFrom) handleUpgrade :: NameSegment -> NameSegment -> Cli () @@ -61,14 +67,12 @@ handleUpgrade oldDepName newDepName = do currentV1Branch <- Cli.getBranch0At projectPath let currentV1BranchWithoutOldDep = deleteLibdep oldDepName currentV1Branch - let currentV1BranchWithoutOldAndNewDeps = deleteLibdep newDepName currentV1BranchWithoutOldDep oldDepV1Branch <- Cli.expectBranch0AtPath' oldDepPath _newDepV1Branch <- Cli.expectBranch0AtPath' newDepPath let namesExcludingLibdeps = Branch.toNames (currentV1Branch & over Branch.children (Map.delete Name.libSegment)) let constructorNamesExcludingLibdeps = forwardCtorNames namesExcludingLibdeps let namesExcludingOldDep = Branch.toNames currentV1BranchWithoutOldDep - let namesExcludingOldAndNewDeps = Branch.toNames currentV1BranchWithoutOldAndNewDeps -- High-level idea: we are trying to perform substitution in every term that depends on something in `old` with the -- corresponding thing in `new`, by first rendering the user's code with a particular pretty-print environment, then @@ -113,27 +117,9 @@ handleUpgrade oldDepName newDepName = do dependents UnisonFile.emptyUnisonFile hashLength <- Codebase.hashLength - let namesToPPED = PPED.fromNamesDecl hashLength . NamesWithHistory.fromCurrentNames - let printPPE1 = namesToPPED namesExcludingOldDep - -- These "fake names" are all of things in `lib.old`, with the `old` segment swapped out for `new` - -- - -- If we fall back to this second PPE, we know we have a reference in `fakeNames` (i.e. a reference originally - -- from `old`, and found nowhere else in our project+libdeps), but we have to include - -- `namesExcludingOldAndNewDeps` as well, so that we don't over-suffixify. - -- - -- For example, consider the names - -- - -- #old = lib.new.foobaloo - -- #thing = my.project.foobaloo - -- - -- Were we to fall back on this PPE looking up a name for #old, we'd not want to return "foobaloo", but rather - -- "new.foobaloo". - let fakeNames = - oldDepV1Branch - & Branch.toNames - & Names.prefix0 (Name.fromReverseSegments (newDepName :| [Name.libSegment])) - let printPPE2 = namesToPPED (namesExcludingOldAndNewDeps <> fakeNames) - pure (unisonFile, printPPE1 `PPED.addFallback` printPPE2) + let primaryPPE = makeOldDepPPE newDepName namesExcludingOldDep oldDepV1Branch + let secondaryPPE = PPED.fromNamesDecl hashLength (NamesWithHistory.fromCurrentNames namesExcludingOldDep) + pure (unisonFile, primaryPPE `PPED.addFallback` secondaryPPE) parsingEnv <- makeParsingEnv projectPath namesExcludingOldDep typecheckedUnisonFile <- @@ -172,6 +158,67 @@ handleUpgrade oldDepName newDepName = do textualDescriptionOfUpgrade = Text.unwords ["upgrade", NameSegment.toText oldDepName, NameSegment.toText newDepName] +makeOldDepPPE :: NameSegment -> Names -> Branch0 m -> PrettyPrintEnvDecl +makeOldDepPPE newDepName namesExcludingOldDep oldDepV1Branch = + PrettyPrintEnvDecl + { unsuffixifiedPPE = + let termNames ref = + if Set.member ref termsDirectlyInOldDep + then + Names.namesForReferent fakeNames ref + & Set.toList + & map (\name -> (HQ'.fromName name, HQ'.fromName name)) + & PPE.Names.prioritize + else [] + typeNames ref = + if Set.member ref typesDirectlyInOldDep + then + Names.namesForReference fakeNames ref + & Set.toList + & map (\name -> (HQ'.fromName name, HQ'.fromName name)) + & PPE.Names.prioritize + else [] + in PrettyPrintEnv {termNames, typeNames}, + suffixifiedPPE = + let termNames ref = + if Set.member ref termsDirectlyInOldDep + then + Names.namesForReferent fakeNames ref + & Set.toList + & map (\name -> (HQ'.fromName name, HQ'.fromName name)) + & PPE.Names.shortestUniqueSuffixes bogusoidTermNames + & PPE.Names.prioritize + else [] + typeNames ref = + if Set.member ref typesDirectlyInOldDep + then + Names.namesForReference fakeNames ref + & Set.toList + & map (\name -> (HQ'.fromName name, HQ'.fromName name)) + & PPE.Names.shortestUniqueSuffixes bogusoidTypeNames + & PPE.Names.prioritize + else [] + in PrettyPrintEnv {termNames, typeNames} + } + where + oldDepMinusItsDepsV1Branch = over Branch.children (Map.delete Name.libSegment) oldDepV1Branch + termsDirectlyInOldDep = Branch.deepReferents oldDepMinusItsDepsV1Branch + typesDirectlyInOldDep = Branch.deepTypeReferences oldDepMinusItsDepsV1Branch + fakeNames = + oldDepMinusItsDepsV1Branch + & Branch.toNames + & Names.prefix0 (Name.fromReverseSegments (newDepName :| [Name.libSegment])) + bogusoidTermNames = + namesExcludingOldDep + & Names.terms + & Relation.subtractRan termsDirectlyInOldDep + & Relation.union (Names.terms fakeNames) + bogusoidTypeNames = + namesExcludingOldDep + & Names.types + & Relation.subtractRan typesDirectlyInOldDep + & Relation.union (Names.types fakeNames) + -- @findTemporaryBranchName projectId oldDepName newDepName@ finds some unused branch name in @projectId@ with a name -- like "upgrade--to-". findTemporaryBranchName :: ProjectId -> NameSegment -> NameSegment -> Transaction ProjectBranchName diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index a891fffd14..5b48ddc9e6 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -481,23 +481,23 @@ unqualified :: Name -> Name unqualified (Name _ (s :| _)) = Name Relative (s :| []) --- Tries to shorten `fqn` to the smallest suffix that still refers --- to to `r`. Uses an efficient logarithmic lookup in the provided relation. +-- Tries to shorten `fqn` to the smallest suffix that still refers the same references. +-- Uses an efficient logarithmic lookup in the provided relation. -- The returned `Name` may refer to multiple hashes if the original FQN -- did as well. -- -- NB: Only works if the `Ord` instance for `Name` orders based on -- `Name.reverseSegments`. -shortestUniqueSuffix :: forall r. (Ord r) => Name -> r -> R.Relation Name r -> Name -shortestUniqueSuffix fqn r rel = +shortestUniqueSuffix :: forall r. (Ord r) => Name -> R.Relation Name r -> Name +shortestUniqueSuffix fqn rel = fromMaybe fqn (List.find isOk (suffixes' fqn)) where - allowed :: Set r - allowed = + allRefs :: Set r + allRefs = R.lookupDom fqn rel isOk :: Name -> Bool isOk suffix = - (Set.size rs == 1 && Set.findMin rs == r) || rs == allowed + Set.size rs == 1 || rs == allRefs where rs :: Set r rs = From 2d082f87edd5b93ae696d730b686b27e8e2d469b Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Tue, 5 Dec 2023 17:11:26 -0500 Subject: [PATCH 2/3] add a transcript and some comments --- .../Codebase/Editor/HandleInput/Upgrade.hs | 128 +++++++++++------- .../transcripts/upgrade-with-old-alias.md | 18 +++ .../upgrade-with-old-alias.output.md | 41 ++++++ 3 files changed, 139 insertions(+), 48 deletions(-) create mode 100644 unison-src/transcripts/upgrade-with-old-alias.md create mode 100644 unison-src/transcripts/upgrade-with-old-alias.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index b6a02722b2..63033108db 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs @@ -141,12 +141,13 @@ handleUpgrade oldDepName newDepName = do Cli.respond (Output.UpgradeFailure oldDepName newDepName) Cli.returnEarlyWithoutOutput - branchUpdates <- Cli.runTransactionWithRollback \abort -> do - Codebase.addDefsToCodebase codebase typecheckedUnisonFile - typecheckedUnisonFileToBranchUpdates - abort - (findCtorNames namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing) - typecheckedUnisonFile + branchUpdates <- + Cli.runTransactionWithRollback \abort -> do + Codebase.addDefsToCodebase codebase typecheckedUnisonFile + typecheckedUnisonFileToBranchUpdates + abort + (findCtorNames namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing) + typecheckedUnisonFile Cli.stepAt textualDescriptionOfUpgrade ( Path.unabsolute projectPath, @@ -158,66 +159,97 @@ handleUpgrade oldDepName newDepName = do textualDescriptionOfUpgrade = Text.unwords ["upgrade", NameSegment.toText oldDepName, NameSegment.toText newDepName] +-- `makeOldDepPPE newDepName namesExcludingOldDep oldDepBranch` makes a PPE(D) that only knows how to render `old` deps; +-- other names should be provided by some fallback PPE. +-- +-- How we render `old` deps is rather subtle and complicated, but the basic idea is that an `upgrade old new` ought to +-- render all of the old things like `lib.old.foo#oldfoo` as `lib.new.foo` to be parsed and typechecked. +-- +-- To render some reference #foo, if it's not a reference that's directly part of old's API (i.e. it has some name in +-- `lib.old.*` that isn't in one of old's deps `lib.old.lib.*`, then return the empty list of names. (Again, the +-- fallback PPE will ultimately provide a name for such a #foo). +-- +-- Otherwise, we have some #foo that has at least one name in `lib.old.*`; say it's called `lib.old.foo`. The goal is to +-- render this as `lib.new.foo`, regardless of how many other aliases #foo has in the namespace. (It may be the case +-- that #foo has a name outside of the libdeps, like `my.name.for.foo`, or maybe it has a name in another dependency +-- entirely, like `lib.otherdep.othername`). makeOldDepPPE :: NameSegment -> Names -> Branch0 m -> PrettyPrintEnvDecl -makeOldDepPPE newDepName namesExcludingOldDep oldDepV1Branch = - PrettyPrintEnvDecl - { unsuffixifiedPPE = - let termNames ref = - if Set.member ref termsDirectlyInOldDep - then - Names.namesForReferent fakeNames ref - & Set.toList - & map (\name -> (HQ'.fromName name, HQ'.fromName name)) - & PPE.Names.prioritize - else [] - typeNames ref = - if Set.member ref typesDirectlyInOldDep - then - Names.namesForReference fakeNames ref - & Set.toList - & map (\name -> (HQ'.fromName name, HQ'.fromName name)) - & PPE.Names.prioritize - else [] - in PrettyPrintEnv {termNames, typeNames}, - suffixifiedPPE = - let termNames ref = +makeOldDepPPE newDepName namesExcludingOldDep oldDepBranch = + let makePPE suffixifyTerms suffixifyTypes = + PrettyPrintEnv + { termNames = \ref -> if Set.member ref termsDirectlyInOldDep then + -- Say ref is #oldfoo, with two names in `old`: + -- + -- [ lib.old.foo, lib.old.fooalias ] + -- + -- We start from that same list of names with `new` swapped in for `old`: + -- + -- [ lib.new.foo, lib.new.fooalias ] Names.namesForReferent fakeNames ref & Set.toList + -- We manually lift those to hashless hash-qualified names, which isn't a very significant + -- implementation detail, we just happen to not want hashes, even if the old name like "lib.old.foo" + -- was conflicted in `old`. & map (\name -> (HQ'.fromName name, HQ'.fromName name)) - & PPE.Names.shortestUniqueSuffixes bogusoidTermNames + -- We find the shortest unique suffix of each name in a naming context which: + -- + -- 1. Starts from all names, minus the entire `lib.old` namespace. + -- + -- 2. Deletes every name for references directly in `lib.old` (i.e. in `lib.old.*` without having + -- to descend into some `lib.old.lib.*`. + -- + -- For example, if there's both + -- + -- lib.old.foo#oldfoo + -- someAlias#oldfoo + -- + -- then (again, because #oldfoo has a name directly in `lib.old`), we delete names like + -- `someAlias#oldfoo`. + -- + -- 3. Adds back in names like `lib.new.*` for every hash directly referenced in `lib.old.*`, which + -- would be + -- + -- [ lib.new.foo#oldfoo, lib.new.fooalias#oldfoo ] + & suffixifyTerms & PPE.Names.prioritize - else [] - typeNames ref = + else [], + typeNames = \ref -> if Set.member ref typesDirectlyInOldDep then Names.namesForReference fakeNames ref & Set.toList & map (\name -> (HQ'.fromName name, HQ'.fromName name)) - & PPE.Names.shortestUniqueSuffixes bogusoidTypeNames + & suffixifyTypes & PPE.Names.prioritize else [] - in PrettyPrintEnv {termNames, typeNames} - } + } + in PrettyPrintEnvDecl + { unsuffixifiedPPE = makePPE id id, + suffixifiedPPE = + makePPE + ( PPE.Names.shortestUniqueSuffixes $ + namesExcludingOldDep + & Names.terms + & Relation.subtractRan termsDirectlyInOldDep + & Relation.union (Names.terms fakeNames) + ) + ( PPE.Names.shortestUniqueSuffixes $ + namesExcludingOldDep + & Names.types + & Relation.subtractRan typesDirectlyInOldDep + & Relation.union (Names.types fakeNames) + ) + } where - oldDepMinusItsDepsV1Branch = over Branch.children (Map.delete Name.libSegment) oldDepV1Branch - termsDirectlyInOldDep = Branch.deepReferents oldDepMinusItsDepsV1Branch - typesDirectlyInOldDep = Branch.deepTypeReferences oldDepMinusItsDepsV1Branch + oldDepWithoutItsDeps = over Branch.children (Map.delete Name.libSegment) oldDepBranch + termsDirectlyInOldDep = Branch.deepReferents oldDepWithoutItsDeps + typesDirectlyInOldDep = Branch.deepTypeReferences oldDepWithoutItsDeps fakeNames = - oldDepMinusItsDepsV1Branch + oldDepWithoutItsDeps & Branch.toNames & Names.prefix0 (Name.fromReverseSegments (newDepName :| [Name.libSegment])) - bogusoidTermNames = - namesExcludingOldDep - & Names.terms - & Relation.subtractRan termsDirectlyInOldDep - & Relation.union (Names.terms fakeNames) - bogusoidTypeNames = - namesExcludingOldDep - & Names.types - & Relation.subtractRan typesDirectlyInOldDep - & Relation.union (Names.types fakeNames) -- @findTemporaryBranchName projectId oldDepName newDepName@ finds some unused branch name in @projectId@ with a name -- like "upgrade--to-". diff --git a/unison-src/transcripts/upgrade-with-old-alias.md b/unison-src/transcripts/upgrade-with-old-alias.md new file mode 100644 index 0000000000..c251fd8d61 --- /dev/null +++ b/unison-src/transcripts/upgrade-with-old-alias.md @@ -0,0 +1,18 @@ +```ucm:hide +.> project.create-empty myproject +myproject/main> builtins.merge +myproject/main> move.namespace builtin lib.builtin +``` + +```unison +lib.old.foo = 141 +lib.new.foo = 142 +bar = 141 +mything = lib.old.foo + 100 +``` + +```ucm +myproject/main> update +myproject/main> upgrade old new +myproject/main> view mything +``` diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md new file mode 100644 index 0000000000..b8e88a11a8 --- /dev/null +++ b/unison-src/transcripts/upgrade-with-old-alias.output.md @@ -0,0 +1,41 @@ +```unison +lib.old.foo = 141 +lib.new.foo = 142 +bar = 141 +mything = lib.old.foo + 100 +``` + +```ucm + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + bar : Nat + lib.new.foo : Nat + lib.old.foo : Nat + mything : Nat + +``` +```ucm +myproject/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +myproject/main> upgrade old new + + I upgraded old to new, and removed old. + +myproject/main> view mything + + mything : Nat + mything = + use Nat + + foo + 100 + +``` From aa0ef5eee27f1c3bb3bb3bae3bb54201cf1acf40 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 6 Dec 2023 12:20:01 -0500 Subject: [PATCH 3/3] tweak transcript --- unison-src/transcripts/upgrade-with-old-alias.md | 1 + unison-src/transcripts/upgrade-with-old-alias.output.md | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/unison-src/transcripts/upgrade-with-old-alias.md b/unison-src/transcripts/upgrade-with-old-alias.md index c251fd8d61..1b2af98103 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.md +++ b/unison-src/transcripts/upgrade-with-old-alias.md @@ -15,4 +15,5 @@ mything = lib.old.foo + 100 myproject/main> update myproject/main> upgrade old new myproject/main> view mything +myproject/main> view bar ``` diff --git a/unison-src/transcripts/upgrade-with-old-alias.output.md b/unison-src/transcripts/upgrade-with-old-alias.output.md index b8e88a11a8..42ef72ff0b 100644 --- a/unison-src/transcripts/upgrade-with-old-alias.output.md +++ b/unison-src/transcripts/upgrade-with-old-alias.output.md @@ -38,4 +38,9 @@ myproject/main> view mything use Nat + foo + 100 +myproject/main> view bar + + bar : Nat + bar = 141 + ```