don't prefer the unison file for type name suffixes

parser-typechecker/src/Unison/PrintError.hs

@@ -1996,12 +1996,19 @@ prettyResolutionFailures s allFailures =
 
     toAmbiguityPair :: Names.ResolutionFailure v annotation -> (v, Maybe (NESet String))
     toAmbiguityPair = \case
-      (Names.TermResolutionFailure v _ (Names.Ambiguous names refs)) -> do
+      (Names.TermResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do
         let ppe = ppeFromNames names
-         in (v, Just $ NES.map (showTermRef ppe) refs)
-      (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs)) -> do
+         in ( v,
+              Just $
+                NES.unsafeFromSet
+                  (Set.map (showTermRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames)
+            )
+      (Names.TypeResolutionFailure v _ (Names.Ambiguous names refs localNames)) -> do
         let ppe = ppeFromNames names
-         in (v, Just $ NES.map (showTypeRef ppe) refs)
+         in ( v,
+              Just $
+                NES.unsafeFromSet (Set.map (showTypeRef ppe) refs <> Set.map (Text.unpack . Name.toText) localNames)
+            )
       (Names.TermResolutionFailure v _ Names.NotFound) -> (v, Nothing)
       (Names.TypeResolutionFailure v _ Names.NotFound) -> (v, Nothing)
 

parser-typechecker/src/Unison/UnisonFile/Names.hs

@@ -130,12 +130,12 @@ environmentFor ::
   Map v (EffectDeclaration v a) ->
   Names.ResolutionResult v a (Either [Error v a] (Env v a))
 environmentFor names dataDecls0 effectDecls0 = do
-  let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0)
+  let locallyBoundTypes = Map.keysSet dataDecls0 <> Map.keysSet effectDecls0
   -- data decls and hash decls may reference each other, and thus must be hashed together
   dataDecls :: Map v (DataDeclaration v a) <-
-    traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0
+    traverse (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names) dataDecls0
   effectDecls :: Map v (EffectDeclaration v a) <-
-    traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0
+    traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar Name.toVar locallyBoundTypes names)) effectDecls0
   let allDecls0 :: Map v (DataDeclaration v a)
       allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls)
   hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0

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

@@ -1678,7 +1678,7 @@ parseType input src = do
     Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err ->
       Cli.returnEarly (TypeParseError src err)
 
-  Type.bindNames Name.unsafeParseVar mempty names (Type.generalizeLowercase mempty typ) & onLeft \errs ->
+  Type.bindNames Name.unsafeParseVar Name.toVar Set.empty names (Type.generalizeLowercase mempty typ) & onLeft \errs ->
     Cli.returnEarly (ParseResolutionFailures src (toList errs))
 
 -- Adds a watch expression of the given name to the file, if

unison-core/src/Unison/DataDeclaration.hs

@@ -108,7 +108,7 @@ data DataDeclaration v a = DataDeclaration
     bound :: [v],
     constructors' :: [(a, v, Type v a)]
   }
