diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index ba382842b..ceee0aa83 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -138,6 +138,7 @@ import Unison.Util.SyntaxText (SyntaxText') import Unison.Var (Var) import Witch (unsafeFrom) import Prelude hiding (unzip, zip, zipWith) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup) handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do @@ -245,7 +246,7 @@ doMerge info = do done (Output.MergeDefnsInLib who) -- Load Alice/Bob/LCA definitions and decl name lookups - (defns3, declNameLookups, lcaDeclToConstructors) <- do + (defns3, declNameLookups, lcaDeclNameLookup) <- do let emptyNametree = Nametree {value = Defns Map.empty Map.empty, children = Map.empty} let loadDefns branch = Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName -> @@ -270,20 +271,20 @@ doMerge info = do (aliceDefns0, aliceDeclNameLookup) <- load (Just (mergeTarget, branches.alice)) (bobDefns0, bobDeclNameLookup) <- load (Just (mergeSource, branches.bob)) lcaDefns0 <- maybe (pure emptyNametree) loadDefns branches.lca - lcaDeclToConstructors <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) + lcaDeclNameLookup <- Cli.runTransaction (lenientCheckDeclCoherency db.loadDeclNumConstructors lcaDefns0) let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns) let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0} let declNameLookups = TwoWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup} - pure (defns3, declNameLookups, lcaDeclToConstructors) + pure (defns3, declNameLookups, lcaDeclNameLookup) let defns = ThreeWay.forgetLca defns3 - liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclToConstructors) + liftIO (debugFunctions.debugDefns defns3 declNameLookups lcaDeclNameLookup) -- Diff LCA->Alice and LCA->Bob - diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns3) + diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns3) liftIO (debugFunctions.debugDiffs diffs) @@ -1038,7 +1039,7 @@ data DebugFunctions = DebugFunctions debugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> IO (), debugDiffs :: TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) -> IO (), debugCombinedDiff :: DefnsF2 (Map Name) CombinedDiffOp Referent TypeReference -> IO (), @@ -1080,7 +1081,7 @@ realDebugCausals causals = do realDebugDefns :: ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> IO () realDebugDefns defns declNameLookups _lcaDeclNameLookup = do Text.putStrLn (Text.bold "\n=== Alice definitions ===") @@ -1200,28 +1201,28 @@ realDebugPartitionedDiff conflicts unconflicts = do renderConflicts "typeid" conflicts.bob.types (Bob ()) Text.putStrLn (Text.bold "\n=== Alice unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice (OnlyAlice ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.alice (OnlyAlice ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.alice (OnlyAlice ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.alice (OnlyAlice ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.alice (OnlyAlice ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.alice (OnlyAlice ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.alice + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.alice + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.alice + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.alice + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.alice + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.alice Text.putStrLn (Text.bold "\n=== Bob unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.bob (OnlyBob ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.bob (OnlyBob ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.bob (OnlyBob ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.bob (OnlyBob ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.bob (OnlyBob ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.bob (OnlyBob ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.bob + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.bob + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.bob + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.bob + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.bob + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.bob Text.putStrLn (Text.bold "\n=== Alice-and-Bob unconflicts ===") - renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.both (AliceAndBob ()) - renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.both (AliceAndBob ()) - renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.both (AliceAndBob ()) - renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.both (AliceAndBob ()) - renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both (AliceAndBob ()) - renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both (AliceAndBob ()) + renderUnconflicts Text.green "+" referentLabel Referent.toText unconflicts.terms.adds.both + renderUnconflicts Text.green "+" (const "type") Reference.toText unconflicts.types.adds.both + renderUnconflicts Text.red "-" referentLabel Referent.toText unconflicts.terms.deletes.both + renderUnconflicts Text.red "-" (const "type") Reference.toText unconflicts.types.deletes.both + renderUnconflicts Text.yellow "%" referentLabel Referent.toText unconflicts.terms.updates.both + renderUnconflicts Text.yellow "%" (const "type") Reference.toText unconflicts.types.updates.both where renderConflicts :: Text -> Map Name Reference.Id -> EitherWay () -> IO () renderConflicts label conflicts who = @@ -1244,9 +1245,8 @@ realDebugPartitionedDiff conflicts unconflicts = do (ref -> Text) -> (ref -> Text) -> Map Name ref -> - EitherWayI () -> IO () - renderUnconflicts color action label renderRef unconflicts who = + renderUnconflicts color action label renderRef unconflicts = for_ (Map.toList unconflicts) \(name, ref) -> Text.putStrLn $ color $ @@ -1257,9 +1257,6 @@ realDebugPartitionedDiff conflicts unconflicts = do <> Name.toText name <> " " <> renderRef ref - <> " (" - <> (case who of OnlyAlice () -> "Alice"; OnlyBob () -> "Bob"; AliceAndBob () -> "Alice and Bob") - <> ")" realDebugDependents :: TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) -> IO () realDebugDependents dependents = do diff --git a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs index a215354b3..2a75252fc 100644 --- a/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs +++ b/unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs @@ -104,6 +104,7 @@ import U.Codebase.Reference (Reference' (..), TypeReference, TypeReferenceId) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.Merge.DeclNameLookup (DeclNameLookup (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment) @@ -217,21 +218,21 @@ checkDeclCoherency loadDeclNumConstructors = fullName name = Name.fromReverseSegments (name :| prefix) --- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns a mapping from decl name to --- constructor names, where constructor names can be missing. +-- | A lenient variant of 'checkDeclCoherency' - so lenient it can't even fail! It returns partial decl name lookup, +-- which doesn't require a name for every constructor, and allows a constructor with a nameless decl. -- --- This function exists merely to extract a best-effort decl-name-to-constructor-name mapping for the LCA of a merge. --- We require Alice and Bob to have coherent decls, but their LCA is out of the user's control and may have incoherent --- decls, and whether or not it does, we still need to compute *some* syntactic hash for its decls. +-- This function exists merely to extract a best-effort name mapping for the LCA of a merge. We require Alice and Bob to +-- have coherent decls, but their LCA is out of the user's control and may have incoherent decls, and whether or not it +-- does, we still need to compute *some* syntactic hash for its decls. lenientCheckDeclCoherency :: forall m. Monad m => (TypeReferenceId -> m Int) -> Nametree (DefnsF (Map NameSegment) Referent TypeReference) -> - m (Map Name [Maybe Name]) + m PartialDeclNameLookup lenientCheckDeclCoherency loadDeclNumConstructors = - fmap (view #declToConstructors) - . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty Map.empty) + fmap (view #declNameLookup) + . (`State.execStateT` LenientDeclCoherencyCheckState Map.empty (PartialDeclNameLookup Map.empty Map.empty)) . go [] where go :: @@ -259,14 +260,14 @@ lenientCheckDeclCoherency loadDeclNumConstructors = lift (getCompose (Map.upsertF (\_ -> Compose recordNewDecl) typeRef state.expectedConstructors)) case whatHappened of UninhabitedDecl -> do - #declToConstructors %= Map.insert typeName [] + #declNameLookup . #declToConstructors %= Map.insert typeName [] pure Nothing InhabitedDecl expectedConstructors1 -> do let child = Map.findWithDefault (Nametree (Defns Map.empty Map.empty) Map.empty) name children #expectedConstructors .= expectedConstructors1 go (name : prefix) child state <- State.get - let (maybeConstructorNames, expectedConstructors) = + let (constructorNames0, expectedConstructors) = Map.alterF f typeRef state.expectedConstructors where f :: @@ -278,8 +279,21 @@ lenientCheckDeclCoherency loadDeclNumConstructors = fromJust >>> Map.deleteLookupJust typeName >>> over _2 \m -> if Map.null m then Nothing else Just m + + constructorNames :: [Maybe Name] + constructorNames = + IntMap.elems constructorNames0 + #expectedConstructors .= expectedConstructors - #declToConstructors %= Map.insert typeName (IntMap.elems maybeConstructorNames) + #declNameLookup . #constructorToDecl %= \constructorToDecl -> + List.foldl' + ( \acc -> \case + Nothing -> acc + Just constructorName -> Map.insert constructorName typeName acc + ) + constructorToDecl + constructorNames + #declNameLookup . #declToConstructors %= Map.insert typeName constructorNames pure (Just name) where typeName = fullName name @@ -298,7 +312,7 @@ data DeclCoherencyCheckState = DeclCoherencyCheckState data LenientDeclCoherencyCheckState = LenientDeclCoherencyCheckState { expectedConstructors :: !(Map TypeReferenceId (Map Name ConstructorNames)), - declToConstructors :: !(Map Name [Maybe Name]) + declNameLookup :: !PartialDeclNameLookup } deriving stock (Generic) diff --git a/unison-merge/src/Unison/Merge/Diff.hs b/unison-merge/src/Unison/Merge/Diff.hs index 754b36be7..1ad67238a 100644 --- a/unison-merge/src/Unison/Merge/Diff.hs +++ b/unison-merge/src/Unison/Merge/Diff.hs @@ -9,6 +9,7 @@ import Data.Semialign (alignWith) import Data.Set qualified as Set import Data.These (These (..)) import U.Codebase.Reference (TypeReference) +import Unison.ConstructorReference (GConstructorReference (..)) import Unison.DataDeclaration (Decl) import Unison.DataDeclaration qualified as DataDeclaration import Unison.Hash (Hash (Hash)) @@ -17,6 +18,7 @@ import Unison.Merge.Database (MergeDatabase (..)) import Unison.Merge.DeclNameLookup (DeclNameLookup) import Unison.Merge.DeclNameLookup qualified as DeclNameLookup import Unison.Merge.DiffOp (DiffOp (..)) +import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..)) import Unison.Merge.Synhash import Unison.Merge.Synhashed (Synhashed (..)) import Unison.Merge.ThreeWay (ThreeWay (..)) @@ -30,6 +32,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv (..)) import Unison.PrettyPrintEnv qualified as Ppe import Unison.Reference (Reference' (..), TypeReferenceId) import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Sqlite (Transaction) import Unison.Symbol (Symbol) import Unison.Syntax.Name qualified as Name @@ -48,52 +51,14 @@ import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith) nameBasedNamespaceDiff :: MergeDatabase -> TwoWay DeclNameLookup -> - Map Name [Maybe Name] -> + PartialDeclNameLookup -> ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) -> Transaction (TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)) -nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do - lcaHashes <- - synhashDefnsWith - hashTerm - ( \name -> \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> - case sequence (lcaDeclToConstructors Map.! name) of - -- If we don't have a name for every constructor, that's okay, just use a dummy syntactic hash here. - -- This is safe; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk - -- that we accidentally get an equal hash and classify a real update as unchanged. - Nothing -> pure (Hash mempty) - Just names -> do - decl <- loadDeclWithGoodConstructorNames names ref - pure (synhashDerivedDecl ppe name decl) - ) - defns.lca - hashes <- sequence (synhashDefns <$> declNameLookups <*> ThreeWay.forgetLca defns) +nameBasedNamespaceDiff db declNameLookups lcaDeclNameLookup defns = do + lcaHashes <- synhashLcaDefns db ppe lcaDeclNameLookup defns.lca + hashes <- sequence (synhashDefns db ppe <$> declNameLookups <*> ThreeWay.forgetLca defns) pure (diffNamespaceDefns lcaHashes <$> hashes) where - synhashDefns :: - DeclNameLookup -> - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) - synhashDefns declNameLookup = - -- FIXME: use cache so we only synhash each thing once - synhashDefnsWith hashTerm hashType - where - hashType :: Name -> TypeReference -> Transaction Hash - hashType name = \case - ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) - ReferenceDerived ref -> do - decl <- loadDeclWithGoodConstructorNames (DeclNameLookup.expectConstructorNames declNameLookup name) ref - pure (synhashDerivedDecl ppe name decl) - - loadDeclWithGoodConstructorNames :: [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) - loadDeclWithGoodConstructorNames names = - fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl - - hashTerm :: Referent -> Transaction Hash - hashTerm = - synhashTerm db.loadV1Term ppe - ppe :: PrettyPrintEnv ppe = -- The order between Alice and Bob isn't important here for syntactic hashing; not sure right now if it matters @@ -102,6 +67,71 @@ nameBasedNamespaceDiff db declNameLookups lcaDeclToConstructors defns = do `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.bob `Ppe.addFallback` deepNamespaceDefinitionsToPpe defns.lca +synhashLcaDefns :: + MergeDatabase -> + PrettyPrintEnv -> + PartialDeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) +synhashLcaDefns db ppe declNameLookup = + synhashDefnsWith hashReferent hashType + where + -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay, + -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places). + -- + -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk + -- that we accidentally get an equal hash and classify a real update as unchanged. + + hashReferent :: Name -> Referent -> Transaction Hash + hashReferent name = \case + Referent.Con (ConstructorReference ref _) _ -> + case Map.lookup name declNameLookup.constructorToDecl of + Nothing -> pure (Hash mempty) -- see note above + Just declName -> hashType declName ref + Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + + hashType :: Name -> TypeReference -> Transaction Hash + hashType name = \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> + case sequence (declNameLookup.declToConstructors Map.! name) of + Nothing -> pure (Hash mempty) -- see note above + Just names -> do + decl <- loadDeclWithGoodConstructorNames db names ref + pure (synhashDerivedDecl ppe name decl) + +synhashDefns :: + MergeDatabase -> + PrettyPrintEnv -> + DeclNameLookup -> + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + Transaction (DefnsF2 (Map Name) Synhashed Referent TypeReference) +synhashDefns db ppe declNameLookup = + -- FIXME: use cache so we only synhash each thing once + synhashDefnsWith hashReferent hashType + where + hashReferent :: Name -> Referent -> Transaction Hash + hashReferent name = \case + -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a + -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and + -- constructors are changed in lock-step: it is not possible to change one, but not the other. + -- + -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on + -- both the type (Foo) and the constructor (Foo.Bar). + Referent.Con (ConstructorReference ref _) _ -> hashType (DeclNameLookup.expectDeclName declNameLookup name) ref + Referent.Ref ref -> synhashTerm db.loadV1Term ppe ref + + hashType :: Name -> TypeReference -> Transaction Hash + hashType name = \case + ReferenceBuiltin builtin -> pure (synhashBuiltinDecl builtin) + ReferenceDerived ref -> do + decl <- loadDeclWithGoodConstructorNames db (DeclNameLookup.expectConstructorNames declNameLookup name) ref + pure (synhashDerivedDecl ppe name decl) + +loadDeclWithGoodConstructorNames :: MergeDatabase -> [Name] -> TypeReferenceId -> Transaction (Decl Symbol Ann) +loadDeclWithGoodConstructorNames db names = + fmap (DataDeclaration.setConstructorNames (map Name.toVar names)) . db.loadV1Decl + diffNamespaceDefns :: DefnsF2 (Map Name) Synhashed term typ -> DefnsF2 (Map Name) Synhashed term typ -> @@ -139,17 +169,17 @@ deepNamespaceDefinitionsToPpe Defns {terms, types} = synhashDefnsWith :: Monad m => - (term -> m Hash) -> + (Name -> term -> m Hash) -> (Name -> typ -> m Hash) -> Defns (BiMultimap term Name) (BiMultimap typ Name) -> m (DefnsF2 (Map Name) Synhashed term typ) synhashDefnsWith hashTerm hashType = do bitraverse - (traverse hashTerm1 . BiMultimap.range) + (Map.traverseWithKey hashTerm1 . BiMultimap.range) (Map.traverseWithKey hashType1 . BiMultimap.range) where - hashTerm1 term = do - hash <- hashTerm term + hashTerm1 name term = do + hash <- hashTerm name term pure (Synhashed hash term) hashType1 name typ = do diff --git a/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs b/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs new file mode 100644 index 000000000..556ea9f5d --- /dev/null +++ b/unison-merge/src/Unison/Merge/PartialDeclNameLookup.hs @@ -0,0 +1,15 @@ +module Unison.Merge.PartialDeclNameLookup + ( PartialDeclNameLookup (..), + ) +where + +import Unison.Name (Name) +import Unison.Prelude + +-- | Like a @DeclNameLookup@, but "partial" / more lenient - because we don't require the LCA of a merge to have a full +-- @DeclNameLookup@. +data PartialDeclNameLookup = PartialDeclNameLookup + { constructorToDecl :: !(Map Name Name), + declToConstructors :: !(Map Name [Maybe Name]) + } + deriving stock (Generic) diff --git a/unison-merge/src/Unison/Merge/Synhash.hs b/unison-merge/src/Unison/Merge/Synhash.hs index 29559690b..6acf835a7 100644 --- a/unison-merge/src/Unison/Merge/Synhash.hs +++ b/unison-merge/src/Unison/Merge/Synhash.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} + -- | Utilities for computing the "syntactic hash" of a decl or term, which is a hash that is computed after substituting -- references to other terms and decls with names from a pretty-print environment. -- @@ -35,7 +37,6 @@ import Data.Char (ord) import Data.Text qualified as Text import U.Codebase.Reference (TypeReference) import Unison.ABT qualified as ABT -import Unison.ConstructorReference (GConstructorReference (..)) import Unison.ConstructorType (ConstructorType) import Unison.ConstructorType qualified as CT import Unison.DataDeclaration (DataDeclaration, Decl) @@ -51,8 +52,9 @@ import Unison.Prelude import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE import Unison.Reference (Reference' (..), TypeReferenceId) -import Unison.Referent qualified as V1 (Referent) -import Unison.Referent qualified as V1.Referent +import Unison.Reference qualified as V1 +import Unison.Referent (Referent) +import Unison.Referent qualified as Referent import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar) import Unison.Term (Term) import Unison.Term qualified as Term @@ -107,7 +109,7 @@ hashConstructorNameToken declName conName = hashDerivedTerm :: Var v => PrettyPrintEnv -> Term v a -> Hash hashDerivedTerm ppe t = - H.accumulate $ isNotBuiltinTag : hashTermTokens ppe t + H.accumulate $ isNotBuiltinTag : isTermTag : hashTermTokens ppe t hashConstructorType :: ConstructorType -> Token hashConstructorType = \case @@ -138,7 +140,7 @@ hashDeclTokens ppe name decl = -- syntactic hashes. synhashDerivedDecl :: Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash synhashDerivedDecl ppe name decl = - H.accumulate $ isNotBuiltinTag : hashDeclTokens ppe name decl + H.accumulate $ isNotBuiltinTag : isDeclTag : hashDeclTokens ppe name decl hashHQNameToken :: HashQualified Name -> Token hashHQNameToken = @@ -170,14 +172,14 @@ hashPatternTokens ppe = \case Pattern.Char _ c -> [H.Tag 7, H.Nat (fromIntegral (ord c))] Pattern.Constructor _ cr ps -> H.Tag 8 - : hashReferentToken ppe (V1.Referent.Con cr CT.Data) + : hashReferentToken ppe (Referent.Con cr CT.Data) : hashLengthToken ps : (ps >>= hashPatternTokens ppe) Pattern.As _ p -> H.Tag 9 : hashPatternTokens ppe p Pattern.EffectPure _ p -> H.Tag 10 : hashPatternTokens ppe p Pattern.EffectBind _ cr ps k -> H.Tag 11 - : hashReferentToken ppe (V1.Referent.Con cr CT.Effect) + : hashReferentToken ppe (Referent.Con cr CT.Effect) : hashLengthToken ps : hashPatternTokens ppe k <> (ps >>= hashPatternTokens ppe) Pattern.SequenceLiteral _ ps -> H.Tag 12 : hashLengthToken ps : (ps >>= hashPatternTokens ppe) @@ -188,36 +190,20 @@ hashPatternTokens ppe = \case Pattern.Snoc -> H.Tag 1 Pattern.Cons -> H.Tag 2 -hashReferentToken :: PrettyPrintEnv -> V1.Referent -> Token +hashReferentToken :: PrettyPrintEnv -> Referent -> Token hashReferentToken ppe = - H.Hashed . H.accumulate . hashReferentTokens ppe + hashHQNameToken . PPE.termNameOrHashOnlyFq ppe -hashReferentTokens :: PrettyPrintEnv -> V1.Referent -> [Token] -hashReferentTokens ppe referent = - case referent of - -- distinguish constructor name from terms by tumbling in a name (of any alias of) its decl - V1.Referent.Con (ConstructorReference ref _i) _ct -> [hashTypeReferenceToken ppe ref, nameTok] - V1.Referent.Ref _ -> [nameTok] - where - nameTok :: Token - nameTok = - hashHQNameToken (PPE.termNameOrHashOnlyFq ppe referent) - --- | Syntactically hash a term, using reference names rather than hashes. --- Two terms will have the same syntactic hash if they would --- print the the same way under the given pretty-print env. synhashTerm :: forall m v a. (Monad m, Var v) => (TypeReferenceId -> m (Term v a)) -> PrettyPrintEnv -> - V1.Referent -> + V1.TermReference -> m Hash synhashTerm loadTerm ppe = \case - V1.Referent.Con ref CT.Data -> pure (hashDerivedTerm ppe (Term.constructor @v () ref)) - V1.Referent.Con ref CT.Effect -> pure (hashDerivedTerm ppe (Term.request @v () ref)) - V1.Referent.Ref (ReferenceBuiltin builtin) -> pure (hashBuiltinTerm builtin) - V1.Referent.Ref (ReferenceDerived ref) -> hashDerivedTerm ppe <$> loadTerm ref + ReferenceBuiltin builtin -> pure (hashBuiltinTerm builtin) + ReferenceDerived ref -> hashDerivedTerm ppe <$> loadTerm ref hashTermTokens :: forall v a. Var v => PrettyPrintEnv -> Term v a -> [Token] hashTermTokens ppe = @@ -242,9 +228,9 @@ hashTermFTokens ppe = \case Term.Char c -> [H.Tag 5, H.Nat (fromIntegral (ord c))] Term.Blank {} -> error "tried to hash a term with blanks, something's very wrong" -- note: these are all hashed the same, just based on the name - Term.Ref r -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Ref r)] - Term.Constructor cr -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Con cr CT.Data)] - Term.Request cr -> [H.Tag 7, hashReferentToken ppe (V1.Referent.Con cr CT.Effect)] + Term.Ref r -> [H.Tag 7, hashReferentToken ppe (Referent.Ref r)] + Term.Constructor cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Data)] + Term.Request cr -> [H.Tag 7, hashReferentToken ppe (Referent.Con cr CT.Effect)] Term.Handle {} -> [H.Tag 8] Term.App {} -> [H.Tag 9] Term.Ann _ ty -> H.Tag 10 : hashTypeTokens ppe ty diff --git a/unison-merge/unison-merge.cabal b/unison-merge/unison-merge.cabal index 84baab088..ab6bebe3d 100644 --- a/unison-merge/unison-merge.cabal +++ b/unison-merge/unison-merge.cabal @@ -26,6 +26,7 @@ library Unison.Merge.EitherWay Unison.Merge.EitherWayI Unison.Merge.Libdeps + Unison.Merge.PartialDeclNameLookup Unison.Merge.PartitionCombinedDiffs Unison.Merge.Synhash Unison.Merge.Synhashed diff --git a/unison-src/transcripts/merge.md b/unison-src/transcripts/merge.md index 980815356..9436ae523 100644 --- a/unison-src/transcripts/merge.md +++ b/unison-src/transcripts/merge.md @@ -14,7 +14,7 @@ contains both additions. ## Basic merge: two unconflicted adds ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -56,7 +56,7 @@ project/alice> view foo bar If Alice and Bob also happen to add the same definition, that's not a conflict. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins project/main> branch alice ``` @@ -97,7 +97,7 @@ project/alice> view foo bar Updates that occur in one branch are propagated to the other. In this example, Alice updates `foo`, while Bob adds a new dependent `bar` of the original `foo`. When Bob's branch is merged into Alice's, her update to `foo` is propagated to his `bar`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -152,7 +152,7 @@ We classify something as an update if its "syntactic hash"—not its normal Unis Let's see an example. We have `foo`, which depends on `bar` and `baz`. Alice updates `bar` (propagating to `foo`), and Bob updates `baz` (propagating to `foo`). When we merge their updates, both updates will be reflected in the final `foo`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -216,7 +216,7 @@ project/alice> display foo Of course, it's also possible for Alice's update to propagate to one of Bob's updates. In this example, `foo` depends on `bar` which depends on `baz`. Alice updates `baz`, propagating to `bar` and `foo`, while Bob updates `bar` (to something that still depends on `foo`), propagating to `baz`. The merged result will have Alice's update to `foo` incorporated into Bob's updated `bar`, and both updates will propagate to `baz`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -286,7 +286,7 @@ project/alice> display foo We don't currently consider "update + delete" a conflict like Git does. In this situation, the delete is just ignored, allowing the update to proceed. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -333,7 +333,7 @@ In a future version, we'd like to give the user a warning at least. Library dependencies don't cause merge conflicts, the library dependencies are just unioned together. If two library dependencies have the same name but different namespace hashes, then the merge algorithm makes up two fresh names. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's adds: @@ -387,7 +387,7 @@ project/alice> view foo bar baz If Bob is equals Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -405,7 +405,7 @@ project/alice> merge /bob If Bob is behind Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -433,7 +433,7 @@ project/alice> merge /bob If Bob is ahead of Alice, then merging Bob into Alice looks like this. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -465,7 +465,7 @@ This can cause merge failures due to out-of-scope identifiers, and the user may In this example, Alice deletes `foo`, while Bob adds a new dependent of `foo`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -508,7 +508,7 @@ It may be Alice's and Bob's changes merge together cleanly in the sense that the In this example, Alice updates a `Text` to a `Nat`, while Bob adds a new dependent of the `Text`. Upon merging, propagating Alice's update to Bob's dependent causes a typechecking failure. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -557,7 +557,7 @@ Alice and Bob may disagree about the definition of a term. In this case, the con are presented to the user to resolve. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -621,7 +621,7 @@ project/merge-bob-into-alice> view bar baz Ditto for types; if the hashes don't match, it's a conflict. In this example, Alice and Bob do different things to the same constructor. However, any explicit changes to the same type will result in a conflict, including changes that could concievably be merged (e.g. Alice and Bob both add a new constructor, or edit different constructors). ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -664,7 +664,7 @@ project/alice> merge /bob We model the renaming of a type's constructor as an update, so if Alice updates a type and Bob renames one of its constructors (even without changing its structure), we consider it a conflict. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -707,7 +707,7 @@ project/alice> merge /bob Here is another example demonstrating that constructor renames are modeled as updates. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -745,7 +745,7 @@ project/alice> merge bob A constructor on one side can conflict with a regular term definition on the other. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -786,7 +786,7 @@ project/alice> merge bob Here's a subtle situation where a new type is added on each side of the merge, and an existing term is replaced with a constructor of one of the types. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -835,7 +835,7 @@ project/alice> merge bob Here's a more involved example that demonstrates the same idea. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` In the LCA, we have a type with two constructors, and some term. @@ -914,7 +914,7 @@ which is a parse error. We will resolve this situation automatically in a future version. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -961,7 +961,7 @@ After merge conflicts are resolved, you can use `merge.commit` rather than `swit ```ucm:hide .> project.create-empty project -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -1026,7 +1026,7 @@ project/alice> branches ```ucm:hide .> project.create-empty project -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm @@ -1051,7 +1051,7 @@ There are a number of conditions under which we can't perform a merge, and the u If `foo` and `bar` are aliases in the nearest common ancestor, but not in Alice's branch, then we don't know whether to update Bob's dependents to Alice's `foo` or Alice's `bar` (and vice-versa). ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Original branch: @@ -1108,7 +1108,7 @@ conflict involving a builtin, we can't perform a merge. One way to fix this in the future would be to introduce a syntax for defining aliases in the scratch file. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -1117,7 +1117,7 @@ project/main> branch alice Alice's branch: ```ucm -project/alice> alias.type builtin.Nat MyNat +project/alice> alias.type lib.builtins.Nat MyNat ``` Bob's branch: @@ -1146,7 +1146,7 @@ project/alice> merge /bob Each naming of a decl may not have more than one name for each constructor, within the decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```ucm:hide @@ -1192,7 +1192,7 @@ project/alice> merge /bob Each naming of a decl must have a name for each constructor, within the decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1239,7 +1239,7 @@ project/alice> merge /bob A decl cannot be aliased within the namespace of another of its aliased. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1287,7 +1287,7 @@ project/alice> merge /bob Constructors may only exist within the corresponding decl's namespace. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1331,7 +1331,7 @@ project/alice> merge bob By convention, `lib` can only namespaces; each of these represents a library dependencies. Individual terms and types are not allowed at the top level of `lib`. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` Alice's branch: @@ -1375,7 +1375,7 @@ Here's an example. We'll delete a constructor name from the LCA and still be abl together. ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` LCA: @@ -1439,7 +1439,7 @@ project/alice> merge /bob ```ucm:hide -project/main> builtins.mergeio +project/main> builtins.mergeio lib.builtins ``` ```unison @@ -1477,3 +1477,44 @@ project/alice> merge /bob ```ucm:hide .> project.delete project ``` + +### Delete a constructor + + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```unison +type Foo = Bar | Baz +``` + +```ucm +project/main> add +project/main> branch topic +``` + +```unison +boop = "boop" +``` + +```ucm +project/topic> add +``` + +```unison +type Foo = Bar +``` + +```ucm +project/main> update +``` + +```ucm +project/main> merge topic +project/main> view Foo +``` + +```ucm:hide +.> project.delete project +``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 1ead9f458..6334b362d 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1255,7 +1255,7 @@ One way to fix this in the future would be to introduce a syntax for defining al Alice's branch: ```ucm -project/alice> alias.type builtin.Nat MyNat +project/alice> alias.type lib.builtins.Nat MyNat Done. @@ -1696,3 +1696,100 @@ project/alice> merge /bob I merged project/bob into project/alice. ``` +### Delete a constructor + + +```unison +type Foo = Bar | Baz +``` + +```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 Foo + +``` +```ucm +project/main> add + + ⍟ I've added these definitions: + + type Foo + +project/main> branch topic + + Done. I've created the topic branch based off of main. + + Tip: To merge your work back into the main branch, first + `switch /main` then `merge /topic`. + +``` +```unison +boop = "boop" +``` + +```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`: + + boop : Text + +``` +```ucm +project/topic> add + + ⍟ I've added these definitions: + + boop : Text + +``` +```unison +type Foo = Bar +``` + +```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 names already exist. You can `update` them to your + new definition: + + type Foo + +``` +```ucm +project/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. + +``` +```ucm +project/main> merge topic + + I merged project/topic into project/main. + +project/main> view Foo + + type Foo = Bar + +```