unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-22 15:58:34 +03:00
Code Issues Projects Releases Wiki Activity

suffixTerm/TypeName are now responsible for sorting output

Browse Source
This commit is contained in:
Paul Chiusano 2021-07-31 00:19:21 -04:00
parent 9d662725e9
commit 33e7d7783c
2 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
parser-typechecker/src/Unison/PrettyPrintEnv.hs
View File

@ -41,9 +41,8 @@ fromNames len names = PrettyPrintEnv terms' types' where
fromSuffixNames :: Int -> Names -> PrettyPrintEnv
fromSuffixNames len names = PrettyPrintEnv terms' types' where
terms' r = pickName . Set.map HQ'.toHQ $ Names.suffixedTermName len r names
types' r = pickName . Set.map HQ'.toHQ $ Names.suffixedTypeName len r names
pickName ns = safeHead . Name.sortNameds toList . HQ.sortByLength $ toList ns
terms' r = safeHead $ Names.suffixedTermName len r names
types' r = safeHead $ Names.suffixedTypeName len r names
fromNamesDecl :: Int -> Names -> PrettyPrintEnvDecl
fromNamesDecl len names =

23
unison-core/src/Unison/Names3.hs
View File

@ -193,8 +193,8 @@ termName length r Names{..} =
where hq n = HQ'.take length (HQ'.fromNamedReferent n r)
isConflicted n = R.manyDom n (Names.terms currentNames)
suffixedTypeName :: Int -> Reference -> Names -> Set (HQ'.HashQualified Name)
suffixedTermName :: Int -> Referent -> Names -> Set (HQ'.HashQualified Name)
suffixedTypeName :: Int -> Reference -> Names -> [HQ.HashQualified Name]
suffixedTermName :: Int -> Referent -> Names -> [HQ.HashQualified Name]
(suffixedTermName,suffixedTypeName) =
( suffixedName termName (Names.terms . currentNames) HQ'.fromNamedReferent
, suffixedName typeName (Names.types . currentNames) HQ'.fromNamedReference )
@ -202,17 +202,24 @@ suffixedTermName :: Int -> Referent -> Names -> Set (HQ'.HashQualified Name)
suffixedName fallback getRel hq' length r ns@(getRel -> rel) =
if R.memberRan r rel
then go $ toList (R.lookupRan r rel)
else fallback length r ns
else sort $ map Name.convert $ Set.toList (fallback length r ns)
where
sort = HQ.sortByLength . Name.sortNameds toList
isConflicted n = R.manyDom n rel
hq n = HQ'.take length (hq' n r)
go ns = case sortOn (\n -> (Name.countSegments n, Name.toText n)) ns of
go ns = case sortOn Name.countSegments ns of
[] -> mempty
fqn : _ -> Set.singleton $
let n' = shortestUniqueSuffix fqn r rel
in if isConflicted fqn then hq n'
else HQ'.fromName n'
fqns -> Name.sortNameds toList (map f fqns) where
f fqn = Name.convert $
let n' = shortestUniqueSuffix fqn r rel
in if isConflicted fqn then hq n' else HQ'.fromName n'
-- Tries to shorten `fqn` to the smallest suffix that still refers
-- uniquely to `r`. Uses an efficient logarithmic lookup in the
-- provided relation.
--
-- NB: Only works if the `Ord` instance for `Name` orders based on
-- `Name.reverseSegments`.
shortestUniqueSuffix :: Ord r => Name -> r -> Relation Name r -> Name
shortestUniqueSuffix fqn r rel =
maybe fqn (Name.convert . reverse) (find isOk suffixes)