-  deriving (Eq, Ord, Show, Functor)
+  deriving (Eq, Ord, Show, Functor, Generic)
 
 constructorCount :: DataDeclaration v a -> Int
 constructorCount DataDeclaration {constructors'} = length constructors'

unison-core/src/Unison/DataDeclaration/Names.hs

@@ -1,28 +1,30 @@
 {-# LANGUAGE RecordWildCards #-}
 
-module Unison.DataDeclaration.Names (bindNames, dataDeclToNames', effectDeclToNames') where
-
-import Data.Map qualified as Map
-import Data.Set qualified as Set
-import Unison.ABT qualified as ABT
+module Unison.DataDeclaration.Names
+  ( bindNames,
+    dataDeclToNames',
+    effectDeclToNames',
+  )
+where
+
+import Control.Lens (traverseOf, _3)
 import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
-import Unison.DataDeclaration (DataDeclaration (DataDeclaration), EffectDeclaration)
+import Unison.DataDeclaration (DataDeclaration (..), EffectDeclaration)
 import Unison.DataDeclaration qualified as DD
-import Unison.Name qualified as Name
+import Unison.Name (Name)
 import Unison.Names (Names (Names))
 import Unison.Names.ResolutionResult qualified as Names
 import Unison.Prelude
 import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
-import Unison.Type qualified as Type
 import Unison.Type.Names qualified as Type.Names
 import Unison.Util.Relation qualified as Rel
 import Unison.Var (Var)
 import Prelude hiding (cycle)
 
 -- implementation of dataDeclToNames and effectDeclToNames
-toNames :: (Var v) => (v -> Name.Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names
+toNames :: (Var v) => (v -> Name) -> CT.ConstructorType -> v -> Reference.Id -> DataDeclaration v a -> Names
 toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd =
   -- constructor names
   foldMap names (DD.constructorVars dd `zip` [0 ..])
@@ -32,29 +34,25 @@ toNames varToName ct typeSymbol (Reference.DerivedId -> r) dd =
     names (ctor, i) =
       Names (Rel.singleton (varToName ctor) (Referent.Con (ConstructorReference r i) ct)) mempty
 
-dataDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> DataDeclaration v a -> Names
+dataDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> DataDeclaration v a -> Names
 dataDeclToNames varToName = toNames varToName CT.Data
 
-effectDeclToNames :: (Var v) => (v -> Name.Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names
+effectDeclToNames :: (Var v) => (v -> Name) -> v -> Reference.Id -> EffectDeclaration v a -> Names
 effectDeclToNames varToName typeSymbol r ed = toNames varToName CT.Effect typeSymbol r $ DD.toDataDecl ed
 
-dataDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names
+dataDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, DataDeclaration v a)) -> Names
 dataDeclToNames' varToName (v, (r, d)) = dataDeclToNames varToName v r d
 
-effectDeclToNames' :: (Var v) => (v -> Name.Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names
+effectDeclToNames' :: (Var v) => (v -> Name) -> (v, (Reference.Id, EffectDeclaration v a)) -> Names
 effectDeclToNames' varToName (v, (r, d)) = effectDeclToNames varToName v r d
 
 bindNames ::
   (Var v) =>
-  (v -> Name.Name) ->
-  Map v v ->
+  (v -> Name) ->
+  (Name -> v) ->
+  Set v ->
   Names ->
   DataDeclaration v a ->
   Names.ResolutionResult v a (DataDeclaration v a)
-bindNames varToName localNames names (DataDeclaration m a bound constructors) = do
-  constructors <- for constructors $ \(a, v, ty) ->
-    (a,v,) <$> Type.Names.bindNames varToName keepFree names (ABT.substsInheritAnnotation subs ty)
-  pure $ DataDeclaration m a bound constructors
-  where
-    keepFree = Set.fromList (Map.elems localNames)
-    subs = Map.toList $ Map.map (Type.var ()) localNames
+bindNames unsafeVarToName nameToVar localNames namespaceNames =
+  traverseOf (#constructors' . traverse . _3) (Type.Names.bindNames unsafeVarToName nameToVar localNames namespaceNames)

unison-core/src/Unison/Names.hs

@@ -93,7 +93,7 @@ data Names = Names
   { terms :: Relation Name Referent,
     types :: Relation Name TypeReference
   }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
 
 instance Semigroup (Names) where
   Names e1 t1 <> Names e2 t2 =

unison-core/src/Unison/Names/ResolutionResult.hs

@@ -1,21 +1,33 @@
-module Unison.Names.ResolutionResult where
+module Unison.Names.ResolutionResult
+  ( ResolutionError (..),
+    ResolutionFailure (..),
+    ResolutionResult,
+    getAnnotation,
+    getVar,
+  )
+where
 
-import Data.Set.NonEmpty
+import Unison.Name (Name)
 import Unison.Names (Names)
 import Unison.Prelude
-import Unison.Reference as Reference (Reference)
-import Unison.Referent as Referent (Referent)
+import Unison.Reference (TypeReference)
+import Unison.Referent (Referent)
 
 data ResolutionError ref
   = NotFound
-  | -- Contains the names which were in scope and which refs were possible options
-    -- The NonEmpty set of refs must contain 2 or more refs (otherwise what is ambiguous?).
-    Ambiguous Names (NESet ref)
+  | -- Contains:
+    --
+    --   1. The namespace names
+    --   2. The refs among those that we could be referring to
+    --   3. The local names that we could be referring to
+    --
+    -- The size of set (2.) + the size of set (3.) is at least 2 (otherwise there wouldn't be any ambiguity).
+    Ambiguous Names (Set ref) (Set Name)
   deriving (Eq, Ord, Show)
 
 -- | ResolutionFailure represents the failure to resolve a given variable.
 data ResolutionFailure var annotation
-  = TypeResolutionFailure var annotation (ResolutionError Reference)
+  = TypeResolutionFailure var annotation (ResolutionError TypeReference)
   | TermResolutionFailure var annotation (ResolutionError Referent)
   deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
 

unison-core/src/Unison/Term.hs

@@ -11,7 +11,6 @@ import Data.Generics.Sum (_Ctor)
 import Data.Map qualified as Map
 import Data.Sequence qualified as Sequence
 import Data.Set qualified as Set
-import Data.Set.NonEmpty qualified as NES
 import Data.Text qualified as Text
 import Text.Show
 import Unison.ABT qualified as ABT
@@ -165,15 +164,13 @@ bindNames unsafeVarToName keepFreeTerms ns e = do
         rs
           | Set.size rs == 1 ->
               pure (v, fromReferent a $ Set.findMin rs)
-          | otherwise -> case NES.nonEmptySet rs of
-              Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound))
-              Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns refs)))
+          | Set.size rs == 0 -> Left (pure (Names.TermResolutionFailure v a Names.NotFound))
+          | otherwise -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns rs Set.empty)))
       okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of
         rs
           | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs)
