mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-26 02:55:19 +03:00
Fix update bug #4618
It is not safe to assume everything in the TUF is in namespace - libdeps, it also contains new terms/decls. So, looking up the constructors of a type may now return Nothing, in which case we know that the decl is new and no deleteConstructorActions need to be generated.
This commit is contained in:
parent
df2a53a97f
commit
4af93e9ec0
@ -6,6 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Update2
|
||||
-- * Misc helpers to be organized later
|
||||
addDefinitionsToUnisonFile,
|
||||
findCtorNames,
|
||||
findCtorNamesMaybe,
|
||||
forwardCtorNames,
|
||||
makeParsingEnv,
|
||||
prettyParseTypecheck,
|
||||
@ -142,7 +143,7 @@ handleUpdate2 = do
|
||||
Cli.respond Output.UpdateTypecheckingSuccess
|
||||
pure secondTuf
|
||||
|
||||
saveTuf (findCtorNames Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
|
||||
saveTuf (findCtorNamesMaybe Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
|
||||
Cli.respond Output.Success
|
||||
|
||||
-- TODO: find a better module for this function, as it's used in a couple places
|
||||
@ -182,7 +183,7 @@ makeParsingEnv path names = do
|
||||
}
|
||||
|
||||
-- save definitions and namespace
|
||||
saveTuf :: (Name -> Either Output [Name]) -> TypecheckedUnisonFile Symbol Ann -> Cli ()
|
||||
saveTuf :: (Name -> Either Output (Maybe [Name])) -> TypecheckedUnisonFile Symbol Ann -> Cli ()
|
||||
saveTuf getConstructors tuf = do
|
||||
Cli.Env {codebase} <- ask
|
||||
currentPath <- Cli.getCurrentPath
|
||||
@ -205,7 +206,10 @@ saveTuf getConstructors tuf = do
|
||||
-- [ ("foo.bar", insert-term("baz",<#foo>)) ]
|
||||
typecheckedUnisonFileToBranchUpdates ::
|
||||
(forall void. Output -> Transaction void) ->
|
||||
(Name -> Either Output [Name]) ->
|
||||
-- | Returns 'Nothing' if the decl isn't in namesExcludingLibdeps,
|
||||
-- in which case we know the decl in new and do not need to generate
|
||||
-- delete actions for it.
|
||||
(Name -> Either Output (Maybe [Name])) ->
|
||||
TypecheckedUnisonFile Symbol Ann ->
|
||||
Transaction [(Path, Branch0 m -> Branch0 m)]
|
||||
typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
@ -224,7 +228,7 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
makeDeclUpdates (symbol, (typeRefId, decl)) = do
|
||||
-- some decls will be deleted, we want to delete their
|
||||
-- constructors as well
|
||||
deleteConstructorActions <- case map (BranchUtil.makeAnnihilateTermName . Path.splitFromName) <$> getConstructors (Name.unsafeFromVar symbol) of
|
||||
deleteConstructorActions <- case maybe [] (map (BranchUtil.makeAnnihilateTermName . Path.splitFromName)) <$> getConstructors (Name.unsafeFromVar symbol) of
|
||||
Left err -> abort err
|
||||
Right actions -> pure actions
|
||||
let deleteTypeAction = BranchUtil.makeAnnihilateTypeName split
|
||||
@ -362,9 +366,13 @@ forwardCtorNames names =
|
||||
]
|
||||
|
||||
-- | given a decl name, find names for all of its constructors, in order.
|
||||
--
|
||||
-- Precondition: 'n' is an element of 'names'
|
||||
findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
|
||||
findCtorNames operation names forwardCtorNames ctorCount n =
|
||||
let declRef = Set.findMin $ Relation.lookupDom n names.types
|
||||
let declRef = case Set.lookupMin (Relation.lookupDom n names.types) of
|
||||
Nothing -> error "[findCtorNames] precondition violation: n is not an element of names"
|
||||
Just x -> x
|
||||
f = ForwardName.fromName n
|
||||
(_, centerRight) = Map.split f forwardCtorNames
|
||||
(center, _) = Map.split (incrementLastSegmentChar f) centerRight
|
||||
@ -384,6 +392,18 @@ findCtorNames operation names forwardCtorNames ctorCount n =
|
||||
then Right $ Map.elems m
|
||||
else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount
|
||||
|
||||
findCtorNamesMaybe ::
|
||||
Output.UpdateOrUpgrade ->
|
||||
Names ->
|
||||
Map ForwardName (Referent, Name) ->
|
||||
Maybe Int ->
|
||||
Name ->
|
||||
Either Output.Output (Maybe [Name])
|
||||
findCtorNamesMaybe operation names forwardCtorNames ctorCount name =
|
||||
case Relation.memberDom name (Names.types names) of
|
||||
True -> Just <$> findCtorNames operation names forwardCtorNames ctorCount name
|
||||
False -> Right Nothing
|
||||
|
||||
-- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly.
|
||||
-- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux"
|
||||
-- ForwardName {toList = "foo" :| ["bar","quuy"]}
|
||||
|
@ -25,6 +25,7 @@ import Unison.Codebase.Editor.HandleInput.Branch qualified as HandleInput.Branch
|
||||
import Unison.Codebase.Editor.HandleInput.Update2
|
||||
( addDefinitionsToUnisonFile,
|
||||
findCtorNames,
|
||||
findCtorNamesMaybe,
|
||||
forwardCtorNames,
|
||||
getNamespaceDependentsOf,
|
||||
makeComplicatedPPE,
|
||||
@ -200,7 +201,7 @@ handleUpgrade oldDepName newDepName = do
|
||||
Codebase.addDefsToCodebase codebase typecheckedUnisonFile
|
||||
typecheckedUnisonFileToBranchUpdates
|
||||
abort
|
||||
(findCtorNames Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
|
||||
(findCtorNamesMaybe Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
|
||||
typecheckedUnisonFile
|
||||
Cli.stepAt
|
||||
textualDescriptionOfUpgrade
|
||||
|
60
unison-src/transcripts/fix4618.output.md
Normal file
60
unison-src/transcripts/fix4618.output.md
Normal file
@ -0,0 +1,60 @@
|
||||
```unison
|
||||
foo = 5
|
||||
unique type Bugs.Zonk = Bugs
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
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`:
|
||||
|
||||
type Bugs.Zonk
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type Bugs.Zonk
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```unison
|
||||
foo = 4
|
||||
unique type Bugs =
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
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`:
|
||||
|
||||
type Bugs
|
||||
|
||||
⍟ These names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
.> update
|
||||
|
||||
Okay, I'm searching the branch for code that needs to be
|
||||
updated...
|
||||
|
||||
Done.
|
||||
|
||||
```
|
Loading…
Reference in New Issue
Block a user