merge API tweaks

parser-typechecker/src/Unison/Codebase.hs

@@ -150,7 +150,7 @@ import Unison.Parser.Ann (Ann)
 import Unison.Parser.Ann qualified as Parser
 import Unison.Prelude
 import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName)
-import Unison.Reference (Reference, TermReferenceId, TypeReference)
+import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.Runtime.IOSource qualified as IOSource
@@ -163,6 +163,7 @@ import Unison.Type qualified as Type
 import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup))
 import Unison.Typechecker.TypeLookup qualified as TL
 import Unison.UnisonFile qualified as UF
+import Unison.Util.Defns (Defns (..), DefnsF)
 import Unison.Util.Relation qualified as Rel
 import Unison.Var (Var)
 import Unison.WatchKind qualified as WK
@@ -364,35 +365,51 @@ lookupWatchCache codebase h = do
 -- and all of their type dependencies, including builtins.
 typeLookupForDependencies ::
   Codebase IO Symbol Ann ->
-  Set Reference ->
+  DefnsF Set TermReference TypeReference ->
   Sqlite.Transaction (TL.TypeLookup Symbol Ann)
 typeLookupForDependencies codebase s = do
   when debug $ traceM $ "typeLookupForDependencies " ++ show s
-  (<> Builtin.typeLookup) <$> depthFirstAccum mempty s
+  (<> Builtin.typeLookup) <$> depthFirstAccum s
   where
-    depthFirstAccum :: TL.TypeLookup Symbol Ann -> Set Reference -> Sqlite.Transaction (TL.TypeLookup Symbol Ann)
-    depthFirstAccum tl refs = foldM go tl (Set.filter (unseen tl) refs)
+    depthFirstAccum ::
+      DefnsF Set TermReference TypeReference ->
+      Sqlite.Transaction (TL.TypeLookup Symbol Ann)
+    depthFirstAccum refs = do
+      tl <- depthFirstAccumTypes mempty refs.types
+      foldM goTerm tl (Set.filter (unseen tl) refs.terms)
+
+    depthFirstAccumTypes ::
+      TL.TypeLookup Symbol Ann ->
+      Set TypeReference ->
+      Sqlite.Transaction (TL.TypeLookup Symbol Ann)
+    depthFirstAccumTypes tl refs =
+      foldM goType tl (Set.filter (unseen tl) refs)
 
     -- We need the transitive dependencies of data decls
     -- that are scrutinized in a match expression for
     -- pattern match coverage checking (specifically for
     -- the inhabitation check). We ensure these are found
     -- by collecting all transitive type dependencies.
-    go tl ref@(Reference.DerivedId id) =
+    goTerm :: TypeLookup Symbol Ann -> TermReference -> Sqlite.Transaction (TypeLookup Symbol Ann)
+    goTerm tl ref =
       getTypeOfTerm codebase ref >>= \case
         Just typ ->
           let z = tl <> TypeLookup (Map.singleton ref typ) mempty mempty
-           in depthFirstAccum z (Type.dependencies typ)
-        Nothing ->
-          getTypeDeclaration codebase id >>= \case
-            Just (Left ed) ->
-              let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed)
-               in depthFirstAccum z (DD.typeDependencies $ DD.toDataDecl ed)
-            Just (Right dd) ->
-              let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty
-               in depthFirstAccum z (DD.typeDependencies dd)
-            Nothing -> pure tl
-    go tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins
+           in depthFirstAccumTypes z (Type.dependencies typ)
+        Nothing -> pure tl
+
+    goType :: TypeLookup Symbol Ann -> TypeReference -> Sqlite.Transaction (TypeLookup Symbol Ann)
+    goType tl ref@(Reference.DerivedId id) =
+      getTypeDeclaration codebase id >>= \case
+        Just (Left ed) ->
+          let z = tl <> TypeLookup mempty mempty (Map.singleton ref ed)
+           in depthFirstAccumTypes z (DD.typeDependencies $ DD.toDataDecl ed)
+        Just (Right dd) ->
+          let z = tl <> TypeLookup mempty (Map.singleton ref dd) mempty
+           in depthFirstAccumTypes z (DD.typeDependencies dd)
+        Nothing -> pure tl
+    goType tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins
+
     unseen :: TL.TypeLookup Symbol a -> Reference -> Bool
     unseen tl r =
       isNothing

parser-typechecker/src/Unison/Codebase/CodeLookup.hs

@@ -8,6 +8,7 @@ import Unison.Prelude
 import Unison.Reference qualified as Reference
 import Unison.Term (Term)
 import Unison.Term qualified as Term
+import Unison.Util.Defns (Defns (..))
 import Unison.Util.Set qualified as Set
 import Unison.Var (Var)
 
@@ -56,7 +57,7 @@ transitiveDependencies code seen0 rid =
           getIds = Set.mapMaybe Reference.toId
        in getTerm code rid >>= \case
             Just t ->
