Skip to content

Commit

Permalink
fix bug in name binding logic related to indirect deps
Browse files Browse the repository at this point in the history
  • Loading branch information
@mitchellwrosen
mitchellwrosen committed Sep 11, 2024
1 parent bf442c9 commit 45a5ea6
Show file tree
Hide file tree
Showing 5 changed files with 100 additions and 105 deletions.
42 changes: 38 additions & 4 deletions unison-core/src/Unison/Names.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,9 +50,12 @@ module Unison.Names
hashQualifyTermsRelation,
fromTermsAndTypes,
lenientToNametree,
resolveName,
)
where

import Control.Lens (_2)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Semialign (alignWith)
import Data.Set qualified as Set
Expand All @@ -68,6 +71,7 @@ import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Names.ResolvesTo (ResolvesTo (..))
import Unison.Prelude
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId)
import Unison.Reference qualified as Reference
Expand Down Expand Up @@ -208,10 +212,11 @@ restrictReferences refs Names {..} = Names terms' types'
-- e.g. @shadowing scratchFileNames codebaseNames@
shadowing :: Names -> Names -> Names
shadowing a b =
Names (shadowing a.terms b.terms) (shadowing a.types b.types)
where
shadowing xs ys =
Relation.fromMultimap (Map.unionWith (\x _ -> x) (Relation.domain xs) (Relation.domain ys))
Names (shadowing1 a.terms b.terms) (shadowing1 a.types b.types)

shadowing1 :: (Ord a, Ord b) => Relation a b -> Relation a b -> Relation a b
shadowing1 xs ys =
Relation.fromMultimap (Map.unionWith (\x _ -> x) (Relation.domain xs) (Relation.domain ys))

-- | TODO: get this from database. For now it's a constant.
numHashChars :: Int
Expand Down Expand Up @@ -497,3 +502,32 @@ lenientToNametree names =
-- The partial `Set.findMin` is fine here because Relation.domain only has non-empty Set values. A NESet would be
-- better.
unflattenNametree . Map.map Set.findMin . Relation.domain

-- Given a namespace and locally-bound names that shadow it (i.e. from a Unison file that hasn't been typechecked yet),
-- determine what the name resolves to, per the usual suffix-matching rules (where local defnintions and direct
-- dependencies are preferred to indirect dependencies).
resolveName :: forall ref. (Ord ref) => Relation Name ref -> Set Name -> Name -> Set (ResolvesTo ref)
resolveName namespace locals name
| Set.member name locals = Set.singleton (ResolvesToLocal name)
| Set.size exactNamespaceMatches == 1 = Set.mapMonotonic ResolvesToNamespace exactNamespaceMatches
| otherwise = localsPlusNamespaceSuffixMatches
where
exactNamespaceMatches :: Set ref
exactNamespaceMatches =
Relation.lookupDom name namespace

localsPlusNamespaceSuffixMatches :: Set (ResolvesTo ref)
localsPlusNamespaceSuffixMatches =
Name.searchByRankedSuffix
name
( shadowing1
( List.foldl'
(\acc name -> Relation.insert name (ResolvesToLocal name) acc)
Relation.empty
(Set.toList locals)
)
( Relation.map
(over _2 ResolvesToNamespace)
namespace
)
)
47 changes: 20 additions & 27 deletions unison-core/src/Unison/Term.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.List (multimap, validate)
import Unison.Util.Relation qualified as Relation
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unsafe.Coerce (unsafeCoerce)
Expand Down Expand Up @@ -157,43 +156,37 @@ bindNames ::
Names ->
Term v a ->
Names.ResolutionResult a (Term v a)
bindNames unsafeVarToName nameToVar localVars ns term = do
bindNames unsafeVarToName nameToVar localVars namespace term = do
let freeTmVars = ABT.freeVarOccurrences localVars term
freeTyVars =
[ (v, a) | (v, as) <- Map.toList (freeTypeVarAnnotations term), a <- as
]
localNames = map unsafeVarToName (Set.toList localVars)

okTm :: (v, a) -> Names.ResolutionResult a (Maybe (v, ResolvesTo Referent))
okTm :: (v, a) -> Maybe (v, ResolvesTo Referent)
okTm (v, _) =
let exactNamespaceMatches = Names.lookupHQTerm Names.ExactName (HQ.NameOnly name) ns
suffixNamespaceMatches = Name.searchByRankedSuffix name (Names.terms ns)
localMatches =
Name.searchBySuffix name (Relation.fromList (map (\name -> (name, name)) localNames))
in case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of
(1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches))
(n, _, _) | n > 1 -> leaveFreeForTdnr
(_, 0, 0) -> leaveFreeForTellingUserAboutExpectedType
(_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches))
(_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches))
_ -> leaveFreeForTdnr
case Set.size matches of
1 -> Just (v, Set.findMin matches)
0 -> Nothing -- not found: leave free for telling user about expected type
_ -> Nothing -- ambiguous: leave free for TDNR
where
name = unsafeVarToName v
good = Right . Just . (v,)
leaveFreeForTdnr = Right Nothing
leaveFreeForTellingUserAboutExpectedType = Right Nothing
matches :: Set (ResolvesTo Referent)
matches =
Names.resolveName (Names.terms namespace) (Set.map unsafeVarToName localVars) (unsafeVarToName v)