-          | otherwise -> case NES.nonEmptySet rs of
-              Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound))
-              Just refs -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns refs)))
+          | Set.size rs == 0 -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound))
+          | otherwise -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs Set.empty)))
   termSubsts <- validate okTm freeTmVars
   typeSubsts <- validate okTy freeTyVars
   pure . substTypeVars typeSubsts . ABT.substsInheritAnnotation termSubsts $ e

unison-core/src/Unison/Type/Names.hs

@@ -3,33 +3,106 @@ module Unison.Type.Names
   )
 where
 
+import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
-import Data.Set.NonEmpty qualified as NES
 import Unison.ABT qualified as ABT
 import Unison.HashQualified qualified as HQ
+import Unison.Name (Name)
 import Unison.Name qualified as Name
-import Unison.Names qualified as Names
+import Unison.Names (Names)
 import Unison.Names.ResolutionResult qualified as Names
 import Unison.NamesWithHistory qualified as Names
 import Unison.Prelude
+import Unison.Reference (TypeReference)
 import Unison.Type
+import Unison.Type qualified as Type
 import Unison.Util.List qualified as List
+import Unison.Util.Relation qualified as Relation
 import Unison.Var (Var)
 
+data ResolvesTo
+  = ResolvesToNamespace TypeReference
+  | ResolvesToLocal Name
+
 bindNames ::
+  forall a v.
   (Var v) =>
-  (v -> Name.Name) ->
+  (v -> Name) ->
+  (Name -> v) ->
   Set v ->
-  Names.Names ->
+  Names ->
   Type v a ->
   Names.ResolutionResult v a (Type v a)