-              foldM (transitiveDependencies code) seen (getIds $ Term.dependencies t)
+              foldM (transitiveDependencies code) seen (getIds $ let deps = Term.dependencies t in deps.terms <> deps.types)
             Nothing ->
               getTypeDeclaration code rid >>= \case
                 Nothing -> pure seen

parser-typechecker/src/Unison/FileParsers.hs

@@ -9,20 +9,22 @@ import Control.Lens
 import Control.Monad.State (evalStateT)
 import Data.Foldable qualified as Foldable
 import Data.List (partition)
+import Data.List qualified as List
 import Data.List.NonEmpty qualified as List.NonEmpty
 import Data.Map qualified as Map
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Unison.ABT qualified as ABT
 import Unison.Blank qualified as Blank
 import Unison.Builtin qualified as Builtin
+import Unison.ConstructorReference qualified as ConstructorReference
 import Unison.Name qualified as Name
 import Unison.Names qualified as Names
 import Unison.NamesWithHistory qualified as Names
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.PrettyPrintEnv.Names qualified as PPE
-import Unison.Reference (Reference)
+import Unison.Reference (TermReference, TypeReference)
 import Unison.Referent qualified as Referent
 import Unison.Result (CompilerBug (..), Note (..), ResultT, pattern Result)
 import Unison.Result qualified as Result
@@ -37,6 +39,7 @@ import Unison.Typechecker.TypeLookup qualified as TL
 import Unison.UnisonFile (definitionLocation)
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
+import Unison.Util.Defns (Defns (..), DefnsF)
 import Unison.Util.List qualified as List
 import Unison.Util.Relation qualified as Rel
 import Unison.Var (Var)
@@ -76,7 +79,7 @@ computeTypecheckingEnvironment ::
   (Var v, Monad m) =>
   ShouldUseTndr m ->
   [Type v] ->
-  (Set Reference -> m (TL.TypeLookup v Ann)) ->
+  (DefnsF Set TermReference TypeReference -> m (TL.TypeLookup v Ann)) ->
   UnisonFile v ->
   m (Typechecker.Env v Ann)
 computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf =
@@ -99,8 +102,15 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf =
                 let shortname = Name.unsafeParseVar v,
                 name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments shortname)
             ]
-          possibleRefs = Referent.toReference . view _3 <$> possibleDeps
-      tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> Set.fromList possibleRefs))
+          possibleRefs =
+            List.foldl'
+              ( \acc -> \case
+                  (_, _, Referent.Con ref _) -> acc & over #types (Set.insert (ref ^. ConstructorReference.reference_))
+                  (_, _, Referent.Ref ref) -> acc & over #terms (Set.insert ref)
+              )
+              (Defns Set.empty Set.empty)
+              possibleDeps
+      tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> possibleRefs))
       -- For populating the TDNR environment, we pick definitions
       -- from the namespace and from the local file whose full name
       -- has a suffix that equals one of the free variables in the file.
@@ -130,7 +140,7 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf =
                 ]
       pure
         Typechecker.Env
-          { ambientAbilities = ambientAbilities,
+          { ambientAbilities,
             typeLookup = tl,
             termsByShortname = fqnsByShortName
           }

parser-typechecker/src/Unison/UnisonFile.hs

@@ -57,7 +57,7 @@ import Unison.Hashing.V2.Convert qualified as Hashing
 import Unison.LabeledDependency (LabeledDependency)
 import Unison.LabeledDependency qualified as LD
 import Unison.Prelude
-import Unison.Reference (Reference)
+import Unison.Reference (Reference, TermReference, TypeReference)
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.Term (Term)
@@ -66,6 +66,7 @@ import Unison.Type (Type)
 import Unison.Type qualified as Type
 import Unison.Typechecker.TypeLookup qualified as TL
 import Unison.UnisonFile.Type (TypecheckedUnisonFile (..), UnisonFile (..), pattern TypecheckedUnisonFile, pattern UnisonFile)
+import Unison.Util.Defns (Defns (..), DefnsF)
 import Unison.Util.List qualified as List
 import Unison.Var (Var)
 import Unison.Var qualified as Var
@@ -84,7 +85,7 @@ emptyUnisonFile =
 
 leftBiasedMerge :: forall v a. (Ord v) => UnisonFile v a -> UnisonFile v a -> UnisonFile v a
 leftBiasedMerge lhs rhs =
-  let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) (terms lhs) (terms rhs)
+  let mergedTerms = Map.foldlWithKey' (addNotIn lhsTermNames) lhs.terms rhs.terms
       mergedWatches = Map.foldlWithKey' addWatch (watches lhs) (watches rhs)
       mergedDataDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (dataDeclarationsId lhs) (dataDeclarationsId rhs)
       mergedEffectDecls = Map.foldlWithKey' (addNotIn lhsTypeNames) (effectDeclarationsId lhs) (effectDeclarationsId rhs)