okTy :: (v, a) -> Names.ResolutionResult a (v, Type v a)
okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes hqName ns of
rs
| Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs)
| Set.size rs == 0 -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a Names.NotFound))
| otherwise -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a (Names.Ambiguous ns rs Set.empty)))
okTy (v, a) =
case Names.lookupHQType Names.IncludeSuffixes hqName namespace of
rs
| Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs)
| Set.size rs == 0 -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a Names.NotFound))
| otherwise -> Left (Seq.singleton (Names.TypeResolutionFailure hqName a (Names.Ambiguous namespace rs Set.empty)))
where
hqName = HQ.NameOnly (unsafeVarToName v)
(namespaceTermResolutions, localTermResolutions) <-
partitionResolutions . catMaybes <$> validate okTm freeTmVars
let termSubsts =

let (namespaceTermResolutions, localTermResolutions) =
partitionResolutions (mapMaybe okTm freeTmVars)

termSubsts =
[(v, fromReferent () ref) | (v, ref) <- namespaceTermResolutions]
++ [(v, var () (nameToVar name)) | (v, name) <- localTermResolutions]
typeSubsts <- validate okTy freeTyVars
Expand Down
69 changes: 22 additions & 47 deletions unison-core/src/Unison/Type/Names.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,17 +8,15 @@ import Data.Set qualified as Set
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 (Names)
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Names.ResolvesTo (ResolvesTo (..), partitionResolutions)
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)

bindNames ::
Expand All @@ -30,7 +28,7 @@ bindNames ::
Names ->
Type v a ->
Names.ResolutionResult a (Type v a)
bindNames unsafeVarToName nameToVar localVars namespaceNames ty =
bindNames unsafeVarToName nameToVar localVars namespace ty =
let -- Identify the unresolved variables in the type: those whose names aren't an *exact* match for some locally-bound
-- type.
--
Expand All @@ -47,55 +45,32 @@ bindNames unsafeVarToName nameToVar localVars namespaceNames ty =
unresolvedVars =
ABT.freeVarOccurrences localVars ty