-bindNames unsafeVarToName keepFree ns t =
-  let fvs = ABT.freeVarOccurrences keepFree t
-      rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns) | (v, a) <- fvs]
-      ok (v, a, rs) =
-        if Set.size rs == 1
-          then pure (v, Set.findMin rs)
-          else case NES.nonEmptySet rs of
-            Nothing -> Left (pure (Names.TypeResolutionFailure v a Names.NotFound))
-            Just rs' -> Left (pure (Names.TypeResolutionFailure v a (Names.Ambiguous ns rs')))
-   in List.validate ok rs <&> \es -> bindExternal es t
+bindNames unsafeVarToName nameToVar localVars namespaceNames ty =
+  let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound
+      -- type.
+      --
+      -- For example:
+      --
+      --   type Foo.Bar = ...
+      --   type Baz.Qux = ...
+      --   type Whatever =
+      --          Whatever
+      --            Foo.Bar   -- this variable is *not* unresolved: it matches locally-bound `Foo.Bar` exactly
+      --            Qux       -- this variable *is* unresolved: it doesn't match any locally-bound type exactly
+      unresolvedVars :: [(v, a)]
+      unresolvedVars =
+        ABT.freeVarOccurrences localVars ty
+
+      -- For each unresolved variable, look up what it might refer to in two places:
+      --
+      --   1. The names from the namespace, less all of the local names (because exact matches shadow the namespace)
+      --   2. The local names.
+      resolvedVars :: [(v, a, Set TypeReference, Set Name)]
+      resolvedVars =
+        map
+          ( \(v, a) ->
+              let name = unsafeVarToName v
+               in (v, a, getNamespaceMatches name, getLocalMatches name)
+          )
+          unresolvedVars
+
+      checkAmbiguity :: (v, a, Set TypeReference, Set Name) -> Either (Seq (Names.ResolutionFailure v a)) (v, ResolvesTo)
+      checkAmbiguity (v, a, namespaceMatches, localMatches) =
+        case (Set.size namespaceMatches, Set.size localMatches) of
+          (0, 0) -> bad Names.NotFound
+          (1, 0) -> good (ResolvesToNamespace (Set.findMin namespaceMatches))
+          (0, 1) -> good (ResolvesToLocal (Set.findMin localMatches))
+          _ -> bad (Names.Ambiguous namespaceNames namespaceMatches localMatches)
+        where
+          bad = Left . Seq.singleton . Names.TypeResolutionFailure v a
+          good = Right . (v,)
+   in List.validate checkAmbiguity resolvedVars <&> \resolutions ->
+        let -- Partition the resolutions into external/local
+            namespaceResolutions :: [(v, TypeReference)]
+            localResolutions :: [(v, Name)]
+            (namespaceResolutions, localResolutions) =
+              resolutions
+                -- Cast our nice informative ResolvesTo type to an Either, just to use `partitionEithers`
+                -- Is there a `partitonWith :: (a -> Either b c) -> [a] -> ([b], [c])` somewhere?
+                & map
+                  ( \case
+                      (v, ResolvesToNamespace ref) -> Left (v, ref)
+                      (v, ResolvesToLocal name) -> Right (v, name)
+                  )
+                & partitionEithers
+         in ty
+              -- Apply namespace resolutions (replacing "Foo" with #Foo where "Foo" refers to namespace)
+              & bindExternal namespaceResolutions
+              -- Apply local resolutions (replacing "Foo" with "Full.Name.Foo" where "Full.Name.Foo" is in local vars)
+              & ABT.substsInheritAnnotation [(v, Type.var () (nameToVar name)) | (v, name) <- localResolutions]
+  where
+    localNames :: Set Name
+    localNames =
+      Set.map unsafeVarToName localVars
+
+    getNamespaceMatches :: Name -> Set TypeReference
+    getNamespaceMatches name =
+      Names.lookupHQType
+        Names.IncludeSuffixes
+        (HQ.NameOnly name)
+        (over #types (Relation.subtractDom localNames) namespaceNames)
+
+    getLocalMatches :: Name -> Set Name
+    getLocalMatches =
+      (`Name.searchBySuffix` Relation.fromList (map (\name -> (name, name)) (Set.toList localNames)))