@@ -96,7 +97,7 @@ leftBiasedMerge lhs rhs =
         }
   where
     lhsTermNames =
-      Map.keysSet (terms lhs)
+      Map.keysSet lhs.terms
         <> foldMap (\x -> Set.fromList [v | (v, _, _) <- x]) (watches lhs)
 
     lhsTypeNames =
@@ -132,7 +133,7 @@ allWatches = join . Map.elems . watches
 -- | Get the location of a given definition in the file.
 definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a
 definitionLocation v uf =
-  terms uf ^? ix v . _1
+  uf.terms ^? ix v . _1
     <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2
     <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation
     <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl)
@@ -152,7 +153,7 @@ typecheckingTerm uf =
 
 termBindings :: UnisonFile v a -> [(v, a, Term v a)]
 termBindings uf =
-  Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] (terms uf)
+  Map.foldrWithKey (\k (a, t) b -> (k, a, t) : b) [] uf.terms
 
 -- backwards compatibility with the old data type
 dataDeclarations' :: TypecheckedUnisonFile v a -> Map v (Reference, DataDeclaration v a)
@@ -337,12 +338,20 @@ termSignatureExternalLabeledDependencies
 
 -- Returns the dependencies of the `UnisonFile` input. Needed so we can
 -- load information about these dependencies before starting typechecking.
-dependencies :: (Monoid a, Var v) => UnisonFile v a -> Set Reference
-dependencies (UnisonFile ds es ts ws) =
-  foldMap (DD.typeDependencies . snd) ds
-    <> foldMap (DD.typeDependencies . DD.toDataDecl . snd) es
-    <> foldMap (Term.dependencies . snd) ts
-    <> foldMap (foldMap (Term.dependencies . view _3)) ws
+dependencies :: (Monoid a, Var v) => UnisonFile v a -> DefnsF Set TermReference TypeReference
+dependencies file =
+  fold
+    [ Defns
+        { terms = Set.empty,
+          types =
+            Set.unions
+              [ foldMap (DD.typeDependencies . snd) file.dataDeclarationsId,
+                foldMap (DD.typeDependencies . DD.toDataDecl . snd) file.effectDeclarationsId
+              ]
+        },
+      foldMap (Term.dependencies . snd) file.terms,
+      foldMap (foldMap (Term.dependencies . view _3)) file.watches
+    ]
 
 discardTypes :: (Ord v) => TypecheckedUnisonFile v a -> UnisonFile v a
 discardTypes (TypecheckedUnisonFileId datas effects terms watches _) =
@@ -397,7 +406,7 @@ constructorsForDecls types uf =
 
 -- | All bindings in the term namespace: terms, test watches (since those are the only watches that are actually stored
 -- in the codebase), data constructors, and effect constructors.
-termNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+termNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v
 termNamespaceBindings uf =
   terms <> tests <> datacons <> effcons
   where
@@ -413,7 +422,7 @@ termNamespaceBindings uf =
         uf.effectDeclarationsId'
 
 -- | All bindings in the term namespace: data declarations and effect declarations.
-typeNamespaceBindings :: Ord v => TypecheckedUnisonFile v a -> Set v
+typeNamespaceBindings :: (Ord v) => TypecheckedUnisonFile v a -> Set v
 typeNamespaceBindings uf =
   datas <> effs
   where

unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs

@@ -280,8 +280,6 @@ doMerge info = do
       mergedLibdeps <-
         Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps)
 
-      uniqueName <- liftIO env.generateUniqueName
-
       let hasConflicts =
             blob2.hasConflicts
 
@@ -307,7 +305,7 @@ doMerge info = do
       maybeBlob5 <-
         if hasConflicts
           then pure Nothing
-          else case Merge.makeMergeblob4 blob3 uniqueName of
+          else case Merge.makeMergeblob4 blob3 of
             Left _parseErr -> pure Nothing
             Right blob4 -> do
               typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies)

unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs

@@ -40,6 +40,7 @@ import Unison.Typechecker.TypeLookup qualified as TypeLookup
 import Unison.UnisonFile (TypecheckedUnisonFile)
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
+import Unison.Util.Defns (Defns (..))
 import Unison.Var qualified as Var
 
 handleRun :: Bool -> HQ.HashQualified Name -> [String] -> Cli ()
@@ -124,7 +125,9 @@ getTerm' mainName =
         Cli.Env {codebase, runtime} <- ask
         case Typechecker.fitsScheme ty (Runtime.mainType runtime) of
           True -> do
-            typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies codebase (Type.dependencies ty))
+            typeLookup <-
+              Cli.runTransaction $
+                Codebase.typeLookupForDependencies codebase Defns {terms = Set.empty, types = Type.dependencies ty}
             f $! synthesizeForce typeLookup ty
           False -> pure (TermHasBadType ty)
    in Cli.getLatestTypecheckedFile >>= \case