-- For each unresolved variable, look up what it might refer to:
--
-- 1. An exact match in the namespace.
-- 2. A suffix match in the namespace.
-- 3. A suffix match in the local names.
resolvedVars :: [(v, a, (Set TypeReference, 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 TypeReference), Set Name) ->
Either (Seq (Names.ResolutionFailure a)) (v, ResolvesTo TypeReference)
checkAmbiguity (v, a, (exactNamespaceMatches, suffixNamespaceMatches), localMatches) =
case (Set.size exactNamespaceMatches, Set.size suffixNamespaceMatches, Set.size localMatches) of
(1, _, _) -> good (ResolvesToNamespace (Set.findMin exactNamespaceMatches))
(n, _, _) | n > 1 -> bad (Names.Ambiguous namespaceNames exactNamespaceMatches Set.empty)
(_, 0, 0) -> bad Names.NotFound
(_, 1, 0) -> good (ResolvesToNamespace (Set.findMin suffixNamespaceMatches))
(_, 0, 1) -> good (ResolvesToLocal (Set.findMin localMatches))
_ -> bad (Names.Ambiguous namespaceNames suffixNamespaceMatches localMatches)
okTy :: (v, a) -> Names.ResolutionResult a (v, ResolvesTo TypeReference)
okTy (v, a) =
case Set.size matches of
1 -> good (Set.findMin matches)
0 -> bad Names.NotFound
_ ->
let (namespaceMatches, localMatches) =
matches
& Set.toList
& map \case
ResolvesToNamespace ref -> Left ref
ResolvesToLocal name -> Right name
& partitionEithers
& bimap Set.fromList Set.fromList
in bad (Names.Ambiguous namespace namespaceMatches localMatches)
where
matches :: Set (ResolvesTo TypeReference)
matches =
Names.resolveName (Names.types namespace) (Set.map unsafeVarToName localVars) (unsafeVarToName v)

bad = Left . Seq.singleton . Names.TypeResolutionFailure (HQ.NameOnly (unsafeVarToName v)) a
good = Right . (v,)
in List.validate checkAmbiguity resolvedVars <&> \resolutions ->
in List.validate okTy unresolvedVars <&> \resolutions ->
let (namespaceResolutions, localResolutions) = partitionResolutions resolutions
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, Set TypeReference)
getNamespaceMatches name =
( Names.lookupHQType Names.ExactName (HQ.NameOnly name) namespaceNamesLessLocalNames,
Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly name) namespaceNamesLessLocalNames
)
where
namespaceNamesLessLocalNames =
over #types (Relation.subtractDom localNames) namespaceNames

getLocalMatches :: Name -> Set Name
getLocalMatches =
(`Name.searchBySuffix` Relation.fromList (map (\name -> (name, name)) (Set.toList localNames)))
8 changes: 4 additions & 4 deletions unison-src/transcripts/fix-5340.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,15 +14,15 @@ lib.dep.lib.dep.foo = 18
scratch/main> add
```

These references to type `Foo` and term `foo` should be unambiguous (resolving to the `my.Foo` and `my.foo` in the
file). However, the indirect dependencies `lib.dep.lib.dep.Foo` and `lib.dep.lib.dep.foo` cause them to be ambiguous.
These references to type `Foo` and term `foo` are be unambiguous (resolving to the `my.Foo` and `my.foo` in the
file), even though indirect dependencies `lib.dep.lib.dep.Foo` and `lib.dep.lib.dep.foo` match by suffix.

```unison:error
```unison
type my.Foo = MkFoo
type Bar = MkBar Foo
```

```unison:error
```unison
my.foo = 17
bar = foo Nat.+ foo
```
39 changes: 16 additions & 23 deletions unison-src/transcripts/fix-5340.output.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,8 @@ scratch/main> add
my.foo : Nat
```
These references to type `Foo` and term `foo` should be unambiguous (resolving to the `my.Foo` and `my.foo` in the
file). However, the indirect dependencies `lib.dep.lib.dep.Foo` and `lib.dep.lib.dep.foo` cause them to be ambiguous.
These references to type `Foo` and term `foo` are be unambiguous (resolving to the `my.Foo` and `my.foo` in the
file), even though indirect dependencies `lib.dep.lib.dep.Foo` and `lib.dep.lib.dep.foo` match by suffix.

``` unison
type my.Foo = MkFoo
Expand All @@ -45,19 +45,15 @@ type Bar = MkBar Foo
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:
❓
I couldn't resolve any of these symbols:
2 | type Bar = MkBar Foo
⊡ Previously added definitions will be ignored: my.Foo
⍟ These new definitions are ok to `add`:
Symbol Suggestions
Foo lib.dep.lib.dep.Foo
my.Foo
type Bar
```
``` unison
Expand All @@ -69,17 +65,14 @@ bar = foo Nat.+ foo
Loading changes detected in scratch.u.
I couldn't figure out what foo refers to here:
2 | bar = foo Nat.+ foo
The name foo is ambiguous. Its type should be: Nat
I found some terms in scope that have matching names and
types. Maybe you meant one of these:
I found and typechecked these definitions in scratch.u. If you
do an `add` or `update`, here's how your codebase would
change:
my.foo : Nat
my.foo : Nat
dep.foo : Nat
⊡ Previously added definitions will be ignored: my.foo
⍟ These new definitions are ok to `add`:
bar : Nat
```

0 comments on commit 45a5ea6

Please sign in to comment.